handmade zippers

zippers.clj

(def seq-zip
     (fn [tree] 
        {:here tree
         :parents '()
         :lefts '()
         :rights '()}))

(def zdown
     (fn [zipper] (if  (empty? (:here zipper))
                       nil
                       {:here (first (:here zipper))
                        :parents (conj (:parents zipper) zipper)
                        :lefts '()
                        :rights (rest (:here zipper))})))

(def zup
     (fn [zipper] (if (empty? (:parents zipper))
                      nil
                      (if (:changed zipper)
                          (zreplace (first (:parents zipper))
                                    (concat (:lefts zipper) (list (:here zipper)) (:rights zipper)))
                          (first (:parents zipper))))))

(def zright
  (fn [zipper] (if (empty? (:rights zipper))
                    nil
                    (assoc zipper 
                      :here (first (:rights zipper))
                      :rights (rest (:rights zipper))
                      :lefts (concat (:lefts zipper) (list (:here zipper)))
                      ))))

(def zleft
     (fn [zipper] (if (empty? (:lefts zipper))
                      nil
                      (assoc zipper 
                             :here (first (:lefts zipper))
                             :lefts (rest (:lefts zipper))
                             :rights (concat (:rights zipper) (list (:here zipper)))
                   ))))


(def znode
     (fn [zipper] (:here zipper)))

(def zroot
     (fn [zipper] (if (zup zipper)
                      (zroot (zup zipper))
                      (znode zipper))))

(def zreplace
     (fn [zipper subtree] (assoc zipper
                                 :here subtree
                                 :changed true)))

(assoc {:a 1} :b 2 :c 3)

(conj '(1 2 3) '(a b c))


(-> '(a b c) seq-zip znode)

(-> '(a b c) seq-zip zdown znode)
(-> '(a b c) seq-zip zdown zup znode)
(-> '((+ 1 2) 3 4) seq-zip zdown znode)
(-> '((+ 1 2) 3 4) seq-zip zdown zdown znode)

(-> '(a b c) seq-zip zup)
(-> '() seq-zip zdown)

(-> '(a) seq-zip zroot)
(-> '(((a)) b c) seq-zip zdown zdown zdown zroot)

(-> (seq-zip '(a b c)) zdown zright znode)
(-> (seq-zip '(a b c)) zdown zright zright zleft znode)
(-> (seq-zip '(a b c)) zdown zleft)
(-> (seq-zip '(a b c)) zdown zright zright zright)
(-> (seq-zip '(a b c)) zdown zup znode )


(-> (seq-zip '(a (b) c)) zdown zright zdown (zreplace 3)
    zroot)

(-> (seq-zip '(a (b) c)) zdown zright zdown (zreplace 3)
    zup zright (zreplace 4)
    zroot)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    zup
    znode)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    zright (zreplace 4) 
    zup
    znode)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    zup
    zup)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    znode)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    zright zleft
    znode)

(-> (seq-zip '(a b c)) zdown zright (zreplace 3)
    zleft  zright zright
    znode)