root

(ns zipexample (:require [clojure.zip :as z]))

;; Example use of zipper to edit a vector with not so straight-forward rules
;; (no children/bransches are used in this case!)

;; Lets assume we have some more or less unstructured facts about animals
;; that we want to put together as some report (maybe as HTML later on).

(def example-data
  [{:header "Elephants"
    :text "Elephants are the only mammals that can’t jump!"
    :category :elephant
    :original-id 1}
   {:header "Sloths"
    :text "Sloths are so slow that algae can grow on their fur!"
    :category :sloth
    :original-id 2}
   {:header "Octopuses"
    :text "An octopus has three hearts and blue blood!"
    :page-break? true
    :category :octopus
    :original-id 3}
   {:header "Penguins"
    :text "Penguins propose to their mates by giving them a pebble!"
    :category :penguin
    :original-id 4}
   {:type :something-unrelated
    :original-id 5}
   {:image "elephant.jpg"
    :category :elephant
    :original-id 6}
   {:text "Famous octopus monster: Kraken"
    :category :octopus
    :original-id 7}
   {:text "Cats"
    :category :cat
    :original-id 8}])

;; Some arbitrary rules that can be seen in the wild:

;; 1. A :page-break? key in an item should be converted to a
;; separate page-break entity {:type :page-break} before the item.

;; 2. Everything in the same :category should be placed together,
;; at the place where the category first occurs.

;; 3. Everything else should be left as is un-touched and in order.

;; Since we are moving a lot of stuff around, it would be nice
;; if we could move things around and insert stuff in between other items etc.

;; We can do this with zippers:

;; current structure [{ }, { }, { }, { }, { }, { }, { }, { }]

;; The rules above as functions taking and returning a zipper location

(defn maybe-insert-page-break 
  "inserts a pagebreak before an item with :page-break? true."
  [loc]

  ;; ... {:page-break? true :a :b ...}, ... ->
  ;; ... {:type :page-break}, {:a :b ...}, ...

  (let [current-node (z/node loc)]
    (if (:page-break? current-node)
      (-> loc
          (z/insert-left {:type :page-break})
          (z/edit dissoc :page-break?)) ;;important!
      loc)))

(defn maybe-sort-item
  "If the location has a :category and is not already :sorted?
  search for the latest earlier node with the same category
  and put the item after that node.

  NOTE that this sorting has quadratic complexity, which 
  means it scales bad for larger collections."
  [original-loc]
  (let [current-node (z/node original-loc)
        current-category (:category current-node)]
    
    ;; to avoid eternal loops we add a :sorted? key on
    ;; all items that has been exposed to this sorting process
    (if (or (:sorted? current-node)
            (not current-category))
      ;; do nothing, return original location
      original-loc
      ;; we have some category on current node
      ;; create a new collection where the current item
      ;; is not there
      (loop [loc-back (z/remove original-loc)]
        ;; remove current node and move back one step
        (if (nil? loc-back)
          ;; if loc is nil we are now at the beginning of the collection.
          ;; Abort mission!
          ;; [_*_ { }, ... ] 
          ;; return the original loc, but with :sorted? true
          ;; set on the item. All this walk backwards is discarded,
          ;; (thanks to our persistent data structures).
          (z/edit original-loc assoc :sorted? true)

          ;; there was some earlier node, compare the category
          (let [compare-node (z/node loc-back)]
            ;; ... {:category :X :prev :node :sorted? true} ...
            (if (= (:category compare-node ::no-category) current-category)
              ;; same category found! insert the current node
              ;; after this found node!
              ;; ... {:category :X :prev :node :sorted? true}, {:category :X :sorted? true} ...
              ;; we continue in the outer loop, where :sorted? true are ignored
              (z/insert-right loc-back (assoc current-node :sorted? true))
                           
              ;; else continue the backwards search!
              (recur (z/left loc-back)))))))))

(defn process [data]
  ;; we start here: [ *{ }*, { }, { }, { }, { }, { }, { }, { }]     
  (loop [loc (z/down (z/vector-zip data))]           
    (let [loc (-> loc
                  (maybe-insert-page-break)
                  (maybe-sort-item)
                  ;; add more rules here!
                  )          
          next-loc (z/right loc)]

      ;; nil means we are at the end of the collection,
      (if (some? next-loc)
        ;; continue with next location until done.
        (recur next-loc)
        ;; no next location, we have reached the end of the collection:
        ;; run clojure.zip/root which realizes the whole collection with all edits
        (z/root loc)))))

(def end-result (process example-data))
;;=>

[{:header "Elephants",
  :text "Elephants are the only mammals that can’t jump!",
  :category :elephant,
  :original-id 1,
  :sorted? true}
  ;;elephant image moved to the first occurence of :elephant.
 {:image "elephant.jpg",
  :category :elephant,
  :original-id 6,
  :sorted? true}

 {:header "Sloths",
  :text "Sloths are so slow that algae can grow on their fur!",
  :category :sloth,
  :original-id 2,
  :sorted? true}
 
 {:type :page-break}
 ;; a page break item was inserted before this item:
 {:header "Octopuses",
  :text "An octopus has three hearts and blue blood!",
  :category :octopus,
  :original-id 3,
  :sorted? true}
  ;; this was moved to it's first :octopus
 {:text "Famous octopus monster: Kraken",
  :category :octopus,
  :original-id 7,
  :sorted? true}

 ;; untouched 
 {:header "Penguins",
  :text "Penguins propose to their mates by giving them a pebble!",
  :category :penguin,
  :original-id 4,
  :sorted? true}
 ;; untouched
 {:type :something-unrelated, :original-id 5}

 ;; ...
 ;; things here was moved
 ;; ...

 ;; untouched
 {:text "Cats", :category :cat, :original-id 8, :sorted? true}]


;; We need to put various markers like :sorted? on items to avoid eternal loops.
;; This is common in mutable algorithms, but almost never needed 
;; when using functional algoritms on persistent data structures.

;; Apart from this I think it is quite apparent how to add more rules
;; to the processing while keeping the code not too weird.