Budapest Clojure User Group 2019 June

zippers.clj

;     root
;   / \     \
;  1  [2 3] [4 5]
;      /\    /\
;     2 3   4 5


(require '[clojure.zip :as zip])

(-> (zip/vector-zip [1 [2 3] [4 5]])
    (zip/down)
    (zip/right)
    (zip/down)
    (zip/node))

(defn ->zipper [node children-fn build-fn]
  ;; build :: node, [children] -> node
  ;; children :: node -> [node]
  {:build-fn    build-fn
   :children-fn children-fn
   :lefts       ()
   :rights      [node]
   :parent      nil})

(defn down [{:keys [build-fn children-fn rights] :as zipper}]
  (let [node (first rights)
        ch   (children-fn node)]
    {:build-fn    build-fn
     :children-fn children-fn
     :lefts       ()
     :rights      ch
     :parent      zipper}))

(defn node [zipper] (first (:rights zipper)))

(defn right [{:keys [lefts rights] :as zipper}]
  (when (next rights)
    (let [node (first rights)]
      (assoc zipper
             :lefts  (cons node lefts)
             :rights (next rights)))))

(defn left [{:keys [lefts rights] :as zipper}]
  (when (seq lefts)
    (let [node (first lefts)]
      (assoc zipper
             :lefts  (next lefts)
             :rights (cons node rights)))))

(defn edit [zipper edit-fn]
  (update zipper :rights (fn [[x & xs]] (cons (edit-fn x) xs))))

(defn up [{:keys [lefts rights parent build-fn] :as zipper}]
  (when parent
    (edit parent
          (fn [parent-node]
            (build-fn parent-node (into rights lefts))))))

(-> [1 [2 3] [4 5]]
    (->zipper seq (fn [node children] (vec children)))
    (down)
    (right)
    (down)
    (right) (left)
    ;;(node)
    (edit (constantly :ketto))
    (up)
    (up)
    (node))