(in-package #:oh-ducks)
(named-readtables:in-readtable template-readtable)
;; FIXME: the switch to chtml:pt nodes means our #'equalp no longer
;; works.

#+(or) (setq *default-parser* 'pt)

(equalp '(:div ((:id "id")) "I " (:i () "like") " cheese.")
        (match (#T(html (:model lhtml) ("#id" . ?div))
                "<div id=\"id\">I <i>like</i> cheese.</div>")
          ;; FIXME: learn to distinguish between when there should only be one
          ;;        result and when there should be many?
          (car div)))

(equalp '((:div ((:class "red fish"))  "one fish")
          (:div ((:class "blue fish")) "two fish"))
        (match (#T(html (:model lhtml)
                        (".fish" . ?divs)
                        (".pig" . ?pig))
                "<div class='pig'>bricklayer</div><div class='red fish'>one fish</div><div class='blue fish'>two fish</div>")
          ;; pig doesn't affect the equalp...but does show separate things are separate
          (values divs pig)))

(equalp '((:i () "not") (:i () "cheese"))
        (match (#T(html (:model lhtml)
                        ("div" ("i" . ?i)))
                "<div>I do <i>not</i> like cheese.</div><div>I like <i>cheese</i>.</div>")
          i))

(equalp '((:i () "not"))
        (match (#T(html (:model lhtml)
                        ("div>i" . ?i))
                "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
          i))

(equalp '((:i () "not"))
        (match (#T(html (:model lhtml)
                        ("div" (">i" . ?i)
                               ;("i" . #t(list ?j ?i))
                               ("span>i" . ?span)))
                "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
          (values i span)))

(defun make-dom-document (child-node)
  (make-instance 'rune-dom::document :children (rune-dom::make-node-list (list child-node))))

(defun serialize (object)
  (let ((document
         (etypecase object
           (rune-dom::document object)
           (rune-dom::element (make-dom-document object))
           (chtml:pt object)
           (list object))))
    (etypecase document
      (rune-dom::document
       (dom:map-document (cxml:make-string-sink :omit-xml-declaration-p t)
                         document))
      (chtml:pt
       (chtml:serialize-pt document (chtml:make-string-sink)))
      (list (mapcar #'serialize document)))))

(defmacro serialize-values (form)
  `(let ((values (multiple-value-list ,form)))
     (values-list (mapcar #'serialize values))))

(equal '("<i>cheese</i>" "<i>cheese</i>")
       (serialize-values
        (match (#T(html (:model dom)
                        ("i" . #t(list ?j ?i))
                        ("span>i" . ?span))
                  "<div>I do <i>not</i> like cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
          (values i span))))

(serialize-values
 (match (#T(html (:model dom)
                 ("div:first-child" . ?div)
                 ("i:nth-child(1)" . ?i))
         "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
   (values div i)))

(serialize-values
 (match (#T(html (:model dom)
                 ("div:nth-last-child(1)" . ?div)
                 ("div:last-child" . ?d2))
         "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
   (values div d2)))

(serialize-values
 (match (#t(html (:model dom)
                 (":nth-last-of-type(2)" . ?first)
                 (":nth-of-type(2)" . ?last))
         "<div><span>1</span><i>i</i><span>2</span><i>i</i></div>")
   (values first last)))

(match (#T(html (:model dom)
                ("q" . ?div))
        "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span>I like <i>cheese</i>.</span></div>")
  (values div))

;; throws 'unification-failure
(serialize-values
 (match (#T(html (:model dom)
                 ("i:only-child" . ?i)
                 ("i:only-of-type" . ?i-type))
         "<div>I do <i>not</i> <i>like</i> cheese.</div><div><span><i>I</i> like <i>cheese</i>.</span></div>")
   (values i i-type)))

(serialize-values
 (match (#T(html (:model dom)
                 ("b + i" . ?i))
         "<div>I <b>really</b> <i>like</i> cheese.  Do you not <i>dislike</i> cheese?</div>")
   (values i)))

(serialize-values
 (match (#T(html (:model dom)
                 ("b ~ i" . ?i))
         "<div>I <i>really</i> <b>like</b> cheese.  Do you <i>not</i> <i>dislike</i> cheese?</div>")
   (values i)))

(serialize-values
 (match (#T(html (:model pt)
                 ("body :empty" . ?empty))
         "<div><p><br></p><p>testing<i>i</i>testing</p></div>")
   (values empty)))

;; Sometimes, you want to match a thing inside a thing, in which case
;; combinators should implicitly assume an unspecified right side means
;; "whatever element I gave you".
(serialize-values
 (match (#T(html (:model dom)
                 ("q" . ?q))
         "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i></div>")
   (match (#t(html ("> i" . ?i))
           (first q))
     i)))

;; siblings will also match, thanks to a bit of ugly code
(serialize-values
 (match (#T(html (:model dom)
                 ("q" . ?q))
         "<div><i>ham</i> foo <q>bar <i>baz</i></q> quuz <i>spam</i><q></q><i>not match</i></div>")
   (match (#t(html ("+ i" . ?i))
           (first q))
     i)))

(serialize-values
 (match (#T(html (:model dom)
                 ("q" . ?q))
         "<div> foo <q>outer q <i>baz <q>inner q</q></i></q> quuz</div>")
   (match (#t(html ("q" . ?i))
           (first q))
     i)))

(serialize-values
 (match (#T(html (:model dom)
                 ("[id]" . ?ids))
         "<div><i id=''>blank id</i>foo<b>no id</b>bar<i id='id'>id id</i></div>")
   ids))

(serialize-values
 (match (#T(html (:model dom)
                 ("[id=foo]" . ?id))
         "<div><i id='bar'>bar id</i><i>no id</i><i id='foo'>foo id</i></div>")
   id))

#+LATER?
(match (#t(html ("div::content" . #t(regexp+ "^f(o+)" (?o))))
        "<div>barbaz</div><div>fooooooobar</div>")
  (values o &rest))