Skip to content

Commit

Permalink
paredit: support ops after update
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@lread
lread committed Feb 20, 2025
1 parent 5542b62 commit fb97069
Show file tree
Hide file tree
Showing 3 changed files with 161 additions and 54 deletions.
2 changes: 2 additions & 0 deletions CHANGELOG.adoc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
106 changes: 63 additions & 43 deletions src/rewrite_clj/paredit.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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))))))))

Expand All @@ -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))
Expand Down
107 changes: 96 additions & 11 deletions test/rewrite_clj/paredit_test.cljc
View file
Original file line number Diff line number Diff line change
@@ -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]))
Expand Down Expand Up @@ -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]
Expand Down Expand Up @@ -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})]
Expand Down Expand Up @@ -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)))))))

0 comments on commit fb97069

Please sign in to comment.