Fixed whitespace-handling in 'remove', restricted 'splice' behaviour.

Author: Yannick Scherer

CHANGES.md

@@ -8,8 +8,13 @@
 - new functions in `rewrite-clj.zip.core`:
   - `length`
   - `move-to-node`
-  - `edit->>`
-- added removal of a single whitespace character to `rewrite-clj.zip/remove`.
+  - `edit->>`, `edit-node`
+  - `subedit->`, `subedit->>`, `edit-children`
+  - `leftmost?`, `rightmost?`
+- new functions in `rewrite-clj.zip.edit`:
+  - `splice-or-remove`
+  - `prefix`, `suffix` (formerly `rewrite-clj.zip.utils`)
+- `rewrite-clj.zip.edit/remove` now handles whitespace appropriately.
 - indentation-aware modification functions in `rewrite-clj.zip.indent`:
   - `indent`
   - `indent-children`
@@ -19,6 +24,7 @@
   - `insert-right
   - `remove`
   - `splice`
+- fast-zip utility functions in `rewrite-clj.zip.utils`
 
 ### 0.2.0
 

src/rewrite_clj/zip.clj

@@ -27,6 +27,7 @@
 
    edn tag value length sexpr
    whitespace? linebreak? 
+   leftmost? rightmost?
    skip-whitespace skip-whitespace-left
    prepend-space append-space
    prepend-newline append-newline
@@ -50,7 +51,8 @@
 
    insert-right insert-left
    insert-child append-child
-   replace edit remove splice
+   replace edit remove 
+   splice splice-or-remove
    prefix suffix]
 
   [rewrite-clj.zip.seqs

src/rewrite_clj/zip/core.clj

@@ -7,7 +7,8 @@
 
 ;; ## Zipper
 
-(declare skip-whitespace)
+(declare skip-whitespace
+         skip-whitespace-left)
 
 (defn- z-branch?
   [node]
@@ -71,6 +72,16 @@
   [zloc]
   (= (tag zloc) :newline))
 
+(defn leftmost?
+  "Check if the given zipper is at the leftmost non-whitespace position."
+  [zloc]
+  (nil? (skip-whitespace-left (z/left zloc))))
+
+(defn rightmost?
+  "Check if the given zipper is at the rightmost non-whitespace position."
+  [zloc]
+  (nil? (skip-whitespace (z/right zloc))))
+
 ;; ## Skip
 
 (defn skip

src/rewrite_clj/zip/edit.clj

@@ -4,24 +4,13 @@
   (:refer-clojure :exclude [replace remove])
   (:require [fast-zip.core :as z]
             [rewrite-clj.convert :as conv]
-            [rewrite-clj.zip.core :as zc]))
+            [rewrite-clj.zip.core :as zc]
+            [rewrite-clj.zip.utils :as zu]))
 
 ;; ## Helpers
 
 (def ^:private ^:const SPACE [:whitespace " "])
 
-(defn- remove-trailing-space
-  "Remove a single whitespace character after the given node."
-  [zloc]
-  (or
-    (when-let [ws (z/right zloc)]
-      (when (= (zc/tag ws) :whitespace)
-        (let [w (dec (zc/length ws))]
-          (-> ws
-            (z/replace [:whitespace (apply str (repeat w \space))])
-            z/left))))
-    zloc))
-
 ;; ## Insert
 
 (defn insert-right
@@ -73,28 +62,65 @@
   (let [form (zc/sexpr zloc)]
     (z/replace zloc (conv/->tree (apply f form args)))))
 
+;; ## Remove
+
+(defn- remove-trailing-space
+  "Remove all whitespace following a given node."
+  [zloc]
+  (loop [zloc zloc]
+    (if-let [rloc (z/right zloc)]
+      (if (zc/whitespace? rloc)
+        (recur (zu/remove-right zloc))
+        zloc)
+      zloc)))
+
+(defn- remove-preceding-space
+  [zloc]
+  (loop [zloc zloc]
+    (if-let [lloc (z/left zloc)]
+      (if (zc/whitespace? lloc)
+        (recur (zu/remove-left zloc))
+        zloc)
+      zloc)))
+
 (defn remove
   "Remove value at the given zipper location. Returns the first non-whitespace node 
-   that would have preceded it in a depth-first walk. Will remove a single whitespace
-   character following the current node and/or preceding it (if last element in branch)."
+   that would have preceded it in a depth-first walk. Will remove whitespace appropriately.
+  
+     [1  2  3]   => [1  3]
+     [1 2]       => [1]
+     [1 2]       => [2]
+     [1]         => []
+     [  1  ]     => []
+     [1 [2 3] 4] => [1 [2 3]]
+     [1 [2 3] 4] => [[2 3] 4]
+
+  If a node is located rightmost, both preceding and trailing spaces are removed, otherwise only
+  trailing spaces are touched. This means that a following element (no matter whether on the
+  same line or not) will end up in the same position (line/column) as the removed one."
   [zloc]
-  (->> zloc
-    remove-trailing-space
-    ;; TODO: Remove preceding space
-    z/remove
-    (zc/skip-whitespace z/prev)))
+  (let [zloc (if (zc/rightmost? zloc) (remove-preceding-space zloc) zloc)
+        zloc (-> zloc remove-trailing-space z/remove)]
+    (zc/skip-whitespace z/prev zloc)))
+
+;; ## Splice
 
 (defn splice
   "Add the current node's children to the parent branch (in place of the current node).
-   The resulting zipper will be positioned on the first non-whitespace \"child\"."
+   The resulting zipper will be positioned on the first non-whitespace \"child\". If 
+   the node does not have children (or only whitespace children), `nil` is returned."
+  [zloc]
+  (when (and (z/branch? zloc) (pos? (count (z/children zloc))) (zc/skip-whitespace (z/down zloc)))
+    (->> (reverse (z/children zloc))
+      (reduce z/insert-right zloc)
+      zu/remove-and-move-right
+      zc/skip-whitespace)))
+
+(defn splice-or-remove
+  "Try to splice the given node. If it fails (no children, only whitespace children),
+   remove it."
   [zloc]
-  (if-not (z/branch? zloc)
-    zloc
-    (let [ch (z/children zloc)]
-      (-> (reduce z/insert-right zloc (reverse ch))
-        z/remove
-        z/next
-        zc/skip-whitespace))))
+  (or (splice zloc) (remove zloc)))
 
 ;; ## Prefix
 

test/rewrite_clj/indent_test.clj

@@ -9,7 +9,6 @@
 ;; ## Fixtures
 
 (def data-string "{:first [1\n          2],\n :second 3}")
-
 (def data (z/of-string data-string))
 
 ;; ## Tests
@@ -48,8 +47,7 @@
     (z/tag rloc) => :token
     (z/value rloc) => 2
     (z/->root-string rloc) => "[1\n 2 \"abc\" [3\n          4]]")
-  (future-fact "about correct preceding whitespace handling."
-    (let [rloc (-> (z/of-string "[1\n 2 [3\n    4]]") (z/find-value z/next 2) i/remove)]
-      (z/tag rloc) => :token
-      (z/value rloc) => 1
-      (z/->root-string rloc) => "[1\n [3\n  4]]")))
+  (let [rloc (-> (z/of-string "[1\n 2 [3\n    4]]") (z/find-value z/next 2) i/remove)]
+    (z/tag rloc) => :token
+    (z/value rloc) => 1
+    (z/->root-string rloc) => "[1\n [3\n  4]]"))

test/rewrite_clj/transform_test.clj

@@ -70,3 +70,16 @@
                  [b-suffix \"1.2.3\"]]
   :repositories { \"private\" \"http://private.com/repo\" })")
 
+(fact "about whitespace-handling in removal"
+  (-> data
+    (z/find-value z/next 'defproject)
+    (z/find-value :dependencies)
+    z/right z/down z/remove
+    z/->root-string)
+      =>
+";; This is a Project File.
+(defproject my-project \"0.1.0-SNAPSHOT\"
+  :description \"A project.
+                 Multiline!\"
+  :dependencies [[b \"1.2.3\"]]
+  :repositories { \"private\" \"http://private.com/repo\" })")

test/rewrite_clj/zip_test.clj

@@ -90,7 +90,7 @@
     (-> root z/down z/remove z/root) 
       => [:forms
           [:vector 
-           [:newline "\n"] [:whitespace " "] [:token 2] 
+           [:token 2] 
            [:newline "\n"] [:whitespace " "] [:token 3]]]
     (-> root z/down z/right (z/replace 5) z/root)
       => [:forms
@@ -106,6 +106,11 @@
            [:newline "\n"] [:whitespace " "] [:token 8]]]))
 
 (fact "about node removal (including trailing/preceding whitespace if necessary)"
+  (let [root (z/of-string "[1\n2]")]
+    (z/sexpr root) => [1 2]
+    (let [r0 (-> root z/down z/remove)]
+      (z/sexpr r0) => [2]
+      (z/->root-string r0) => "[2]"))
   (let [root (z/of-string "[1 [2 3] 4]")]
     (z/sexpr root) => [1 [2 3] 4]
     (let [r0 (-> root z/down z/remove*)]
@@ -116,15 +121,37 @@
       (z/->root-string r0) => "[[2 3] 4]")
     (let [r0 (-> root z/down z/right z/right z/remove*)]
       (z/->root-string r0) => "[1 [2 3] ]")  
-    (future-fact "about removal of preceding spaces"
-      (let [r0 (-> root z/down z/right z/right z/remove)]
-        (z/sexpr r0) => 3
-        (z/->root-string r0) => "[1 [2 3]]"))))
+    (let [r0 (-> root z/down z/right z/right z/remove)]
+      (z/sexpr r0) => 3
+      (z/->root-string r0) => "[1 [2 3]]")))
 
 (fact "about zipper splice"
-  (let [root (z/of-string "[1 [2 3] 4]")]
-    (z/sexpr root) => [1 [2 3] 4]
-    (-> root z/down z/right z/splice z/up z/sexpr) => [1 2 3 4]))
+  (let [r0 (z/of-string "[1 [2 3] 4]")
+        r1 (-> r0 z/down z/right z/splice)]
+    (z/sexpr r0) => [1 [2 3] 4]
+    (z/sexpr r1) => 2
+    (z/sexpr (z/up r1)) => [1 2 3 4])
+  (let [r0 (z/of-string "[1 [] 4]")
+        r1 (-> r0 z/down z/right z/splice)
+        r2 (-> r0 z/down z/right z/splice-or-remove)]
+    (z/sexpr r0) => [1 [] 4]
+    r1 => falsey
+    (z/sexpr r2) => 1
+    (z/->root-string r2) => "[1 4]")  
+  (let [r0 (z/of-string "[1 [ ] 4]")
+        r1 (-> r0 z/down z/right z/splice)
+        r2 (-> r0 z/down z/right z/splice-or-remove)]
+    (z/sexpr r0) => [1 [] 4]
+    r1 => falsey
+    (z/sexpr r2) => 1
+    (z/->root-string r2) => "[1 4]")
+  (let [r0 (z/of-string "[1 []]")
+        r1 (-> r0 z/down z/right z/splice)
+        r2 (-> r0 z/down z/right z/splice-or-remove)]
+    (z/sexpr r0) => [1 []]
+    r1 => falsey
+    (z/sexpr r2) => 1
+    (z/->root-string r2) => "[1]"))
 
 (fact "about zipper search/find traversal"
   (-> root z/down (z/find-value :description) z/right z/node) => [:token "A project."]