(defpackage :block-to-sexp
(:use :cl))
(in-package :block-to-sexp)
(defun read-block (stream)
(when (char= (read-char stream) #\{)
(loop
with block = (make-string-output-stream)
with count = 0
for char = (read-char stream)
until (and (char= char #\}) (= count 0))
when (char= char #\{) do (incf count)
when (char= char #\}) do (decf count)
do (write-char char block)
finally
(return (get-output-stream-string block)))))
(defun read-to-block (stream)
(with-output-to-string (s)
(loop
until (char= #\{ (peek-char nil stream))
do (write-char (read-char stream) s))))
(defun partition (char string &key from-end)
(let ((pos (position char string :from-end from-end)))
(if pos
(list (subseq string 0 pos)
(subseq string (1+ pos)))
(list nil
string))))
(defun parse-rule (block)
(mapcar #'serapeum:tokens
(serapeum:split-sequence #\;
(serapeum:collapse-whitespace block)
:remove-empty-subseqs t)))
(defun read-section (stream)
(cons (serapeum:collapse-whitespace (read-to-block stream))
(parse-rule (read-block stream))))
(defun parse-file (stream)
(loop with result = (list)
with done = nil
until done
do
(handler-case (push (read-section stream)
result)
(end-of-file (c) c (setf done t)))
finally
(return (nreverse result))))
(defun collapse-rule (rule)
(let ((selector (car rule)))
(mapcan (serapeum:op (mapcar (lambda (x) (list x _))
selector))
(cdr rule))))
(defun reconstitute (rules)
(loop for (selector (property value)) in rules
collect (format nil "~a { ~a: ~a; }" selector property value)))
(defun normalize-file (stream)
(fw.lu:let-each (:be *)
(parse-file stream)
(mapcan #'collapse-rule *)
(stable-sort * #'string< :key #'caadr)
(reconstitute *)
(serapeum:string-join * #\newline)))
(defun test-read-block ()
(let ((strings (list "asdf cda qwer dsfa"
(format nil "asdf fdsaf ~% asdf qwerqw~%")
(format nil "{asdf fdsaf ~% asdf qwerqw~%}")
(format nil "asdf fdsaf {~% asdf qwerqw~%}"))))
(loop
for string in strings
for n from 1
do
(with-input-from-string (s (format nil "{~a}" string))
(format t "~&Test ~d: ~:[fail~;pass~]~%" n
(string= string (read-block s)))))))
|