paredit/join fn fixes

CHANGELOG.adoc

@@ -29,6 +29,10 @@ A release with known breaking changes is marked with:
 * `rewrite.clj.paredit`
 ** `pos` arguments now accept vector `[row col]` in addition to map `{:row :col}`
 {issue}344[#344] ({lread})
+** `join` now takes type of left sequence
+{issue}321[#321] ({lread}, thanks for the issue {person}openvest[@openvest]!)
+** `join` no longer removes comments that were between joined strings
+{issue}351[#351] ({lread})
 
 === v1.1.49 - 2024-11-18 [[v1.1.49]]
 

src/rewrite_clj/paredit.cljc

@@ -17,7 +17,6 @@
 (defn- empty-seq? [zloc]
   (and (z/seq? zloc) (not (seq (z/sexpr zloc)))))
 
-;; helper
 (defn- move-n [loc f n]
   (if (= 0 n)
     loc
@@ -45,17 +44,25 @@
         (take-while p?)
         (map z/node))))
 
+(defn- reduce-into-zipper
+  "A thread-first-friendly reducer"
+  [zloc f items]
+  (reduce f zloc items))
+
+(defn- linebreak-and-comment-nodes
+  "Return vector of all linebreak and comment nodes from whitespace and comment nodes from `zloc` moving via `f` "
+  [zloc f]
+  (->> (-> zloc
+           f
+           (nodes-by-dir f ws/whitespace-or-comment?))
+       (filterv #(or (nd/linebreak? %) (nd/comment? %)))))
+
 (defn- remove-first-if-ws [nodes]
   (when (seq nodes)
     (if (nd/whitespace? (first nodes))
       (rest nodes)
       nodes)))
 
-(defn- remove-ws-or-comment [zloc]
-  (if-not (ws/whitespace-or-comment? zloc)
-    zloc
-    (recur (z/remove* zloc))))
-
 (defn- create-seq-node
   "Creates a sequence node of given type `t` with node values of `v`"
   [t v]
@@ -457,33 +464,44 @@
     zloc))
 
 (defn- join-seqs [left right]
-  (let [lefts (-> left z/node nd/children)
+  (let [rights (-> right z/node nd/children)
         ws-nodes (-> (z/right* left) (nodes-by-dir z/right* ws/whitespace-or-comment?))
-        rights (-> right z/node nd/children)]
+        ws-nodes (if (seq ws-nodes)
+                   ws-nodes
+                   [(nd/spaces 1)])
+        zloc (-> left
+                 (reduce-into-zipper z/append-child* ws-nodes)
+                 (reduce-into-zipper z/append-child* rights))]
+    (-> zloc
+        (u/remove-right-while ws/whitespace-or-comment?)
+        z/right*
+        u/remove-and-move-left
+        z/down
+        z/rightmost*
+        (move-n z/left* (dec (count rights))))))
 
+(defn- join-strings [left right]
+  (let [cmts-and-nls (linebreak-and-comment-nodes left z/right*)
+        cmts-and-nls (when (seq cmts-and-nls)
+                       (into [(nd/spaces 1)] cmts-and-nls))]
     (-> right
         z/remove*
-        remove-ws-or-comment
-        z/up
-        (z/insert-left (create-seq-node :vector
-                                        (concat lefts
-                                                ws-nodes
-                                                rights)))
-        z/remove
-        (global-find-by-node (first rights)))))
-
-(defn- join-strings [left right]
-  (-> right
-      z/remove*
-      remove-ws-or-comment
-      (z/replace (nd/string-node (str (-> left z/node nd/sexpr)
-                                      (-> right z/node nd/sexpr))))))
+        z/left
+        (u/remove-right-while ws/whitespace-or-comment?)
+        ;; sexpr is safe on strings
+        (z/replace (nd/string-node (str (-> left z/node nd/sexpr)
+                                        (-> right z/node nd/sexpr))))
+        (reduce-into-zipper z/insert-right* (reverse cmts-and-nls)))))
 
 (defn join
-  "Join S-expression to the left and right of current loc. Also works for strings.
-
-  - `[[1 2] |[3 4]] => [[1 2 3 4]]`
-  - `[\"Hello \" | \"World\"] => [\"Hello World\"]`"
+  "Returns `zloc` with sequence to the left joined to sequence to the right.
+  Also works for strings.
+  If sequence types differ, uses sequence type to the left.
+
+  - `[1 2] |[3 4]            => [1 2 |3 4]`
+  - `[1 2]| [3 4]            => [1 2 |3 4]`
+  - `{:a 1} |(:b 2)          => `{:a 1 :b 2}`
+  - `[\"Hello\" | \"World\"] => [|\"HelloWorld\"]`"
   [zloc]
   (let [left (some-> zloc z/left)
         right (if (some-> zloc z/node nd/whitespace?) (z/right zloc) zloc)]

test/rewrite_clj/paredit_test.cljc

@@ -214,7 +214,7 @@
   ;; for this pos fn test, ⊚ in `s` represents character row/col the the `pos`
   ;; ⊚ in `expected` is at zipper node granularity
   (doseq [[s                              expected]
-          [["(\"Hello ⊚World\")"          "(⊚\"Hello \" \"World\")" ]]]
+          [["(\"Hello ⊚World\")"          "(⊚\"Hello \" \"World\")"]]]
     (let [{:keys [pos s]} (th/pos-and-s s)
           zloc (z/of-string* s {:track-position? true})]
       (doseq [pos [pos [(:row pos) (:col pos)]]]
@@ -226,9 +226,18 @@
     (testing (zipper-opts-desc opts)
       (doseq [[s                                                            expected]
               [["[1 2]⊚ [3 4]"                                              "[1 2 ⊚3 4]"]
-               ["\n[[1 2]⊚ ; the first stuff\n [3 4] ; the second stuff\n]" "\n[[1 2 ; the first stuff\n ⊚3 4]; the second stuff\n]"]
+               ["#{1 2} ⊚[3 4]"                                             "#{1 2 ⊚3 4}"]
+               ["(1 2)⊚ {3 4}"                                              "(1 2 ⊚3 4)"]
+               ["{:a 1} ⊚(:b 2)"                                            "{:a 1 ⊚:b 2}"]
+               ["[foo]⊚[bar]"                                               "[foo ⊚bar]"]
+               ["[foo]   ⊚[bar]"                                            "[foo   ⊚bar]"]
+               ["\n[[1 2]⊚ ; the first stuff\n [3 4] ; the second stuff\n]" "\n[[1 2 ; the first stuff\n ⊚3 4] ; the second stuff\n]"]
                ;; strings
-               ["(\"Hello \" ⊚\"World\")"                                   "(⊚\"Hello World\")"]]]
+               ["(\"Hello \" ⊚\"World\")"                                   "(⊚\"Hello World\")"]
+               ["(⊚\"Hello \" \"World\")" "(⊚\"Hello \" \"World\")"]
+               ["(\"Hello \" ;; comment\n;; comment2\n⊚\"World\")"
+                "(⊚\"Hello World\" ;; comment\n;; comment2\n)"]
+               ["\"foo\"⊚\"bar\""         "⊚\"foobar\""]]]
         (let [zloc (th/of-locmarked-string s opts)]
           (is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
           (is (= expected (-> zloc pe/join th/root-locmarked-string)) "string after"))))))