Retain zipper options after zipper operations

The internal rewrite-clj.custom-zipper.core down operation no longer
discards zipper metadata for the down operation, which means it is now
no longer discarding zipper options.

Also:
- zipper options moved to own internal namespace and refactored for
  clarity
- custom zipper internal comments/docs reviewed/refreshed

Fixes #159

Author: lread

CHANGELOG.adoc

@@ -16,7 +16,7 @@ For a list of breaking changes see link:#v1-breaking[breaking changes].
 
 === Unreleased
 
-* Internal rewrite-clj developer facing changes only
+* position tracking zippers now retain zipper options correctly https://github.com/clj-commons/rewrite-clj/issues/159[#159]
 
 === v1.0.644-alpha
 

src/rewrite_clj/custom_zipper/core.cljc

@@ -1,3 +1,5 @@
+; Interface and algorithms based on code in clojure.zip with is bundled with Clojure itself:
+
 ;   Copyright (c) Rich Hickey. All rights reserved.
 ;   The use and distribution terms for this software are covered by the
 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
@@ -9,11 +11,14 @@
 ;functional hierarchical zipper, with navigation, editing and enumeration
 ;see Huet
 
-(ns ^:no-doc ^{:doc "Functional hierarchical zipper, with navigation, editing,
-  and enumeration.  See Huet.
-  Modified to optionally support row col position tracking."
-       :author "Rich Hickey"}
-  rewrite-clj.custom-zipper.core
+(ns ^:no-doc rewrite-clj.custom-zipper.core
+  "This is the underlying zipper that rewrite-clj uses.
+
+   It delegates to two different zipper implementations:
+   1. the code herein under defn-switchable bodies when the user has created a `:position-tracking` zipper
+   2. otherwise clojure.zip, with some small exceptions:
+      - `edit` explicitly handles the delegation - I assume because defn-switchable could not handle the argument delegation
+      - there are fns exclusive to the position trakcing zipper, `position`, `position-span`"
   (:refer-clojure :exclude (replace remove next))
   (:require [clojure.zip :as clj-zip]
             [rewrite-clj.custom-zipper.switchable :refer [defn-switchable]]
@@ -22,10 +27,7 @@
 
 #?(:clj (set! *warn-on-reflection* true))
 
-;; ## Switch
-;;
-;; To not force users into using this custom zipper, the following flag
-;; is used to dispatch to `clojure.zip` when set to `false`.
+;; the custom zipper is used to support position-tracking, otherwise clojure.zip is used
 
 (defn custom-zipper
   [root]
@@ -107,12 +109,14 @@
     (let [{:keys [node] [row col] :position} zloc
           [c & cnext :as cs] (children zloc)]
       (when cs
-        {::custom? true
-         :node     c
-         :position [row (+ col (node/leader-length node))]
-         :parent   zloc
-         :left     []
-         :right    cnext}))))
+        (with-meta
+          {::custom? true
+           :node     c
+           :position [row (+ col (node/leader-length node))]
+           :parent   zloc
+           :left     []
+           :right    cnext}
+          (meta zloc))))))
 
 (defn-switchable up
   "Returns zipper with the location at the parent of current node in `zloc`, or nil if at

src/rewrite_clj/zip/base.cljc

@@ -4,19 +4,11 @@
             [rewrite-clj.node.forms :as nforms]
             [rewrite-clj.node.protocols :as node]
             [rewrite-clj.parser :as p]
+            [rewrite-clj.zip.options :as options]
             [rewrite-clj.zip.whitespace :as ws]))
 
 #?(:clj (set! *warn-on-reflection* true))
 
-(defn get-opts [zloc]
-  (:rewrite-clj.zip/opts (meta zloc)))
-
-(defn set-opts [zloc opts]
-  (with-meta zloc
-    (merge (meta zloc)
-           {:rewrite-clj.zip/opts (merge {:auto-resolve node/default-auto-resolve}
-                                         opts)})))
-
 ;; ## Zipper
 
 (defn edn*
@@ -31,7 +23,7 @@
    (-> (if (:track-position? opts)
          (zraw/custom-zipper node)
          (zraw/zipper node))
-       (set-opts opts))))
+       (options/set-opts opts))))
 
 (defn edn
   "Create and return zipper from Clojure/ClojureScript/EDN `node` (likely parsed by [[rewrite-clj.parse]]),
@@ -69,14 +61,14 @@
 
   See docs for [sexpr nuances](/doc/01-user-guide.adoc#sexpr-nuances)."
   ([zloc]
-   (some-> zloc zraw/node (node/sexpr (get-opts zloc)))))
+   (some-> zloc zraw/node (node/sexpr (options/get-opts zloc)))))
 
 (defn child-sexprs
   "Return s-expression (the Clojure forms) of children of current node in `zloc`.
 
   See docs for [sexpr nuances](/doc/01-user-guide.adoc#sexpr-nuances)."
   ([zloc]
-   (some-> zloc zraw/node (node/child-sexprs (get-opts zloc)))))
+   (some-> zloc zraw/node (node/child-sexprs (options/get-opts zloc)))))
 
 (defn length
   "Return length of printable [[string]] of current node in `zloc`."

src/rewrite_clj/zip/editz.cljc

@@ -6,6 +6,7 @@
             [rewrite-clj.node.token :as ntoken]
             [rewrite-clj.node.whitespace :as nwhitespace]
             [rewrite-clj.zip.base :as base]
+            [rewrite-clj.zip.options :as options]
             [rewrite-clj.zip.removez :as r]
             [rewrite-clj.zip.whitespace :as ws]))
 
