(defpackage :css-norm
(:use :cl))
(in-package :css-norm)
(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)
(declare (optimize (speed 3) (safety 1)))
(with-output-to-string (s)
(labels ((initial ()
(let ((next-char (peek-char nil stream)))
(case next-char
(#\{ (return-from initial))
(#\/ (maybe-comment-start))
(t
(write-char (read-char stream)
s)
(initial)))))
(maybe-comment-start ()
(let ((stash (read-char stream))
(next-char (peek-char nil stream)))
(case next-char
(#\*
(read-char stream)
(comment)
(initial))
(t (unread-char stash
stream)))))
(comment ()
(let ((ending nil))
(loop
(case (read-char stream)
(#\* (setf ending t))
(#\/ (when ending
(return-from comment)))
(t (when ending
(setf ending nil))))))))
(initial))))
(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)
(remove-if-not #'car
(mapcar (serapeum:op
(mapcar (lambda (v1)
(declare (ignorable v1))
(progn
(if v1
(serapeum:trim-whitespace v1))))
(partition #\: _)))
(serapeum:split-sequence #\;
(serapeum:collapse-whitespace block)))))
(defmacro one-of (chars)
`(lambda (it)
(case it
(,(coerce chars 'list) t)
(t nil))))
(defun split-to (pred str)
(let ((split (or (= 0 (length str))
(position-if pred str :start 1))))
(if (and split
(/= 0 (length str)))
(values (subseq str 0 split)
(subseq str split))
(values str
nil))))
(defun repeatedly (fun str &optional acc)
(declare (optimize (speed 3) (safety 1))
(type function fun))
(multiple-value-bind (head tail) (funcall fun str)
(if tail
(repeatedly fun tail
(cons head acc))
(nreverse (cons head acc)))))
(defun split-selector (selector)
(mapcan 'serapeum:tokens
(mapcan (lambda (it)
(destructuring-bind (h . tt) (repeatedly (lambda (it)
(split-to (one-of "~+>")
it))
it)
(cons h
(when tt
(mapcan (lambda (it)
(list (subseq it 0 1)
(subseq it 1)))
tt)))))
(mapcan (lambda (it)
(destructuring-bind (a . r) (remove ":"
(coerce (fwoar.string-utils:split ":" it)
'list)
:test 'equal)
(let ((tail (mapcar (lambda (it)
(serapeum:concat ":" it))
r)))
(if (equal a "")
tail
(cons a tail)))))
(repeatedly (lambda (it)
(let ((first-non-ws (position-if-not 'serapeum:whitespacep
it)))
(split-to (one-of "#.[()")
(subseq it first-non-ws))))
selector)))))
(defun specificity (selector)
(macrolet ((matches-pseudo ((&rest types) v)
(alexandria:once-only (v)
`(or ,@(mapcar (lambda (type)
`(alexandria:starts-with-subseq ,(format nil ":~a" (string-downcase type))
,v))
types)))))
(let ((ids 0)
(classes 0)
(elements 0))
(loop for el in selector
when (consp el)
do
(case (car el)
(:id (incf ids))
(:class (incf classes))
(:attribute (incf classes))
(:element (incf elements))
(:pseudo (let ((v (cadr el)))
(cond
((matches-pseudo (:link :empty :only-of-type :only-child :last-of-type :first-of-type
:last-child :first-child "nth-of-type(" "nth-last-child("
"nth-child(" :root :indeterminate :checked :disabled "enabled"
:lang :target :focus :active :hover :visited)
v)
(incf classes))
((or (matches-pseudo (:before :after :first-line :first-letter)
v))
(incf elements))
(t (format t "~&unrecognized pseudoclass/element: ~s~%" v)))))))
(list (vector ids classes elements) selector))))
(defun parse-selector (selector)
(flet ((categorize (it)
(case (char-downcase (elt it 0))
(#\. (list :class it))
(#\@ (list :media it))
(#\[ (list :attribute it))
(#\# (list :id it))
(#\: (list :pseudo it))
(#.(loop for c
from (char-code #\a)
to (char-code #\z)
collect (code-char c))
(list :element it))
(t it))))
(let ((selector (string-trim #2=#.(format nil "~c~c" #\space #\tab)
selector)))
(if (alexandria:starts-with-subseq "@media" selector)
(list (list #1="@media"
(string-trim #2#(subseq selector (length #1#)))))
(mapcar (alexandria:compose (data-lens:over
(alexandria:compose
(lambda (it)
(let ((it (serapeum:trim-whitespace it)))
(categorize it)))))
'split-selector)
(split-sequence:split-sequence #\, selector))))))
(defun read-rule (stream)
(let ((selector (funcall (alexandria:compose #'parse-selector
#'serapeum:collapse-whitespace)
(read-to-block stream)))
(rule (read-block stream)))
(cons selector
(if (equal "@media" (caar selector))
(with-input-from-string (s rule)
(parse-file s))
(parse-rule rule)))))
(defun parse-file (stream)
(loop with result = (list)
with done = nil
until done
do
(handler-case (push (read-rule 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)))))))