1 (in-package #:oh-ducks) 2 (named-readtables:in-readtable template-readtable) 3 ;; FIXME: the switch to chtml:pt nodes means our #'equalp no longer 4 ;; works. 5 6 #+(or) (setq *default-parser* 'pt) 7 8 (equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.") 9 (match (#T(html (:model lhtml) ("#id" . ?div)) 10 "<div id=\"id\">I <i>like</i> cheese.</div>") 11 ;; FIXME: learn to distinguish between when there should only be one 12 ;; result and when there should be many? 13 (car div))) 14 15 (equalp '((:div ((:class "red fish")) "one fish") 16 (:div ((:class "blue fish")) "two fish")) 17 (match (#T(html (:model lhtml) 18 (".fish" . ?divs) 19 (".pig" . ?pig)) 20 "<div class='pig'>bricklayer</div><div class='red fish'>one fish</div><div class='blue fish'>two fish</div>") 21 ;; pig doesn't affect the equalp...but does show separate things are separate 22 (values divs pig))) 23 24 (equalp '((:i () "not") (:i () "cheese")) 25 (match (#T(html (:model lhtml) 26 ("div" ("i" . ?i))) 27 "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>") 28 i)) 29 30 (equalp '((:i () "not")) 31 (match (#T(html (:model lhtml) 32 ("div>i" . ?i)) 33 "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 34 i)) 35 36 (equalp '((:i () "not")) 37 (match (#T(html (:model lhtml) 38 ("div" (">i" . ?i) 39 ;("i" . #t(list ?j ?i)) 40 ("span>i" . ?span))) 41 "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 42 (values i span))) 43 44 (defun make-dom-document (child-node) 45 (make-instance 'rune-dom::document :children (rune-dom::make-node-list (list child-node)))) 46 47 (defun serialize (object) 48 (let ((document 49 (etypecase object 50 (rune-dom::document object) 51 (rune-dom::element (make-dom-document object)) 52 (chtml:pt object) 53 (list object)))) 54 (etypecase document 55 (rune-dom::document 56 (dom:map-document (cxml:make-string-sink :omit-xml-declaration-p t) 57 document)) 58 (chtml:pt 59 (chtml:serialize-pt document (chtml:make-string-sink))) 60 (list (mapcar #'serialize document))))) 61 62 (defmacro serialize-values (form) 63 `(let ((values (multiple-value-list ,form))) 64 (values-list (mapcar #'serialize values)))) 65 66 (equal '("<i>cheese</i>" "<i>cheese</i>") 67 (serialize-values 68 (match (#T(html (:model dom) 69 ("i" . #t(list ?j ?i)) 70 ("span>i" . ?span)) 71 "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 72 (values i span)))) 73 74 (serialize-values 75 (match (#T(html (:model dom) 76 ("div:first-child" . ?div) 77 ("i:nth-child(1)" . ?i)) 78 "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 79 (values div i))) 80 81 (serialize-values 82 (match (#T(html (:model dom) 83 ("div:nth-last-child(1)" . ?div) 84 ("div:last-child" . ?d2)) 85 "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 86 (values div d2))) 87 88 (serialize-values 89 (match (#t(html (:model dom) 90 (":nth-last-of-type(2)" . ?first) 91 (":nth-of-type(2)" . ?last)) 92 "<div><span>1</span><i>i</i><span>2</span><i>i</i></div>") 93 (values first last))) 94 95 (match (#T(html (:model dom) 96 ("q" . ?div)) 97 "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>") 98 (values div)) 99 100 ;; throws 'unification-failure 101 (serialize-values 102 (match (#T(html (:model dom) 103 ("i:only-child" . ?i) 104 ("i:only-of-type" . ?i-type)) 105 "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span><i>I</i> like <i>cheese</i>.</span></div>") 106 (values i i-type))) 107 108 (serialize-values 109 (match (#T(html (:model dom) 110 ("b + i" . ?i)) 111 "<div>I <b>really</b> <i>like</i> cheese. Do you not <i>dislike</i> cheese?</div>") 112 (values i))) 113 114 (serialize-values 115 (match (#T(html (:model dom) 116 ("b ~ i" . ?i)) 117 "<div>I <i>really</i> <b>like</b> cheese. Do you <i>not</i> <i>dislike</i> cheese?</div>") 118 (values i))) 119 120 (serialize-values 121 (match (#T(html (:model pt) 122 ("body :empty" . ?empty)) 123 "<div><p><br></p><p>testing<i>i</i>testing</p></div>") 124 (values empty))) 125 126 ;; Sometimes, you want to match a thing inside a thing, in which case 127 ;; combinators should implicitly assume an unspecified right side means 128 ;; "whatever element I gave you". 129 (serialize-values 130 (match (#T(html (:model dom) 131 ("q" . ?q)) 132 "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i></div>") 133 (match (#t(html ("> i" . ?i)) 134 (first q)) 135 i))) 136 137 ;; siblings will also match, thanks to a bit of ugly code 138 (serialize-values 139 (match (#T(html (:model dom) 140 ("q" . ?q)) 141 "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i><q></q><i>not match</i></div>") 142 (match (#t(html ("+ i" . ?i)) 143 (first q)) 144 i))) 145 146 (serialize-values 147 (match (#T(html (:model dom) 148 ("q" . ?q)) 149 "<div> foo <q>outer q <i>baz <q>inner q</q></i></q> quuz</div>") 150 (match (#t(html ("q" . ?i)) 151 (first q)) 152 i))) 153 154 (serialize-values 155 (match (#T(html (:model dom) 156 ("[id]" . ?ids)) 157 "<div><i id=''>blank id</i>foo<b>no id</b>bar<i id='id'>id id</i></div>") 158 ids)) 159 160 (serialize-values 161 (match (#T(html (:model dom) 162 ("[id=foo]" . ?id)) 163 "<div><i id='bar'>bar id</i><i>no id</i><i id='foo'>foo id</i></div>") 164 id)) 165 166 #+LATER? 167 (match (#t(html ("div::content" . #t(regexp+ "^f(o+)" (?o)))) 168 "<div>barbaz</div><div>fooooooobar</div>") 169 (values o &rest))