Browse code
feat: add specificity calculation, refactor
Ed Langley authored on 20/11/2019 18:38:41Showing 1 changed files
| ... | ... |
@@ -16,10 +16,37 @@ |
| 16 | 16 |
(return (get-output-stream-string block))))) |
| 17 | 17 |
|
| 18 | 18 |
(defun read-to-block (stream) |
| 19 |
+ (declare (optimize (speed 3) (safety 1))) |
|
| 19 | 20 |
(with-output-to-string (s) |
| 20 |
- (loop |
|
| 21 |
- until (char= #\{ (peek-char nil stream))
|
|
| 22 |
- do (write-char (read-char stream) s)))) |
|
| 21 |
+ (labels ((initial () |
|
| 22 |
+ (let ((next-char (peek-char nil stream))) |
|
| 23 |
+ (case next-char |
|
| 24 |
+ (#\{ (return-from initial))
|
|
| 25 |
+ (#\/ (maybe-comment-start)) |
|
| 26 |
+ (t |
|
| 27 |
+ (write-char (read-char stream) |
|
| 28 |
+ s) |
|
| 29 |
+ (initial))))) |
|
| 30 |
+ (maybe-comment-start () |
|
| 31 |
+ (let ((stash (read-char stream)) |
|
| 32 |
+ (next-char (peek-char nil stream))) |
|
| 33 |
+ (case next-char |
|
| 34 |
+ (#\* |
|
| 35 |
+ (read-char stream) |
|
| 36 |
+ (comment) |
|
| 37 |
+ (initial)) |
|
| 38 |
+ (t (unread-char stash |
|
| 39 |
+ stream))))) |
|
| 40 |
+ (comment () |
|
| 41 |
+ (let ((ending nil)) |
|
| 42 |
+ (loop |
|
| 43 |
+ (case (read-char stream) |
|
| 44 |
+ (#\* (setf ending t)) |
|
| 45 |
+ (#\/ (when ending |
|
| 46 |
+ (return-from comment))) |
|
| 47 |
+ (t (when ending |
|
| 48 |
+ (setf ending nil)))))))) |
|
| 49 |
+ (initial)))) |
|
| 23 | 50 |
|
| 24 | 51 |
(defun partition (char string &key from-end) |
| 25 | 52 |
(let ((pos (position char string :from-end from-end))) |
| ... | ... |
@@ -31,22 +58,141 @@ |
| 31 | 58 |
|
| 32 | 59 |
(defun parse-rule (block) |
| 33 | 60 |
(remove-if-not #'car |
| 34 |
- (mapcar (serapeum:op |
|
| 35 |
- (mapcar (serapeum:op |
|
| 36 |
- (and _1 (serapeum:trim-whitespace _1))) |
|
| 37 |
- (partition #\: _))) |
|
| 38 |
- (serapeum:split-sequence #\; |
|
| 39 |
- (serapeum:collapse-whitespace block))))) |
|
| 61 |
+ (mapcar (serapeum:op |
|
| 62 |
+ (mapcar (lambda (v1) |
|
| 63 |
+ (declare (ignorable v1)) |
|
| 64 |
+ (progn |
|
| 65 |
+ (if v1 |
|
| 66 |
+ (serapeum:trim-whitespace v1)))) |
|
| 67 |
+ (partition #\: _))) |
|
| 68 |
+ (serapeum:split-sequence #\; |
|
| 69 |
+ (serapeum:collapse-whitespace block))))) |
|
| 70 |
+ |
|
| 71 |
+(defmacro one-of (chars) |
|
| 72 |
+ `(lambda (it) |
|
| 73 |
+ (case it |
|
| 74 |
+ (,(coerce chars 'list) t) |
|
| 75 |
+ (t nil)))) |
|
| 76 |
+ |
|
| 77 |
+(defun split-to (pred str) |
|
| 78 |
+ (let ((split (or (= 0 (length str)) |
|
| 79 |
+ (position-if pred str :start 1)))) |
|
| 80 |
+ (if (and split |
|
| 81 |
+ (/= 0 (length str))) |
|
| 82 |
+ (values (subseq str 0 split) |
|
| 83 |
+ (subseq str split)) |
|
| 84 |
+ (values str |
|
| 85 |
+ nil)))) |
|
| 86 |
+ |
|
| 87 |
+(defun repeatedly (fun str &optional acc) |
|
| 88 |
+ (declare (optimize (speed 3) (safety 1)) |
|
| 89 |
+ (type function fun)) |
|
| 90 |
+ (multiple-value-bind (head tail) (funcall fun str) |
|
| 91 |
+ (if tail |
|
| 92 |
+ (repeatedly fun tail |
|
| 93 |
+ (cons head acc)) |
|
| 94 |
+ (nreverse (cons head acc))))) |
|
| 95 |
+ |
|
| 96 |
+(defun split-selector (selector) |
|
| 97 |
+ (mapcan 'serapeum:tokens |
|
| 98 |
+ (mapcan (lambda (it) |
|
| 99 |
+ (destructuring-bind (h . tt) (repeatedly (lambda (it) |
|
| 100 |
+ (split-to (one-of "~+>") |
|
| 101 |
+ it)) |
|
| 102 |
+ it) |
|
| 103 |
+ (cons h |
|
| 104 |
+ (when tt |
|
| 105 |
+ (mapcan (lambda (it) |
|
| 106 |
+ (list (subseq it 0 1) |
|
| 107 |
+ (subseq it 1))) |
|
| 108 |
+ tt))))) |
|
| 109 |
+ (mapcan (lambda (it) |
|
| 110 |
+ (destructuring-bind (a . r) (remove ":" |
|
| 111 |
+ (coerce (fwoar.string-utils:split ":" it) |
|
| 112 |
+ 'list) |
|
| 113 |
+ :test 'equal) |
|
| 114 |
+ (let ((tail (mapcar (lambda (it) |
|
| 115 |
+ (serapeum:concat ":" it)) |
|
| 116 |
+ r))) |
|
| 117 |
+ (if (equal a "") |
|
| 118 |
+ tail |
|
| 119 |
+ (cons a tail))))) |
|
| 120 |
+ (repeatedly (lambda (it) |
|
| 121 |
+ (let ((first-non-ws (position-if-not 'serapeum:whitespacep |
|
| 122 |
+ it))) |
|
| 123 |
+ (split-to (one-of "#.[()") |
|
| 124 |
+ (subseq it first-non-ws)))) |
|
| 125 |
+ selector))))) |
|
| 126 |
+ |
|
| 127 |
+(defun specificity (selector) |
|
| 128 |
+ (macrolet ((matches-pseudo ((&rest types) v) |
|
| 129 |
+ (alexandria:once-only (v) |
|
| 130 |
+ `(or ,@(mapcar (lambda (type) |
|
| 131 |
+ `(alexandria:starts-with-subseq ,(format nil ":~a" (string-downcase type)) |
|
| 132 |
+ ,v)) |
|
| 133 |
+ types))))) |
|
| 134 |
+ (let ((ids 0) |
|
| 135 |
+ (classes 0) |
|
| 136 |
+ (elements 0)) |
|
| 137 |
+ (loop for el in selector |
|
| 138 |
+ when (consp el) |
|
| 139 |
+ do |
|
| 140 |
+ (case (car el) |
|
| 141 |
+ (:id (incf ids)) |
|
| 142 |
+ (:class (incf classes)) |
|
| 143 |
+ (:attribute (incf classes)) |
|
| 144 |
+ (:element (incf elements)) |
|
| 145 |
+ (:pseudo (let ((v (cadr el))) |
|
| 146 |
+ (cond |
|
| 147 |
+ ((matches-pseudo (:link :empty :only-of-type :only-child :last-of-type :first-of-type |
|
| 148 |
+ :last-child :first-child "nth-of-type(" "nth-last-child("
|
|
| 149 |
+ "nth-child(" :root :indeterminate :checked :disabled "enabled"
|
|
| 150 |
+ :lang :target :focus :active :hover :visited) |
|
| 151 |
+ v) |
|
| 152 |
+ (incf classes)) |
|
| 153 |
+ ((or (matches-pseudo (:before :after :first-line :first-letter) |
|
| 154 |
+ v)) |
|
| 155 |
+ (incf elements)) |
|
| 156 |
+ (t (format t "~&unrecognized pseudoclass/element: ~s~%" v))))))) |
|
| 157 |
+ (list (vector ids classes elements) selector)))) |
|
| 40 | 158 |
|
| 41 | 159 |
(defun parse-selector (selector) |
| 42 |
- (mapcar #'serapeum:trim-whitespace |
|
| 43 |
- (split-sequence:split-sequence #\, selector))) |
|
| 160 |
+ (flet ((categorize (it) |
|
| 161 |
+ (case (char-downcase (elt it 0)) |
|
| 162 |
+ (#\. (list :class it)) |
|
| 163 |
+ (#\@ (list :media it)) |
|
| 164 |
+ (#\[ (list :attribute it)) |
|
| 165 |
+ (#\# (list :id it)) |
|
| 166 |
+ (#\: (list :pseudo it)) |
|
| 167 |
+ (#.(loop for c |
|
| 168 |
+ from (char-code #\a) |
|
| 169 |
+ to (char-code #\z) |
|
| 170 |
+ collect (code-char c)) |
|
| 171 |
+ (list :element it)) |
|
| 172 |
+ (t it)))) |
|
| 173 |
+ (let ((selector (string-trim #2=#.(format nil "~c~c" #\space #\tab) |
|
| 174 |
+ selector))) |
|
| 175 |
+ (if (alexandria:starts-with-subseq "@media" selector) |
|
| 176 |
+ (list (list #1="@media" |
|
| 177 |
+ (string-trim #2#(subseq selector (length #1#))))) |
|
| 178 |
+ (mapcar (alexandria:compose (data-lens:over |
|
| 179 |
+ (alexandria:compose |
|
| 180 |
+ (lambda (it) |
|
| 181 |
+ (let ((it (serapeum:trim-whitespace it))) |
|
| 182 |
+ (categorize it))))) |
|
| 183 |
+ 'split-selector) |
|
| 184 |
+ (split-sequence:split-sequence #\, selector)))))) |
|
| 44 | 185 |
|
| 45 | 186 |
(defun read-rule (stream) |
| 46 |
- (cons (funcall (alexandria:compose #'parse-selector |
|
| 47 |
- #'serapeum:collapse-whitespace) |
|
| 48 |
- (read-to-block stream)) |
|
| 49 |
- (parse-rule (read-block stream)))) |
|
| 187 |
+ (let ((selector (funcall (alexandria:compose #'parse-selector |
|
| 188 |
+ #'serapeum:collapse-whitespace) |
|
| 189 |
+ (read-to-block stream))) |
|
| 190 |
+ (rule (read-block stream))) |
|
| 191 |
+ (cons selector |
|
| 192 |
+ (if (equal "@media" (caar selector)) |
|
| 193 |
+ (with-input-from-string (s rule) |
|
| 194 |
+ (parse-file s)) |
|
| 195 |
+ (parse-rule rule))))) |
|
| 50 | 196 |
|
| 51 | 197 |
(defun parse-file (stream) |
| 52 | 198 |
(loop with result = (list) |
| ... | ... |
@@ -79,13 +225,13 @@ |
| 79 | 225 |
|
| 80 | 226 |
(defun test-read-block () |
| 81 | 227 |
(let ((strings (list "asdf cda qwer dsfa" |
| 82 |
- (format nil "asdf fdsaf ~% asdf qwerqw~%") |
|
| 83 |
- (format nil "{asdf fdsaf ~% asdf qwerqw~%}")
|
|
| 84 |
- (format nil "asdf fdsaf {~% asdf qwerqw~%}"))))
|
|
| 228 |
+ (format nil "asdf fdsaf ~% asdf qwerqw~%") |
|
| 229 |
+ (format nil "{asdf fdsaf ~% asdf qwerqw~%}")
|
|
| 230 |
+ (format nil "asdf fdsaf {~% asdf qwerqw~%}"))))
|
|
| 85 | 231 |
(loop |
| 86 |
- for string in strings |
|
| 87 |
- for n from 1 |
|
| 88 |
- do |
|
| 89 |
- (with-input-from-string (s (format nil "{~a}" string))
|
|
| 90 |
- (format t "~&Test ~d: ~:[fail~;pass~]~%" n |
|
| 91 |
- (string= string (read-block s))))))) |
|
| 232 |
+ for string in strings |
|
| 233 |
+ for n from 1 |
|
| 234 |
+ do |
|
| 235 |
+ (with-input-from-string (s (format nil "{~a}" string))
|
|
| 236 |
+ (format t "~&Test ~d: ~:[fail~;pass~]~%" n |
|
| 237 |
+ (string= string (read-block s))))))) |