 (ns com.billpiel.mem-tracer.query2
   (require [com.billpiel.mem-tracer.trace :as tr]
-           [clojure.zip :as z]
-           [com.billpiel.mem-tracer.util.tree-query :as tq]))
-
-
+           [clojure.zip :as z]))
+
+;; === zipper iterators
+
+(defn iter-while-identity
+  [f v]
+  (->> v
+       (iterate f)
+       (take-while identity)))
+
+(defn right-sib-zips
+  [z]
+  (->> z
+       (iter-while-identity z/right)
+       rest))
+
+(defn left-sib-zips
+  [z]
+  (->> z
+       (iter-while-identity z/left)
+       rest))
+
+(defn all-sib-zips [z]
+  (->> z
+       z/leftmost
+       right-sib-zips
+       (filter #(not (= % z)))))
+
+(defn parent-zips
+  [z]
+  (->> z
+       (iter-while-identity z/up)
+       rest))
+
+(defn children-zips [z]
+  (->> z
+       z/down
+       (iter-while-identity z/right)))
+
+
+;; === tags
+
+(defn get-tags
+  [node pred-map]
+  (vec (for [[kw pred] pred-map
+             :when (pred node)]
+         kw)))
+
+(defn get-tag-map
+  [tree pred-map]
+  (reduce (fn [tag-map node]
+            (assoc tag-map
+                   (:id node)
+                   (get-tags node pred-map)))
+          {}
+          (tree-seq map? :children tree)))
+
+(defn mk-get-tag-fn
+  [tag-map]
+  (fn [tree]
+    (-> tree
+        :id
+        tag-map)))
+
+;; === zippers
+
+(defn tree->zipper
+  [tree]
+  (z/zipper map?
+            #(-> % :children not-empty)
+            #(assoc % :children %2)
+            tree))
+
+(defn traverse-assoc-zipper
+  [zipr]
+  (if (z/end? zipr)
+    (-> zipr z/root)
+    (recur (-> zipr
+               (z/edit assoc :zipper zipr)
+               z/next))))
+
+(defn traverse-tree-assoc-zipper
+  [tree]
+  (-> tree
+      tree->zipper
+      traverse-assoc-zipper))
+
+;; move this to trace or utils?
+(defn traverse-tree
+  [tree f]
+  (assoc (f tree)
+         :children (mapv #(traverse-tree % f)
+                         (:children tree))))
+
+(defn traverse-tree-dissoc-zipper
+  [tree]
+  (traverse-tree tree #(dissoc % :zipper)))
+
+;; === query
 
 (defn query-tree
   [qry-fn tree]

      [e']
      (:children e'))))


(defn get-tags
  [node pred-map]
  (vec (for [[kw pred] pred-map
             :when (pred node)]
         kw)))

#_ (defn tag-tree
  [tree pred-map-fn]
  (-> tree
      (with-meta {::tags (get-tags tree)})
      (update-in [:children] #(mapv tag-tree
                                    %))))

(defn get-tag-map
  [tree pred-map]
  (reduce (fn [tag-map node]
            (assoc tag-map
                   (:id node)
                   (get-tags node pred-map)))
          {}
          (tree-seq map? :children tree)))

(defn mk-get-tag-fn
  [tag-map]
  (fn [tree]
    (-> tree
        :id
        tag-map)))

(defn tree->zipper
  [tree]
  (z/zipper map?
            #(-> % :children not-empty)
            #(assoc % :children %2)
            tree))

(defn traverse-assoc-zipper
  [zipr]
  (if (z/end? zipr)
    (-> zipr z/root)
    (recur (-> zipr
               (z/edit assoc :zipper zipr)
               z/next))))


(defn traverse-tree-assoc-zipper
  [tree]
  (-> tree
      tree->zipper
      traverse-assoc-zipper))

;; move this to trace or utils
(defn traverse-tree
  [tree f]
  (assoc (f tree)
         :children (mapv #(traverse-tree % f)
                         (:children tree))))

(defn traverse-tree-dissoc-zipper
  [tree]
  (traverse-tree tree #(dissoc % :zipper)))

(defn query-dos
  [tree pred-map pred-final-fn] ;; pred-final-fn takes a node (w/ :zipper) and fn to retrieve tags from a node
  (let [tag-map (get-tag-map tree pred-map)

       (map tags-fn)
       (some pred-fn)))

(defmacro defn-zipper->>
  [name & body]
  `(defn ~name
     [node#]
     (->> node#
          :zipper
          ~@body)))

(defmacro defn-tags-functor
  [name & body]
  `(defn ~name
     [node# tags-fn#]
     (->> node#
          ~@body
          (map z/node)
          (map tags-fn#))))

(defn-zipper->> lazy-ancestor-tag-seq parent-zips)

(defn-tags-functor lazy-ancestor-tag-seq lazy-ancestor-zipr-seq)

(defn some-tags
  [tag-set tag-seq]
