(in-package #:hypnotisml)

(defun var-pair-p (thing)
  (and (listp thing)
       (= 2 (length thing))
       (every #'symbolp thing)))

  


#+off
(a:with-gensyms (elem frontier)
  (destructuring-bind (node parent) vars
    (let ((loop-clauses
            (loop :for (_if cond-expr action) :in clauses
                  :if (eq :remove)
                    :collect `(:when ,cond-expr ))))
      `(let* ((,elem ,elem-expr)
              (,frontier (list ,elem)))
         (loop
           :until (endp ,frontier)
           :with ,parent := nil
           :for ,node := (car ,frontier)
           ,@loop-clauses)
         ,elem))))

(defun make-queue (&rest xs)
  (let ((q (cons nil nil)))
    (when xs (enqueue* q xs))
    q))

(defun enqueue (q e)
  (push e (cdr q)))

(defun enqueue* (q es)
  (dolist (e es) (enqueue q e)))

(defun prequeue (q e)
  (push e (car q)))

(defun prequeue* (q es)
  (dolist (e (reverse es))
    (prequeue q e)))

(defun dequeue (q)
  (when (endp (car q))
    (setf (car q) (nreverse (cdr q))
          (cdr q) nil))
  (pop (car q)))

(defun empty-queue (q)
  (not (or (car q) (cdr q))))


(defun expand-walk (top vars clauses)
  (a:with-gensyms (new-children frontier top-var)
    (destructuring-bind (node parent) vars
     (multiple-value-bind
           (unconditional-exprs conditional-exprs remove-check-exprs)
         (loop
           :with unconditional-exprs := nil
           :with conditional-exprs := nil
           :with remove-check-exprs := nil
           :for (clause-start . clause-body) :in clauses
           :do (case clause-start
                 (:do (push (first clause-body) unconditional-exprs))
                 (:if (destructuring-bind (guard phrase) clause-body
                        (if (eq :remove phrase)
                            (push guard remove-check-exprs)
                            (destructuring-bind (phrase-head phrase-body) phrase
                              (ecase phrase-head
                                (:replace
                                 (push `(,guard (push ,phrase-body ,new-children))
                                       conditional-exprs))
                                (:splice
                                 (push `(,guard (setf ,new-children
                                                 (nconc (reverse ,phrase-body)
                                                        ,new-children)))
                                       conditional-exprs))))))))
           :finally (return (values (nreverse unconditional-exprs)
                                    (nreverse conditional-exprs)
                                    (nreverse remove-check-exprs))))
       `(let ((,top-var ,top))
          (loop
            :with ,frontier := (make-queue ,top-var)
            :until (empty-queue ,frontier)
            :for ,parent := (dequeue ,frontier)
            :for ,new-children := (loop
                                    :with ,new-children := nil
                                    :for ,node :in (children ,parent)
                                    ,@(when unconditional-exprs
                                        (cons :do unconditional-exprs))
                                    :unless (or ,@remove-check-exprs)
                                      :do (cond
                                            ,@conditional-exprs
                                            (t (push ,node ,new-children)))
                                    :finally (return  (nreverse ,new-children)))
            :do (setf (children ,parent) ,new-children)
                (enqueue* ,frontier (remove-if-not #'elemp ,new-children)))
          ,top-var)))))

(argot:deflanguage dom-transform ()
  (<walk>
   :match (:seq (:@ top (:item))
                (:@ vars <var-declare>)
                (:@ clauses (:+ <clause>)) (:eof))
   :then (expand-walk top vars clauses))
  (<var-declare>
   :match (:item)
   :if var-pair-p
   :note "Variable declaration (node var)")
  (<clause>
   :match (:or <if-clause> <unconditional-clause>))
  (<unconditional-clause>
   :match (:seq (:= :do) (:item)))
  (<if-clause>
   :match (:seq (:= :if) (:item) <action-phrase>))
  (<action-phrase>
   :match (:or <remove-phrase> <replace-phrase> <splice-phrase>))
  (<remove-phrase>
   :match (:= :remove)
   :note "Removes the node from the tree, including all its children.")
  (<replace-phrase>
   :match (:seq (:= :replace) (:item))
   :note "Expression should return a DOM-NODE")
  (<splice-phrase>
   :match (:seq (:= :splice) (:item))
   :note "Expression should return a list of DOM-NODEs. These will be inserted
in place of the current node, and WALK will visit the first of these
nodes next."))