@@ -37,7 +38,7 @@
 
   See docs for [sexpr nuances](/doc/01-user-guide.adoc#sexpr-nuances)."
   [zloc f & args]
-  (zraw/edit zloc (node-editor (base/get-opts zloc)) #(apply f % args)))
+  (zraw/edit zloc (node-editor (options/get-opts zloc)) #(apply f % args)))
 
 ;; ## Splice
 

src/rewrite_clj/zip/options.cljc

@@ -0,0 +1,14 @@
+(ns ^:no-doc rewrite-clj.zip.options
+  (:require [rewrite-clj.node.protocols :as protocols]))
+
+#?(:clj (set! *warn-on-reflection* true))
+
+(def default-zipper-opts
+  {:track-position? false
+   :auto-resolve protocols/default-auto-resolve})
+
+(defn get-opts [zloc]
+  (:rewrite-clj.zip/opts (meta zloc)))
+
+(defn set-opts [zloc opts]
+  (vary-meta zloc assoc :rewrite-clj.zip/opts (merge default-zipper-opts opts)))

src/rewrite_clj/zip/subedit.cljc

@@ -1,6 +1,7 @@
 (ns ^:no-doc rewrite-clj.zip.subedit
   (:require [rewrite-clj.custom-zipper.core :as zraw]
-            [rewrite-clj.zip.base :as base])
+            [rewrite-clj.zip.base :as base]
+            [rewrite-clj.zip.options :as options])
   #?(:cljs (:require-macros [rewrite-clj.zip.subedit])) )
 
 #?(:clj (set! *warn-on-reflection* true))
@@ -30,7 +31,7 @@
   [zloc path]
   (let [root (-> zloc 
                  zraw/root 
-                 (base/edn* (base/get-opts zloc)))]
+                 (base/edn* (options/get-opts zloc)))]
     (reduce move-step root path)))
 
 (defn edit-node
@@ -71,7 +72,7 @@
   [zloc]
   (let [zloc' (some-> zloc 
                       zraw/node 
-                      (base/edn* (base/get-opts zloc)))]
+                      (base/edn* (options/get-opts zloc)))]
     (assert zloc' "could not create subzipper.")
     zloc'))
 

test/rewrite_clj/zip/subedit_test.cljc

@@ -1,7 +1,7 @@
 (ns rewrite-clj.zip.subedit-test
   (:require [clojure.test :refer [deftest testing is]]
             [rewrite-clj.zip :as z]
-            [rewrite-clj.zip.base :as zbase]))
+            [rewrite-clj.zip.options :as options]))
 
 (deftest t-trees
   (let [root (z/of-string "[1 #{2 [3 4] 5} 6]")]
@@ -23,15 +23,15 @@
 
 (deftest zipper-retains-options
   (let [zloc (z/of-string "(1 (2 (3 4 ::my-kw)))" {:auto-resolve (fn [_x] 'custom-resolved)})
-        orig-opts (zbase/get-opts zloc)]
+        orig-opts (options/get-opts zloc)]
     (testing "sanity - without subzip"
       (is (= :custom-resolved/my-kw (-> zloc
                                         z/down z/right
                                         z/down z/right
                                         z/down z/rightmost z/sexpr))))
     (testing "subzip"
       (let [sub-zloc (-> zloc z/up* z/subzip z/down*)]
-        (is (= orig-opts (zbase/get-opts sub-zloc)))
+        (is (= orig-opts (options/get-opts sub-zloc)))
         (is (= :custom-resolved/my-kw (-> sub-zloc
                                           z/down z/right
                                           z/down z/right
@@ -43,7 +43,7 @@
                                         z/down z/right
                                         z/down (z/replace* 'x)))))]
         (is (= 'x (-> edited-zloc z/down z/right z/down z/sexpr)))
-        (is (= orig-opts (zbase/get-opts edited-zloc)))
+        (is (= orig-opts (options/get-opts edited-zloc)))
         (is (= :custom-resolved/my-kw (-> edited-zloc
                                           z/down z/right
                                           z/down z/right

test/rewrite_clj/zip_test.cljc

@@ -170,3 +170,74 @@
   ;; spot check, more thorough testing done on node tests
   (is (= false (-> "," z/of-string z/next* z/sexpr-able?)))
   (is (= true (-> "heyy" z/of-string z/sexpr-able?))))
+
+
+(deftest t-zipper-options-are-retained-after-operations
+  ;; use a custom auto-resolve to verify that options are still in effect on returned zippers
+  ;; test with both track-position true (rewrite-clj.custom-zipper.core) and false (clojure.zip)
+  (let [opts {:track-position? true
+              :auto-resolve (constantly 'testing123)}]
+    (doseq [opts [(assoc opts :track-position? false)
+                  opts]]
+      (let [zloc (z/of-string "[::kw1 ::kw2 ::kw3]" opts)
+            msg (fn [desc] (str desc " " (select-keys opts [:track-position?])))]
+        (is (= [:testing123/kw1 :testing123/kw2 :testing123/kw3] (z/sexpr zloc))
+            (msg "of-string"))
+        (is (= :testing123/kw1 (-> zloc z/down z/sexpr))
+            (msg "down"))
+        (is (= [:testing123/kw1 :testing123/kw2 :testing123/kw3] (-> zloc z/down z/up z/sexpr))
+            (msg "up"))
+        (is (= :testing123/kw2 (-> zloc z/down z/right z/sexpr))
+            (msg "right"))
+        (is (= :testing123/kw1 (-> zloc z/down z/right z/left z/sexpr))
+            (msg "left"))
+        (is (= :testing123/kw3 (-> zloc z/down z/rightmost z/sexpr))
+            (msg "rightmost"))
+        (is (= :testing123/kw1 (-> zloc z/down z/rightmost z/leftmost z/sexpr))
+            (msg "leftmost"))
+        (is (= :testing123/kw1 (-> zloc z/next z/sexpr))
+            (msg "next"))
+        (is (= :testing123/kw1 (-> zloc z/next z/next z/prev z/sexpr))
+            (msg "prev"))
+        (is (= ["child" :testing123/kw1 :testing123/kw2 :testing123/kw3]
+               (-> zloc (z/insert-child "child") z/sexpr))
+            (msg "append-child"))
+        (is (= [:testing123/kw1 :testing123/kw2 :testing123/kw3 "child"]
+               (-> zloc (z/append-child "child") z/sexpr))
+            (msg "append-child"))
+        (is (= [:testing123/kw1 ":testing123/kw2-edited" :testing123/kw3]
+               (-> zloc z/down z/right (z/edit str "-edited") z/up z/sexpr))
+            (msg "edit"))
+        (is (= ["inserted" :testing123/kw1 :testing123/kw2 :testing123/kw3]
+               (-> zloc z/down (z/insert-left "inserted") z/up z/sexpr))
+            (msg "insert-left"))
+        (is (= [:testing123/kw1 "inserted" :testing123/kw2 :testing123/kw3]
+               (-> zloc z/down (z/insert-right "inserted") z/up z/sexpr))
+            (msg "insert-right"))
+        (is (= ["replaced" :testing123/kw2 :testing123/kw3]
+               (-> zloc z/down (z/replace "replaced") z/up z/sexpr))
+            (msg "replace"))
+        (is (= ["inserted" :testing123/kw1 :testing123/kw2 :testing123/kw3]
+               (-> zloc (z/insert-child "inserted") z/sexpr))
+            (msg "insert-child"))
+        (is (= [:testing123/kw2 :testing123/kw3]
+               (-> zloc z/down z/remove z/sexpr))
+            (msg "remove"))
+        (is (= ["insert-left" "insert-child" "insert-right" "replace" :testing123/kw2 "append-child-edited"]
+               (-> zloc z/down* z/up*
+                   z/down* z/rightmost* z/leftmost* z/up*
+                   z/next* z/prev*
+                   (z/insert-child* (n/spaces 1))
+                   (z/insert-child* (n/string-node "insert-child"))
+                   (z/append-child* (n/spaces 1))
+                   (z/append-child* (n/string-node "append-child"))
+                   z/down*  (z/insert-left* (n/string-node "insert-left")) (z/insert-left* (n/spaces 1))
+                            (z/insert-right* (n/string-node "insert-right")) (z/insert-right* (n/spaces 1)) z/up*
+                   z/down* z/rightmost* (z/edit* (fn [n] (n/string-node
+                                                          (str (n/sexpr n) "-edited")))) z/up*
+                   z/down* z/right* z/right* z/right* z/right* z/right* z/right* 
+                           (z/replace* (n/string-node "replace")) z/up*
+                   z/down* z/rightmost* z/left* z/left* z/remove* z/up*
+                   z/sexpr))
+            (msg "raw ops sanity test"))))))
+