diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 3043c0dd..29933240 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -24,6 +24,9 @@ A release with known breaking changes is marked with: // (adjust these in publish.clj as you see fit) === Unreleased +* `rewrite-clj.zip/insert-right` and `rewrite-clj.zip/append-child` no longer insert a space when inserting/appending after a comment node. +{issue}346[#346] ({lread}) + === v1.1.49 - 2024-11-18 [[v1.1.49]] * Fix parsing of `b//` symbol diff --git a/script/test_libs.clj b/script/test_libs.clj index e7d748ce..c89ab252 100755 --- a/script/test_libs.clj +++ b/script/test_libs.clj @@ -40,7 +40,7 @@ opts (if token {:headers {"Authorization" (format "Bearer %s" token)}} {})] - (case (:via github-release) + (case (:via github-release) ;; no official release :sha (-> (curl/get (format "https://api.github.com/repos/%s/git/refs/heads/master" (:repo github-release)) @@ -75,6 +75,7 @@ (:repo github-release) (or (:version-prefix github-release) "") version))] + (status/line :detail "Downloading lib release from: %s" download-url) (io/make-parents target) (io/copy (:body (curl/get download-url {:as :stream})) @@ -411,11 +412,15 @@ :show-deps-fn cli-deps-tree :test-cmds ["clojure -M:test"]} {:name "rewrite-edn" - :version "0.4.8" + ;; very temporarily use sha of my PR that addresses failure + ;; move back to release when PR is merged + :version "5659a1f650514d18c2356edeca16662e860ddd92" :platforms [:clj] :github-release {:repo "borkdude/rewrite-edn" - :version-prefix "v" - :via :tag} + ;; very temporarily use sha of PR that addresses failure + ;; :version-prefix "v" + ;; :via :tag + :via :sha} :patch-fn deps-edn-v1-patch :show-deps-fn cli-deps-tree :test-cmds ["clojure -M:test"]} diff --git a/src/rewrite_clj/zip.cljc b/src/rewrite_clj/zip.cljc index 2d361661..82deb1bf 100644 --- a/src/rewrite_clj/zip.cljc +++ b/src/rewrite_clj/zip.cljc @@ -501,10 +501,11 @@ ;; DO NOT EDIT FILE, automatically imported from: rewrite-clj.zip.insert (defn insert-right - "Return zipper with `item` inserted to the right of the current node in `zloc`, without moving location. + "Return `zloc` with `item` inserted to the right of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. - Will insert a space if necessary. + Will insert spaces around `item` if necessary. + There is no consideration on whitespaceness of `item` itself. Use [[rewrite-clj.zip/insert-right*]] to insert without adding any whitespace." [zloc item] (rewrite-clj.zip.insert/insert-right zloc item)) @@ -512,27 +513,33 @@ ;; DO NOT EDIT FILE, automatically imported from: rewrite-clj.zip.insert (defn insert-left "Return zipper with `item` inserted to the left of the current node in `zloc`, without moving location. - Will insert a space if necessary. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert spaces around `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[insert-left*]] to insert without adding any whitespace." [zloc item] (rewrite-clj.zip.insert/insert-left zloc item)) ;; DO NOT EDIT FILE, automatically imported from: rewrite-clj.zip.insert (defn insert-child - "Return zipper with `item` inserted as the first child of the current node in `zloc`, without moving location. - Will insert a space if necessary. + "Return `zloc` with `item` inserted as the first child of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert space after `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[insert-child*]] to insert without adding any whitespace." [zloc item] (rewrite-clj.zip.insert/insert-child zloc item)) ;; DO NOT EDIT FILE, automatically imported from: rewrite-clj.zip.insert (defn append-child - "Return zipper with `item` inserted as the last child of the current node in `zloc`, without moving. - Will insert a space if necessary. + "Return `zloc` with `item` inserted as the last child of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert space before `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[append-child*]] to append without adding any whitespace." [zloc item] (rewrite-clj.zip.insert/append-child zloc item)) diff --git a/src/rewrite_clj/zip/insert.cljc b/src/rewrite_clj/zip/insert.cljc index 986cbf6b..fdf0de25 100644 --- a/src/rewrite_clj/zip/insert.cljc +++ b/src/rewrite_clj/zip/insert.cljc @@ -9,69 +9,90 @@ (def ^:private space (nwhitespace/spaces 1)) -(defn- insert - "Generic insertion helper. If the node reached by `move-fn` - is a whitespace, insert an additional space." - [move-fn insert-fn prefix zloc item] - (let [item-node (node/coerce item) - next-node (move-fn zloc)] - (->> (concat - (when (and next-node (not (zwhitespace/whitespace? next-node))) - [space]) - [item-node] - (when (not (zwhitespace/whitespace? zloc)) - prefix)) - (reduce insert-fn zloc)))) +(defn- ends-with-ws? [zloc] + (when zloc + (or (zwhitespace/whitespace? zloc) + ;; a comment is not necessarily newline terminated, but we don't special case that + ;; inserting after a non-newline termnated comment is caveated in rewrite-clj.node/comment-node + (zwhitespace/comment? zloc)))) + +(defn- starts-with-ws? [zloc] + (zwhitespace/whitespace? zloc)) (defn insert-right - "Return zipper with `item` inserted to the right of the current node in `zloc`, without moving location. + "Return `zloc` with `item` inserted to the right of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. - Will insert a space if necessary. + Will insert spaces around `item` if necessary. + There is no consideration on whitespaceness of `item` itself. Use [[rewrite-clj.zip/insert-right*]] to insert without adding any whitespace." [zloc item] - (insert - zraw/right - zraw/insert-right - [space] - zloc item)) + (let [next-zloc (zraw/right zloc) + item-node (node/coerce item)] + (cond-> zloc + (and next-zloc (not (starts-with-ws? next-zloc))) + (zraw/insert-right space) + + :always + (zraw/insert-right item-node) + + (not (ends-with-ws? zloc)) + (zraw/insert-right space)))) (defn insert-left "Return zipper with `item` inserted to the left of the current node in `zloc`, without moving location. - Will insert a space if necessary. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert spaces around `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[insert-left*]] to insert without adding any whitespace." [zloc item] - (insert - zraw/left - zraw/insert-left - [space] - zloc item)) + (let [prev-zloc (zraw/left zloc) + item-node (node/coerce item)] + (cond-> zloc + (and prev-zloc (not (ends-with-ws? prev-zloc))) + (zraw/insert-left space) + + :always + (zraw/insert-left item-node) + + (not (starts-with-ws? zloc)) + (zraw/insert-left space)))) (defn insert-child - "Return zipper with `item` inserted as the first child of the current node in `zloc`, without moving location. - Will insert a space if necessary. + "Return `zloc` with `item` inserted as the first child of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert space after `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[insert-child*]] to insert without adding any whitespace." [zloc item] - (insert - zraw/down - zraw/insert-child - [] - zloc item)) + (let [prev-zloc (zraw/down zloc) + item-node (node/coerce item)] + (cond-> zloc + (and prev-zloc (not (starts-with-ws? prev-zloc))) + (zraw/insert-child space) + + :always + (zraw/insert-child item-node)))) (defn append-child - "Return zipper with `item` inserted as the last child of the current node in `zloc`, without moving. - Will insert a space if necessary. + "Return `zloc` with `item` inserted as the last child of the current node in `zloc`, without moving location. If `item` is not already a node, an attempt will be made to coerce it to one. + Will insert space before `item` if necessary. + There is no consideration on whitespaceness of `item` itself. + Use [[append-child*]] to append without adding any whitespace." [zloc item] - (insert - #(some-> % zraw/down zraw/rightmost) - zraw/append-child - [] - zloc item)) + (let [prev-zloc (some-> zloc zraw/down zraw/rightmost) + item-node (node/coerce item)] + (cond-> zloc + (and prev-zloc (not (ends-with-ws? prev-zloc))) + (zraw/append-child space) + + :always + (zraw/append-child item-node)))) diff --git a/test/rewrite_clj/zip/insert_test.cljc b/test/rewrite_clj/zip/insert_test.cljc index 380f54b5..6857f98d 100644 --- a/test/rewrite_clj/zip/insert_test.cljc +++ b/test/rewrite_clj/zip/insert_test.cljc @@ -1,48 +1,118 @@ (ns rewrite-clj.zip.insert-test - (:require [clojure.test :refer [deftest is]] - [rewrite-clj.interop :as interop] - [rewrite-clj.zip :as z])) - -(deftest t-whitespace-aware-insertion - (doseq [[fmt m n f s] - [["[%s]" z/next 0 z/insert-right "[1 2 3 4] x"] - ["[%s]" z/next 1 z/insert-right "[1 x 2 3 4]"] - ["[%s]" z/next 2 z/insert-right "[1 2 x 3 4]"] - ["[%s]" z/next 3 z/insert-right "[1 2 3 x 4]"] - ["[%s]" z/next 4 z/insert-right "[1 2 3 4 x]"] - ["[%s]" z/next 0 z/insert-left "x [1 2 3 4]"] - ["[%s]" z/next 1 z/insert-left "[x 1 2 3 4]"] - ["[%s]" z/next 2 z/insert-left "[1 x 2 3 4]"] - ["[%s]" z/next 3 z/insert-left "[1 2 x 3 4]"] - ["[%s]" z/next 4 z/insert-left "[1 2 3 x 4]"] - ["[%s]" z/next 0 z/insert-child "[x 1 2 3 4]"] - ["[%s]" z/next 0 z/append-child "[1 2 3 4 x]"] - ["[ %s]" z/next 0 z/insert-child "[x 1 2 3 4]"] - ["[%s ]" z/next 0 z/append-child "[1 2 3 4 x]"] - ["[%s]" z/next* 2 z/insert-right "[1 x 2 3 4]"] - ["\n[%s]" z/leftmost* 1 z/insert-left "x\n[1 2 3 4]"] - ["\n[%s]" z/leftmost* 1 z/insert-right "\nx [1 2 3 4]"]]] - (let [elements (->> (z/of-string - (interop/simple-format fmt "1 2 3 4")) - (iterate m)) - loc (nth elements n) - loc' (f loc 'x)] - (is (= (z/tag loc') (z/tag loc))) - (is (= s (z/root-string loc')))))) + (:require [clojure.test :refer [deftest is testing]] + [rewrite-clj.zip :as z] + [rewrite-clj.zip.test-helper :as th])) + +(def zipper-opts [{} {:track-position? true}]) + +;; special positional markers recognized by test-helper fns +;; ⊚ - node location +;; ◬ - root :forms node + +(deftest t-insert-right + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (doseq [[in expected] + [["⊚[1 2 3 4]" "⊚[1 2 3 4] x"] + ["[⊚1 2 3 4]" "[⊚1 x 2 3 4]"] + ["[1 ⊚2 3 4]" "[1 ⊚2 x 3 4]"] + ["[1 2 ⊚3 4]" "[1 2 ⊚3 x 4]"] + ["[1 2 3 ⊚4]" "[1 2 3 ⊚4 x]"] + ["[1\n⊚ 2 3 4]" "[1\n⊚ x 2 3 4]"] + ["⊚\n[1 2 3 4]" "⊚\nx [1 2 3 4]"] + ["[1 2 3 4⊚;; comment\n]" "[1 2 3 4⊚;; comment\nx]"] + ["⊚;; unterminated cmt" "⊚;; unterminated cmtx"] ;; an odd thing to do, but allowed + ["⊚;; comment\n" "⊚;; comment\nx"]]] + (let [zloc (th/of-locmarked-string in zopts)] + (is (= expected (th/root-locmarked-string (z/insert-right zloc 'x))) + in)))))) + +(deftest t-insert-rigth-contrived + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (let [zloc (-> (th/of-locmarked-string "1⊚ 2" zopts) z/remove*)] + (is (= "⊚12" (th/root-locmarked-string zloc)) "sanity pre-condition") + (is (= "⊚1 x 2" (-> zloc + (z/insert-right 'x) + th/root-locmarked-string))))))) + +(deftest t-insert-left + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (doseq [[in expected] + [["⊚[1 2 3 4]" "x ⊚[1 2 3 4]"] + ["[⊚1 2 3 4]" "[x ⊚1 2 3 4]"] + ["[1 ⊚2 3 4]" "[1 x ⊚2 3 4]"] + ["[1 2 ⊚3 4]" "[1 2 x ⊚3 4]"] + ["[1 2 3 ⊚4]" "[1 2 3 x ⊚4]"] + ["[1\n⊚ 2 3 4]" "[1\nx⊚ 2 3 4]"] + ["⊚\n[1 2 3 4]" "x⊚\n[1 2 3 4]"] + ["⊚;; comment\n" "x ⊚;; comment\n"] + ["⊚;; unterminated cmt" "x ⊚;; unterminated cmt"]]] + (let [zloc (th/of-locmarked-string in zopts)] + (is (= expected (th/root-locmarked-string (z/insert-left zloc 'x))) + in)))))) + +(deftest t-insert-left-contrived + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (let [zloc (-> (th/of-locmarked-string "1⊚ 2" zopts) z/remove* z/right*)] + (is (= "1⊚2" (th/root-locmarked-string zloc)) "sanity pre-condition") + (is (= "1 x ⊚2" (-> zloc + (z/insert-left 'x) + th/root-locmarked-string))))))) + +(deftest t-insert-child + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (doseq [[in expected] + [["⊚[1 2 3 4]" "⊚[x 1 2 3 4]"] + ["⊚[]" "⊚[x]"] + ["⊚[1]" "⊚[x 1]"] + ["⊚[ 1]" "⊚[x 1]"] + ["⊚[ 1 ]" "⊚[x 1 ]"] + ["⊚[ ]" "⊚[x ]"] + ["⊚[ 1 2 3 4]" "⊚[x 1 2 3 4]"] + ["⊚[;; comment\n1 2 3 4]" "⊚[x ;; comment\n1 2 3 4]"] + ["◬;; unterminated cmt" "◬x ;; unterminated cmt"] + ["◬;; comment\n" "◬x ;; comment\n"]]] + (let [zloc (th/of-locmarked-string in zopts)] + (is (= expected (th/root-locmarked-string (z/insert-child zloc 'x))) + in)))))) + +(deftest t-append-child + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (doseq [[in expected] + [["⊚[1 2 3 4 ]" "⊚[1 2 3 4 x]"] + ["⊚[]" "⊚[x]"] + ["⊚[1]" "⊚[1 x]"] + ["⊚[1 ]" "⊚[1 x]"] + ["⊚[ 1 ]" "⊚[ 1 x]"] + ["⊚[ ]" "⊚[ x]"] + ["⊚[1 2 3 4;; comment\n]" "⊚[1 2 3 4;; comment\nx]"] + ["◬;; unterminated cmt" "◬;; unterminated cmtx"] ;; odd to do but allowed + ["◬#! unterminated cmt" "◬#! unterminated cmtx"] ;; try alternate comment syntax + ["◬;; comment\n" "◬;; comment\nx"]]] + (let [zloc (th/of-locmarked-string in zopts)] + (is (= expected (th/root-locmarked-string (z/append-child zloc 'x))) + in)))))) (deftest t-different-node-types-that-allow-insertion - (doseq [[s depth result] - [["[1 2]" 0 "[1 x 2 y]"] - ["(1 2)" 0 "(1 x 2 y)"] - ["#{1 2}" 0 "#{1 x 2 y}"] - ["#(1 2)" 0 "#(1 x 2 y)"] - ["'(1 2)" 1 "'(1 x 2 y)"] - ["#=(1 2)" 1 "#=(1 x 2 y)"] - ["#_(1 2)" 1 "#_(1 x 2 y)"] - ["@(f 2)" 1 "@(f x 2 y)"]]] - (let [loc (-> (iterate z/down (z/of-string s)) - (nth (inc depth)) - z/right - (z/insert-left 'x) - (z/insert-right 'y))] - (is (= result (z/root-string loc)))))) + (doseq [zopts zipper-opts] + (testing (str "zipper opts " zopts) + (doseq [[in expected] + [["[1 ⊚2]" "[1 x ⊚2 y]"] + ["(1 ⊚2)" "(1 x ⊚2 y)"] + ["#{1 ⊚2}" "#{1 x ⊚2 y}"] + ["#(1 ⊚2)" "#(1 x ⊚2 y)"] + ["'(1 ⊚2)" "'(1 x ⊚2 y)"] + ["#=(1 ⊚2)" "#=(1 x ⊚2 y)"] + ["#_(1 ⊚2)" "#_(1 x ⊚2 y)"] + ["@(f ⊚2)" "@(f x ⊚2 y)"]]] + (let [zloc (th/of-locmarked-string in zopts)] + (is (= expected (-> zloc + (z/insert-left 'x) + (z/insert-right 'y) + (th/root-locmarked-string))) + in)))))) diff --git a/test/rewrite_clj/zip/test_helper.cljc b/test/rewrite_clj/zip/test_helper.cljc new file mode 100644 index 00000000..ac29c36e --- /dev/null +++ b/test/rewrite_clj/zip/test_helper.cljc @@ -0,0 +1,94 @@ +(ns rewrite-clj.zip.test-helper + "It can be tricky and error prone to navigate to a desired location in a zipper. + These helpers allow us to mark our desired location with a special ⊚ character + and spit out that same character to reflect the location. + The ◬ character at start of string to indicates root :forms node location." + (:require [clojure.string :as str] + [rewrite-clj.node :as n] + [rewrite-clj.zip :as z])) + +(defn pos-and-s + "Given `s` that includes a single loc prefix ⊚, return map with + - `:s` s without loc prefix char + - `:pos` + - `:row` row of prefix char + - `:col` col or prefix char" + [s] + (when-let [marker-ndx (str/index-of s "⊚")] + (let [[row col] (-> (subs s 0 marker-ndx) + (str/split #"\n" -1) + ((juxt count #(-> % last count inc) )))] + {:s (str/replace s "⊚" "") :pos {:row row :col col}}))) + +(defn of-locmarked-string + "Return zloc for string `s` located at node prefixed with ⊚ marker. + Use ◬ as first char to locate to root forms node." + [s opts] + + (cond + (str/starts-with? s "◬") + (z/of-string* (subs s 1) opts) + + (str/includes? s "⊚") + (let [{:keys [pos s]} (pos-and-s s) + {target-row :row target-col :col} pos + zloc (z/of-string* s opts)] + (loop [zloc (z/down* zloc)] + (let [{:keys [row col]} (meta (z/node zloc))] + (cond + (and (= target-row row) (= target-col col)) + zloc + + (z/end? zloc) + (throw (ex-info (str "Oops, of-locmarked-string failed to locate to node at ⊚ mark found at [row col]:" [target-row target-col]) {})) + + :else + (recur (z/next* zloc)))))) + :else + (throw (ex-info "s needs to start with ◬, or include a single ⊚" {})))) + +(defn- row-num [zloc] + (loop [zloc (z/prev* zloc) + rows 0] + (if (not zloc) + (inc rows) + (if (or (z/linebreak? zloc) (n/comment? (z/node zloc))) + (recur (z/prev* zloc) (inc rows)) + (recur (z/prev* zloc) rows))))) + +(defn- col-num [zloc] + (loop [zloc zloc + cols 0] + (let [up (z/up* zloc) + left (z/left* zloc)] + (cond + (and left (or (z/linebreak? left) (-> left z/node n/comment?))) + (inc cols) + + left + (recur left (long (+ cols (z/length left)))) + + up + (recur up (long (+ cols (-> up z/node n/leader-length)))) + + :else + (inc cols))))) + +(defn root-locmarked-string + "Return root string for `zloc` with current node prefixed with ⊚ marker, + if located at root forms node string will start with ◬" + [zloc] + (if (= :forms (z/tag zloc)) + (str "◬" (z/root-string zloc) ) + (let [row (row-num zloc) + col (col-num zloc) + s (z/root-string zloc) + lines (str/split s #"\n" -1) + line (nth lines (dec row))] + (str/join "\n" + (concat + (subvec lines 0 (dec row)) + [(str (subs line 0 (dec col)) + "⊚" + (subs line (dec col)))] + (subvec lines row))))))