hara.zip data traversal in style

Author: Chris Zheng  (z@caudate.me)
Date: 29 June 2017
Repository: https://github.com/zcaudate/hara
Version: 2.5.10

1    Introduction

hara.zip provides a customisable zipper implementation for navigating datastructures

1.1    Installation

Add to project.clj dependencies:

[im.chit/hara.zip "2.5.10"]
All functionality is found contained in the hara.zip namespace
(require '[hara.zip :as zip])

2    Index

3    API

3.1    Basics



zipper ^

constructs a zipper

v 2.4
(defn zipper
  ([root {:keys [branch? children make-node] :as meta}]
   (map->Zipper {:left ()
                 :right (list root)
                 :parent :top
                 :meta (zipper-meta meta)})))
link
(zipper '(1 2 3) {:branch? seq? :children identity :make-node identity}) => zipper?

seq-zip ^

constructs a sequence zipper

v 2.4
(defn seq-zip
  [root]
  (zipper root {:branch?   seq?
                :children  identity
                :make-node identity}))
link
(seq-zip '(1 2 3 4 5)) => (contains {:left (), :right '((1 2 3 4 5)), :parent :top})

vector-zip ^

constructs a vector based zipper

v 2.4
(defn vector-zip
  [root]
  (zipper root {:branch? vector?
                :children seq
                :make-node vec}))
link
(vector-zip [1 2 3 4 5]) => (contains {:left (), :right '([1 2 3 4 5]) :parent :top})

up ^

move cursor up

v 2.4
(defn up
  [zip]
  (base/move-up zip))
link
(-> (from-cursor [1 '| 2 3]) (up) (cursor)) => '(| [1 2 3]) (-> (from-cursor [1 [['| 2] 3]]) (up) (cursor)) => '([1 [| [2] 3]])

down ^

move cursor down

v 2.4
(defn down
  [zip]
  (base/move-down zip))
link
(-> (from-cursor '[1 [| [2] 3]]) (down) (cursor)) => '([1 [[| 2] 3]])

left ^

move cursor left

v 2.4
(defn left
  [zip]
  (base/move-left zip))
link
(-> (from-cursor [1 '| 2 3]) (left) (cursor)) => '([| 1 2 3])

right ^

move cursor right

v 2.4
(defn right
  [zip]
  (base/move-right zip))
link
(-> (from-cursor [1 '| 2 3]) (right) (cursor)) => '([1 2 | 3])

end ^

move cursor to the end of the tree

v 2.4
(defn end
  [zip]
  (cond (nil? zip) nil

        (base/move-right? (base/move-right zip))
        (recur (base/move-right zip))

        (base/move-down? zip)
        (recur (base/move-down zip))

        :else zip))
link
(->> (vector-zip [1 [2 [6 7] 3] [4 5]]) (end) (cursor)) => '([1 [2 [6 7] 3] [4 | 5]])

cursor ^

returns the form with the cursor showing

v 2.4
(defn cursor
  [zip]
  (event/manage
   (-> zip
       (base/insert-left '|)
       (base/move-top-most)
       (base/siblings))
   (on {:fn :insert-left :tag :at-top} [zip element]
       (event/continue (base/insert-base zip element :left :insert-left)))))
link
(-> (vector-zip [1 [[2] 3]]) (find-next even?) (cursor)) => '([1 [[| 2] 3]])

cursor-str ^

returns the string form of the cursor

v 2.4
(defn cursor-str
  [zip]
  (->> (cursor zip)
       (apply prn-str)
       (string/trim)))
link
(-> (vector-zip [1 [[2] 3]]) (find-next even?) (cursor-str)) => "[1 [[| 2] 3]]"

from-cursor ^

returns a zipper given a data structure with | as the cursor

v 2.4
(defn from-cursor
  [arr]
  (-> (vector-zip arr)
      (find-next  #(= '| %))
      (delete-right)))
link
(from-cursor '[1 2 3 | 4]) => (contains {:left '(3 2 1), :right '(4)})

next ^

move cursor through the tree in depth first order

v 2.4
(defn next
  [zip]
  (cond (nil? zip) nil

        (base/move-down? zip)
        (base/move-down zip)

        :else
        (let [zip (base/move-right zip)]
          (if (base/move-right? zip)
            zip
            
            (loop [zip (-> zip
                           (base/move-up)
                           (base/move-right))]
              (cond (base/top-most? zip)
                    nil
                    
                    (base/move-right? zip)
                    zip
                    
                    :else
                    (recur (-> zip
                               (base/move-up)
                               (base/move-right)))))))))
link
(->> (from-cursor '[| 1 [2 [6 7] 3] [4 5]]) (iterate next) (take-while identity) (map node)) => '(1 [2 [6 7] 3] 2 [6 7] 6 7 3 [4 5] 4 5)

prev ^

move cursor in reverse through the tree in depth first order

v 2.4
(defn prev
  [zip]
  (cond (nil? zip) nil
        
        (base/move-left? zip)
        (loop [zip (base/move-left zip)]
          (if (base/move-down? zip)
            (recur (-> zip
                       base/move-down
                       base/move-right-most
                       base/move-left))
            zip))

        (base/top-most? zip)
        nil

        :else
        (base/move-up zip)))
link
(->> (from-cursor '[1 [2 [6 7] 3] [4 | 5]]) (iterate prev) (take 10) (map node)) => '(5 4 [4 5] 3 7 6 [6 7] 2 [2 [6 7] 3] 1)

find-next ^

move cursor through the tree in depth first order to the first matching element

v 2.4
(defn find-next
  [zip pred]
  (->> (iterate next zip)
       (drop 1)
       (take-while identity)
       (filter #(try (pred (node %))
                     (catch Throwable t)))
       (first)))
link
(-> (vector-zip [1 [2 [6 7] 3] [4 5]]) (find-next #(= 7 %)) (cursor)) => '([1 [2 [6 | 7] 3] [4 5]])

find-prev ^

move cursor through the tree in reverse order to the last matching element

v 2.4
(defn find-prev
  [zip pred]
  (->> (iterate prev zip)
       (drop 1)
       (take-while identity)
       (filter #(try (pred (node %))
                     (catch Throwable t)))
       (first)))
link
(-> (from-cursor '[1 [2 [6 | 7] 3] [4 5]]) (find-prev even?) (cursor)) => '([1 [2 [| 6 7] 3] [4 5]])

3.2    Direction



move-up ^

move up from current position

v 2.4
(defn move-up
  ([zip]
   (cond (top-most? zip)
         (event/raise {:fn  :move-up
                       :op  :move
                       :tag :at-top
                       :zip zip}
                      "At Top Node"
                      (option :zip [] zip)
                      (default :zip))

         (not (:changed? zip))
         (->  (:parent zip)
              (assoc :meta (:meta zip))
              (add-history [:up]))
         
         :else
         (let [{:keys [left right parent levels]} zip
               children ((-> zip :meta :make-node)
                         (concat (reverse left) right))]
           (-> parent
               (assoc :changed? true :meta (:meta zip))
               (update-in [:right] #(->> % rest (cons children)))
               (add-history [:up])))))
  ([zip num]
   (nth (iterate move-up zip) num)))
link
(-> (zip/from-cursor '[1 2 [| 3 4]]) (move-up) (zip/cursor)) => '([1 2 | [3 4]])

move-down ^

move down from current position

v 2.4
(defn move-down
  ([zip]
   (cond (right-most? zip)
         (event/raise {:fn  :move-down
                       :op  :move
                       :tag :no-right
                       :zip zip}
                      "No Right Node"
                      (option :zip [] zip)
                      (default :zip))

         :else
         (let [rnode   (right-node zip)
               branch?  (-> zip :meta :branch?)]
           (cond (branch? rnode)
                 (let [children (-> zip :meta :children)
                       coll (children rnode)]
                   (-> zip
                       (assoc :left () :right coll :parent zip)
                       (add-history [:down])))
                 
                 :else
                 (event/raise {:fn  :move-down
                               :op  :move
                               :tag :not-branch
                               :zip zip}
                              "Not Branch Node"
                              (option :zip [] zip)
                              (default :zip))))))
  ([zip num]
   (nth (iterate move-down zip) num)))
link
(-> (zip/from-cursor '[1 2 | [3 4]]) (move-down) (zip/cursor)) => '([1 2 [| 3 4]])

move-left ^

move left from current position

v 2.4
(defn move-left
  ([{:keys [left right] :as zip}]
   (cond (empty? left)
         (event/raise {:fn  :move-left
                       :op  :move
                       :tag :no-left
                       :zip zip}
                      "No Left Node"
                      (option :zip [] zip)
                      (default :zip))

         :else
         (-> zip
             (assoc :left (rest left))
             (assoc :right (cons (first left) right))
             (add-history [:left]))))
  ([zip num]
   (nth (iterate move-left zip) num)))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (move-left) (zip/cursor)) => '([1 2 [3 | 4]])

move-right ^

move right from current position

v 2.4
(defn move-right
  ([{:keys [left right] :as zip}]
   (cond (empty? right)
         (event/raise {:fn  :move-right
                       :op  :move
                       :tag :no-right
                       :zip zip}
                      "No Right Node"
                      (option :zip [] zip)
                      (default :zip))

         :else
         (-> zip
             (assoc :left (cons (first right) left))
             (assoc :right (rest right))
             (add-history [:right]))))
  ([zip num]
   (nth (iterate move-right zip) num)))
link
(-> (zip/from-cursor '[1 2 [| 3 4]]) (move-right) (zip/cursor)) => '([1 2 [3 | 4]])

move-top-most ^

move to top-most point of the tree

v 2.4
(defn move-top-most
  [zip]
  (if (top-most? zip)
    zip
    
    (recur (move-up zip))))
link
(-> (zip/from-cursor '[1 2 [| 3 4]]) (move-top-most) (zip/cursor)) => '(| [1 2 [3 4]])

move-bottom-most ^

move to bottom-most point of current branch

v 2.4
(defn move-bottom-most
  [zip]
  (if (bottom-most? zip)
    zip
    
    (recur (move-down zip))))
link
(-> (zip/from-cursor '[1 2 | [[3] 4]]) (move-bottom-most) (zip/cursor)) => '([1 2 [[| 3] 4]])

move-left-most ^

move to left-most point of current branch

v 2.4
(defn move-left-most
  [zip]
  (cond (move-left? zip)
        (recur (move-left zip))

        :else zip))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (move-left-most) (zip/cursor)) => '([1 2 [| 3 4]])

move-right-most ^

move to right-most point of current branch

v 2.4
(defn move-right-most
  [zip]
  (cond (move-right? zip)
        (recur (move-right zip))

        :else zip))
link
(-> (zip/from-cursor '[1 2 [| 3 4]]) (move-right-most) (zip/cursor)) => '([1 2 [3 4 |]])

move-up? ^

check if can move up from current position

v 2.4
(defn move-up?
  [zip]
  (not= :top (:parent zip)))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (move-up?)) => true

move-down? ^

check if can move down from current position

v 2.4
(defn move-down?
  [zip]
  (and (move-right? zip)
       ((-> zip :meta :branch?)
        (first (:right zip)))))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (move-down?)) => false (-> (zip/from-cursor '[1 2 | [3 4]]) (move-down?)) => true

move-left? ^

check if can move left from current position

v 2.4
(defn move-left?
  [zip]
  (not (empty? (:left zip))))
link
(-> (zip/from-cursor '[1 2 [3 | 4]]) (move-left?)) => true (-> (zip/from-cursor '[1 2 [| 3 4]]) (move-left?)) => false

move-right? ^

check if can move right from current position

v 2.4
(defn move-right?
  [zip]
  (not (empty? (:right zip))))
link
(-> (zip/from-cursor '[1 2 [3 | 4]]) (move-right?)) => true (-> (zip/from-cursor '[1 2 [3 4 |]]) (move-right?)) => false

top-most? ^

check if at top-most point of the tree

v 2.4
(defn top-most?
  [zip]
  (= :top (:parent zip)))
link
(-> (zip/from-cursor [1 2 [3 4 '|]]) (top-most?)) => false (-> (zip/from-cursor '[1 2 [3 4 |]]) (move-up) (move-up) (top-most?)) => true

bottom-most? ^

check if at bottom-most point of a branch

v 2.4
(defn bottom-most?
  [zip]
  (or (empty? (:right zip))
      (not ((-> zip :meta :branch?)
            (first (:right zip))))))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (bottom-most?)) => true

left-most? ^

check if at left-most point of a branch

v 2.4
(defn left-most?
  [zip]
  (empty? (:left zip)))
link
(-> (zip/from-cursor [1 2 ['| 3 4]]) (left-most?)) => true

right-most? ^

check if at right-most point of a branch

v 2.4
(defn right-most?
  [zip]
  (empty? (:right zip)))
link
(-> (zip/from-cursor '[1 2 [3 4 |]]) (right-most?)) => true

3.3    Elements



node ^

accesses the node directly right of the cursor

v 2.4
(defn node
  [zip]
  (base/right-node zip))
link
(-> (from-cursor [1 '| 2 3]) (node)) => 2

siblings ^

all elements left and right of current position

v 2.4
(defn siblings
  [{:keys [left right] :as zip}]
  (concat (reverse left) right))
link
(-> (zip/from-cursor '[1 2 | 3 4]) (siblings)) => '(1 2 3 4) (-> (zip/from-cursor '[1 [2 | 3] 4]) (siblings)) => '(2 3)

left-node ^

element directly left of current position

v 2.4
(defn left-node
  [zip]
  (first (:left zip)))
link
(-> (zip/from-cursor '[1 2 3 | 4]) (left-node)) => 3

right-node ^

element directly right of current position

v 2.4
(defn right-node
  [zip]
  (first (:right zip)))
link
(-> (zip/from-cursor '[1 2 3 | 4]) (right-node)) => 4

left-nodes ^

all elements left of current position

v 2.4
(defn left-nodes
  [zip]
  (reverse (:left zip)))
link
(-> (zip/from-cursor '[1 2 | 3 4]) (left-nodes)) => '(1 2)

right-nodes ^

all elements right of current position

v 2.4
(defn right-nodes
  [zip]
  (:right zip))
link
(-> (zip/from-cursor '[1 2 | 3 4]) (right-nodes)) => '(3 4)

root-node ^

accesses the top level node

v 2.4
(defn root-node
  [zip]
  (-> zip base/move-top-most base/right-node))
link
(-> (vector-zip [[[3] 2] 1]) (move-bottom-most) (root-node)) => [[[3] 2] 1]

3.4    Editing



delete-left ^

delete element/s left of the current position

v 2.4
(defn delete-left
  ([{:keys [left] :as zip}]
   (cond (empty? left)
         (event/raise {:fn  :delete-left
                       :op  :delete
                       :tag :no-left
                       :zip zip}
                      "No Left Node")
         
         (top-most? zip)
         (event/raise {:fn  :delete-left
                       :op  :delete
                       :tag :at-top
                       :zip zip}
                      "At Top Node")

         :else
         (delete-base zip :left :delete-left)))
  ([zip num]
   (nth (iterate delete-left zip) num)))
link
(-> (zip/from-cursor '[1 2 | 3]) (delete-left) (zip/cursor)) => '([1 | 3])

delete-right ^

delete element/s right of the current position

v 2.4
(defn delete-right
  ([{:keys [right] :as zip}]
   (cond (empty? right)
         (event/raise {:fn  :delete-right
                       :op  :delete
                       :tag :no-right
                       :zip zip}
                      "No Right Node")

         (top-most? zip)
         (event/raise {:fn  :delete-right
                       :op  :delete
                       :tag :at-top
                       :zip zip}
                      "At Top Node")

         :else
         (delete-base zip :right :delete-left)))
  ([zip num]
   (nth (iterate delete-right zip) num)))
link
(-> (zip/from-cursor '[1 2 | 3]) (delete-right) (zip/cursor)) => '([1 2 |])

insert-left ^

insert element/s left of the current position

v 2.4
(defn insert-left
  ([zip element]
   (cond (top-most? zip)
         (event/raise {:fn  :insert-left
                       :op  :insert
                       :tag :at-top
                       :zip zip
                       :element element}
                      "At Top Node")

         :else
         (insert-base zip element :left :insert-left)))
  ([zip element & more]
   (apply insert-left (insert-left zip element) more)))
link
(-> (zip/from-cursor '[1 2 [[| 3] 4]]) (insert-left 1 2 3) (zip/cursor)) => '([1 2 [[1 2 3 | 3] 4]])

insert-right ^

insert element/s right of the current position

v 2.4
(defn insert-right
  ([zip element]
   (cond (top-most? zip)
         (event/raise {:fn  :insert-right
                       :op  :insert
                       :tag :at-top
                       :zip zip
                       :element element}
                      "At Top Node")

         :else
         (insert-base zip element :right :insert-right)))
  ([zip element & more]
   (apply insert-right (insert-right zip element) more)))
link
(-> (zip/from-cursor '[| 1 2 3]) (insert-right 1 2 3) (zip/cursor)) => '([| 3 2 1 1 2 3])

replace-left ^

replace element left of the current position

v 2.4
(defn replace-left
  [{:keys [left] :as zip} element]
  (cond (empty? left)
        (event/raise {:fn  :replace-left
                      :op  :replace
                      :tag :no-left
                      :zip zip}
                     "No Left Node")

        :else
        (-> zip
            (update-in [:left] #(->> % rest (cons element)))
            (assoc :changed? true)
            (update-in [:meta :history] conj :replace-left))))
link
(-> (zip/from-cursor '[1 2 | 3]) (replace-left "10") (zip/cursor)) => '([1 "10" | 3])

replace-right ^

replace element right of the current position

v 2.4
(defn replace-right
  [{:keys [right] :as zip} element]
  (cond (empty? right)
        (event/raise {:fn  :replace-right
                      :op  :replace
                      :tag :no-right
                      :zip zip}
                     "No Right Node")

        :else
        (-> zip
            (update-in [:right] #(->> % rest (cons element)))
            (assoc :changed? true)
            (update-in [:meta :history] conj :replace-right))))
link
(-> (zip/from-cursor '[1 2 | 3]) (replace-right "10") (zip/cursor)) => '([1 2 | "10"])

prewalk ^

emulates clojure.walk/prewalk behavior with zipper

v 2.4
(defn prewalk
  [zip f]
  (let [zip (base/replace-right zip (f (base/right-node zip)))]
    (cond (base/move-down? zip)
          (loop [zip (base/move-down zip)]
            (let [zip  (-> (prewalk zip f)
                           (base/move-right))]
              (cond (base/move-right? zip)
                    (recur zip)
                    
                    :else
                    (base/move-up zip))))
          
          :else zip)))
link
(-> (vector-zip [1 [2 [6 7] 3] [4 5]]) (prewalk (fn [v] (if (vector? v) (conj v 100) (+ v 100)))) (root-node)) => [101 [102 [106 107 200] 103 200] [104 105 200] 200]

postwalk ^

emulates clojure.walk/postwalk behavior with zipper

v 2.4
(defn postwalk
  [zip f]
  (let [zip (cond (base/move-down? zip)
                  (loop [zip (base/move-down zip)]
                    (let [zip  (-> (prewalk zip f)
                                   (base/move-right))]
                      (cond (base/move-right? zip)
                            (recur zip)
                            
                            :else
                            (base/move-up zip))))
                  
                  :else zip)]
    (base/replace-right zip (f (base/right-node zip)))))
link
(-> (vector-zip [1 [2 [6 7] 3] [4 5]]) (find-next even?) (up) (postwalk (fn [v] (if (vector? v) (conj v 100) (+ v 100)))) (root-node)) => [1 [102 [106 107 200] 103 100] [4 5]]

surround ^

adds additional levels to the element

v 2.4
(defn surround
  ([zip]
   (cond (base/right-most? zip)
         (event/raise {:fn  :surround
                       :op  :insert
                       :tag :no-right
                       :zip zip}
                      "No Right Node")

         :else
         (let [rnode (base/right-node zip)
               make-node (-> zip :meta :make-node)
               new-node (make-node [rnode])]
           (-> zip
               (base/replace-right new-node)
               (base/move-down)))))
  ([zip num]
   (nth (iterate surround zip) num)))
link
(-> (vector-zip 1) (surround 2) (root-node)) => [[1]]

traverse ^

traverse through zipper with data

v 2.4
(defn traverse
  ([zip command]
   (let [[op args] (cond (keyword? command)
                         [command ()]

                         (vector? command)
                         [(first command) (rest command)]

                         :else (throw (Exception. (str "Invalid input: " command))))
         op-fn (op-lookup op)]
     (if (nil? op-fn)
       (throw (Exception. (str "Cannot find operation: " op
                               "values are: n"
                               (sort (keys op-lookup)))))
       (apply op-fn zip args))))
  ([zip command & more]
   (apply traverse (traverse zip command) more)))
link
(-> (traverse (vector-zip [1 [[2] 3]]) :down :right [:down 2] [:right] [:insert-right 1 2 3 4]) (cursor)) => '([1 [[2 | 4 3 2 1] 3]])

history ^

accesses the zipper history

v 2.4
(defn history
  [zip]
  (-> zip :meta :history))
link
(-> (vector-zip [1 [2 3]]) (move-down) (move-right) (history)) => [[:down] [:right]]

4    Boundaries

4.1    Default Behavior

How zippers respond when crossing boundaries can be set. In general, movement will not throw an exception:

(-> (zip/from-cursor '[1 2 |])
    (zip/move-right)
    (zip/cursor))
=> '([1 2 |])

(-> (zip/from-cursor '[| 1 2])
    (zip/move-left)
    (zip/cursor))
=> '([| 1 2])

Whilst deletions and replacements will.

(-> (zip/from-cursor '[1 2 |])
    (zip/delete-right))
  
=> (throws-info {:fn :delete-right
                 :op :delete
                 :tag :no-right})

(-> (zip/from-cursor '[| 1 2])
    (zip/replace-left 1))
=> (throws-info {:fn :replace-left,
                 :op :replace,
                 :tag :no-left})

4.2    Overrides

However, default behavior can be rewritten through the hara.event condition system. In this case a move-left call which previously resulted in the zipper staying where is is is now staring put:

(manage
 (-> (zip/from-cursor '[| 1 2])
     (zip/move-left))
 (on {:tag :no-left}
     e
     (fail)))
=> (throws-info {:fn :move-left,
                 :op :move,
                 :tag :no-left})

And a delete-right call which previously threw an exception will continue as normal:

(manage
 (-> (zip/from-cursor '[1 2 |])
     (zip/delete-right)
     (zip/cursor))
 (on {:tag :no-right}
     [zip]
     (continue zip)))
=> '([1 2 |])