From 3b07e600e86f70eae5cac15ae7e72a245d895371 Mon Sep 17 00:00:00 2001 From: Lee Read Date: Wed, 19 Feb 2025 22:14:49 -0500 Subject: [PATCH] paredit: support ops after update (#365) Fixes for splice-killing-forward, splice-killing-backward, split-at-pos. These are the final fns that relied on reader positional metadata, add in a test to confirm paredit works on zipper without this metadata. Closes #256 --- CHANGELOG.adoc | 2 + src/rewrite_clj/paredit.cljc | 106 ++++++++++++++++------------ test/rewrite_clj/paredit_test.cljc | 107 ++++++++++++++++++++++++++--- 3 files changed, 161 insertions(+), 54 deletions(-) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 98c304f..caf088d 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -27,6 +27,8 @@ A release with known breaking changes is marked with: * `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}) * `rewrite.clj.paredit` +** now supports paredit ops on new/changed nodes in a zipper +{issue}256[#256] ({lread}, thanks for the issue {person}mrkam2[mrkam2]!) ** `pos` arguments now accept vector `[row col]` in addition to map `{:row :col}` {issue}344[#344] ({lread}) ** `join` now takes type of left sequence diff --git a/src/rewrite_clj/paredit.cljc b/src/rewrite_clj/paredit.cljc index 69c279d..8dbf1c2 100644 --- a/src/rewrite_clj/paredit.cljc +++ b/src/rewrite_clj/paredit.cljc @@ -51,18 +51,13 @@ loc (->> loc (iterate f) (take (inc n)) last))) -(defn- top - [zloc] - (->> zloc - (iterate z/up) +(defn- count-moves [zloc f] + (->> (iterate f zloc) (take-while identity) - last)) + count)) -(defn- global-find-by-node - [zloc n] - (-> zloc - top - (z/find z/next* #(= (meta (z/node %)) (meta n))))) +(defn- thread-friendly-skip [zloc f p?] + (ws/skip f p? zloc)) (defn- nodes-by-dir ([zloc f] (nodes-by-dir zloc f constantly)) @@ -420,7 +415,6 @@ (take (inc n-slurps)) last)))))) - (defn ^{:deprecated "1.1.49"} slurp-forward-fully "DEPRECATED: We recommend [[slurp-forward-fully-into]]] for more control. @@ -657,33 +651,56 @@ "See [[rewrite-clj.zip/splice]]" z/splice) -(defn- splice-killing - [zloc f] - (if-not (z/up zloc) - zloc - (-> zloc - (f (constantly true)) - z/up - splice - (global-find-by-node (z/node zloc))))) - (defn splice-killing-backward - "Remove left siblings of current given node in S-Expression and unwrap remaining into enclosing S-expression + "Return `zloc` with current and right siblings spliced into parent sequence. - - `(foo (let ((x 5)) |(sqrt n)) bar) => (foo (sqrt n) bar)`" + - `(a (b c |d e f) g) => (a |d e f g)` + - `(foo (let ((x 5)) |(sqrt n)) bar) => (foo |(sqrt n) bar)`" [zloc] - (splice-killing zloc u/remove-left-while)) + (cond + (not (z/up zloc)) + zloc + + (empty-seq? (z/up zloc)) + (let [zloc-parent (z/up zloc)] + (or + (some-> zloc-parent z/left (u/remove-right-while z/whitespace?) u/remove-right) + (some-> zloc-parent z/right (u/remove-left-while z/whitespace?) u/remove-left) + (-> zloc-parent z/remove))) + + :else + (-> zloc + (u/remove-left-while (constantly true)) + z/up + splice))) (defn splice-killing-forward - "Remove current given node and its right siblings in S-Expression and unwrap remaining into enclosing S-expression + "Return `zloc` with left siblings spliced into parent sequence. - - `(a (b c |d e) f) => (a b |c f)`" + - `(a (b c |d e f) g) => (a b |c g)`" [zloc] - (if (and (z/up zloc) (not (z/leftmost? zloc))) - (splice-killing (z/left zloc) u/remove-right-while) - (if (z/up zloc) - (-> zloc z/up z/remove) - zloc))) + (cond + (not (z/up zloc)) + zloc + + (or (z/leftmost? zloc) (empty-seq? (z/up zloc))) + (let [zloc-parent (z/up zloc)] + (or + (some-> zloc-parent z/left (u/remove-right-while z/whitespace?) u/remove-right) + (some-> zloc-parent z/right (u/remove-left-while z/whitespace?) u/remove-left) + (-> zloc-parent z/remove))) + + :else + (let [n-right-sibs-parent (-> zloc z/up (count-moves z/right)) + zloc (-> zloc + kill + (thread-friendly-skip z/left* z/whitespace?)) + n-left-sibs-seq (count-moves zloc z/left)] + (-> zloc + z/up + splice + z/rightmost + (move-n z/left (inc (- n-right-sibs-parent n-left-sibs-seq))))))) (defn split "Return `zloc` with parent sequence split into to two sequences at current node. @@ -719,20 +736,20 @@ z/down z/rightmost)))))) -(defn- split-string [zloc pos] - (let [bounds (-> zloc z/node meta) - row-idx (- (:row pos) (:row bounds)) +(defn- split-string [zloc [split-row split-col]] + (let [[elem-row elem-col] (z/position zloc) + lines-ndx (- split-row elem-row) lines (-> zloc z/node :lines) - split-col (if-not (= (:row pos) (:row bounds)) - (dec (:col pos)) - (- (:col pos) (inc (:col bounds))))] + split-col (if-not (= split-row elem-row) + (dec split-col) + (- split-col (inc elem-col)))] (-> zloc (z/replace (nd/string-node - (-> (take (inc row-idx) lines) + (-> (take (inc lines-ndx) lines) vec - (update-in [row-idx] #(subs % 0 split-col))))) + (update-in [lines-ndx] #(subs % 0 split-col))))) (z/insert-right (nd/string-node - (-> (drop row-idx lines) + (-> (drop lines-ndx lines) vec (update-in [0] #(subs % split-col)))))))) @@ -750,9 +767,12 @@ - `(\"Hello |World\") => (|\"Hello\" \"World\")`" [zloc pos] (if-let [candidate (z/find-last-by-pos zloc pos)] - (let [pos (fz/pos-as-map pos) - candidate-pos (fz/pos-as-map (-> candidate z/position fz/pos-as-map))] - (if (and (string-node? candidate) (not= pos candidate-pos)) + (let [pos (fz/pos-as-vec pos) + [candidate-pos candidate-end-pos] (-> candidate z/position-span) + candidate-end-pos (update candidate-end-pos 1 dec)] + (if (and (string-node? candidate) + (not= pos candidate-pos) + (not= pos candidate-end-pos)) (split-string candidate pos) (split candidate))) zloc)) diff --git a/test/rewrite_clj/paredit_test.cljc b/test/rewrite_clj/paredit_test.cljc index d5087cf..c8a215d 100644 --- a/test/rewrite_clj/paredit_test.cljc +++ b/test/rewrite_clj/paredit_test.cljc @@ -1,5 +1,6 @@ (ns rewrite-clj.paredit-test (:require [clojure.test :refer [deftest is testing]] + [rewrite-clj.node :as n] [rewrite-clj.paredit :as pe] [rewrite-clj.zip :as z] [rewrite-clj.zip.test-helper :as th])) @@ -391,22 +392,55 @@ (is (= s (th/root-locmarked-string zloc)) "(sanity) string before") (is (= expected (-> zloc (pe/wrap-fully-forward-slurp t) th/root-locmarked-string)) "string after"))))))) +;; TODO what about comments? (deftest splice-killing-backward-test (doseq [opts zipper-opts] - (testing (zipper-opts-desc opts) - (let [res (-> (th/of-locmarked-string "(foo (let ((x 5)) ⊚(sqrt n)) bar)" opts) - pe/splice-killing-backward)] - (is (= "(foo ⊚(sqrt n) bar)" (th/root-locmarked-string res))))))) + (testing (str "zipper opts" opts) + (doseq [[s expected] + [["(foo (let ((x 5)) ⊚(sqrt n)) bar)" "(foo ⊚(sqrt n) bar)"] + ["( a ( b c ⊚d e f) g)" "( a ⊚d e f g)"] + ["( [a] ( [b] [c] ⊚[d] [e] [f]) [g])" "( [a] ⊚[d] [e] [f] [g])"] + ["( [a] ( [b] [c] [d] [e] ⊚[f]) [g])" "( [a] ⊚[f] [g])"] + ["( (⊚ ) [g])" "( ⊚[g])"] + ["( [a] (⊚ ))" "( ⊚[a])"] + ["( (⊚ ))" "⊚()"] + ["[⊚1]" "⊚1"] + ["[⊚1 2]" "⊚1 2"] + ["[1 2 ⊚3 4 5]" "⊚3 4 5"] + ["[1 2⊚ 3 4 5]" "⊚3 4 5"] + ["[1 2 3 4 5⊚ ]" "◬"]]] + (testing s + (let [zloc (th/of-locmarked-string s opts) + res (pe/splice-killing-backward zloc)] + (is (= s (th/root-locmarked-string zloc)) "(sanity) s before change") + (is (= expected (th/root-locmarked-string res)) "root-string after"))))))) +;; TODO what about comments? (deftest splice-killing-forward-test (doseq [opts zipper-opts] - (testing (zipper-opts-desc opts) - (doseq [[s expected] - [["(a (b c ⊚d e) f)" "(a b ⊚c f)"] - ["(a (⊚b c d e) f)" "(⊚a f)"]]] - (let [zloc (th/of-locmarked-string s opts)] - (is (= s (th/root-locmarked-string zloc)) "(sanity) string before") - (is (= expected (-> zloc pe/splice-killing-forward th/root-locmarked-string)) "string after")))))) + (testing (str "zipper opts" opts) + (doseq [[s expected] + [["(a (b c ⊚d e f) g)" "(a b ⊚c g)"] + ["(a (⊚b c d e) f)" "(⊚a f)"] + ["( a ( b c ⊚d e f) g)" "( a b ⊚c g)"] + ["( [a] ( [b] [c] ⊚[d] [e] [f]) [g])" "( [a] [b] ⊚[c] [g])"] + ["( [a] ( ⊚[b] [c] [d] [e] [f]) [g])" "( ⊚[a] [g])"] + ["( ( ⊚[b] [c] [d] [e] [f]) [g])" "( ⊚[g])"] + ["( [a] ( ⊚[b] [c] [d] [e] [f]))" "( ⊚[a])"] + ["( ( ⊚[b] [c] [d] [e] [f]))" "⊚()"] + ["( (⊚ ) [g])" "( ⊚[g])"] + ["( [a] (⊚ ))" "( ⊚[a])"] + ["( (⊚ ))" "⊚()"] + ["[⊚1]" "◬"] + ["[⊚1 2]" "◬"] + ["[1 2 ⊚3 4 5]" "1 ⊚2"] + ["[1 2⊚ 3 4 5]" "1 ⊚2"] + ["[ ⊚1 2 3 4 5 ]" "◬"]]] + (testing s + (let [zloc (th/of-locmarked-string s opts) + res (pe/splice-killing-forward zloc)] + (is (= s (th/root-locmarked-string zloc)) "(sanity) s before change") + (is (= expected (th/root-locmarked-string res)) "root-string after"))))))) (deftest split-test (doseq [opts zipper-opts] @@ -436,6 +470,8 @@ [["(\"Hello ⊚World\" 42)" "(⊚\"Hello \" \"World\" 42)"] ["(\"⊚Hello World\" 101)" "(⊚\"\" \"Hello World\" 101)"] ["(\"H⊚ello World\" 101)" "(⊚\"H\" \"ello World\" 101)"] + ["(\"Hello World⊚\" 101)" "(⊚\"Hello World\") (101)"] + ["bingo bango (\"Hello\n Wor⊚ld\" 101)" "bingo bango (⊚\"Hello\n Wor\" \"ld\" 101)"] ["(⊚\"Hello World\" 101)" "(⊚\"Hello World\") (101)"]]] (let [{:keys [pos s]} (th/pos-and-s s) zloc (z/of-string* s {:track-position? true})] @@ -485,3 +521,52 @@ (let [zloc (th/of-locmarked-string s opts)] (is (= s (th/root-locmarked-string zloc)) "(sanity) string before") (is (= expected (-> zloc pe/move-to-prev th/root-locmarked-string)) "string after")))))) + +(deftest ops-on-changed-zipper-test + (doseq [opts zipper-opts] + (testing (str "zipper opts " opts) + ;; create our zipper dynamically to avoid any reader metadata + ;; we used to rely on this metadata and it was a problem + ;; see https://github.com/clj-commons/rewrite-clj/issues/256 + (let [zloc (-> (z/of-node (n/forms-node + [(n/token-node 'foo) (n/spaces 1) + (n/list-node + [(n/token-node 'bar) (n/spaces 1) + (n/token-node 'baz) (n/spaces 1) + (n/vector-node + [(n/token-node 1) (n/spaces 1) + (n/token-node 2)]) + (n/spaces 1) + (n/vector-node + [(n/token-node 3) (n/spaces 1) + (n/token-node 4)]) + (n/spaces 1) + (n/keyword-node :bip) (n/spaces 1) + (n/keyword-node :bop)]) + (n/spaces 1) + (n/token-node :bap)]) + opts) + z/right z/down z/right z/right z/down)] + ;; 1 2 3 4 + ;; 12345678901234567890123456789012345678901 + (is (= "foo (bar baz [⊚1 2] [3 4] :bip :bop) :bap" (th/root-locmarked-string zloc)) "(sanity) before") + (is (= "foo (bar baz ⊚1 [2] [3 4] :bip :bop) :bap" (-> zloc pe/barf-backward th/root-locmarked-string))) + (is (= "foo (bar baz [⊚1] 2 [3 4] :bip :bop) :bap" (-> zloc pe/barf-forward th/root-locmarked-string))) + (is (= "foo (bar baz [1 2 ⊚3 4] :bip :bop) :bap" (-> zloc z/up z/right pe/join th/root-locmarked-string))) + (is (= "foo (bar baz ⊚[] [3 4] :bip :bop) :bap" (-> zloc pe/kill th/root-locmarked-string))) + (when (:track-position? opts) + (is (= "foo (bar baz [1 2] [3 4]⊚ ) :bap" (-> zloc (pe/kill-at-pos {:row 1 :col 28}) th/root-locmarked-string)))) + (is (= "foo (bar baz ⊚1 [2] [3 4] :bip :bop) :bap" (-> zloc pe/move-to-prev th/root-locmarked-string))) + (is (= "foo (bar baz ⊚1 [3 4] :bip :bop) :bap" (-> zloc pe/raise th/root-locmarked-string))) + (is (= "foo (bar [baz ⊚1 2] [3 4] :bip :bop) :bap" (-> zloc pe/slurp-backward th/root-locmarked-string))) + (is (= "foo ([bar baz ⊚1 2] [3 4] :bip :bop) :bap" (-> zloc pe/slurp-backward-fully th/root-locmarked-string))) + (is (= "foo (bar baz [⊚1 2 [3 4]] :bip :bop) :bap" (-> zloc pe/slurp-forward th/root-locmarked-string))) + (is (= "foo (bar baz [1 2] [⊚3 4 :bip :bop]) :bap" (-> zloc z/up z/right z/down pe/slurp-forward-fully th/root-locmarked-string))) + (is (= "foo (bar baz ⊚1 2 [3 4] :bip :bop) :bap" (-> zloc z/up pe/splice th/root-locmarked-string))) + (is (= "foo (bar baz ⊚2 [3 4] :bip :bop) :bap" (-> zloc z/right pe/splice-killing-backward th/root-locmarked-string))) + (is (= "foo (bar baz ⊚2 [3 4] :bip :bop) :bap" (-> zloc z/right pe/splice-killing-backward th/root-locmarked-string))) + (is (= "foo (bar baz [⊚1] [2] [3 4] :bip :bop) :bap" (-> zloc pe/split th/root-locmarked-string))) + (when (:track-position? opts) + (is (= "foo (bar baz [1 2] [⊚3] [4] :bip :bop) :bap" (-> zloc (pe/split-at-pos {:row 1 :col 22}) th/root-locmarked-string)))) + (is (= "foo (bar baz [#{⊚1} 2] [3 4] :bip :bop) :bap" (-> zloc (pe/wrap-around :set) th/root-locmarked-string))) + (is (= "foo (bar baz [{⊚1 2}] [3 4] :bip :bop) :bap" (-> zloc (pe/wrap-fully-forward-slurp :map) th/root-locmarked-string)))))))