Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

paredit: support ops after update #365

Merged
merged 1 commit into from
Feb 20, 2025
Merged

paredit: support ops after update #365

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG.adoc
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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)))))))
Loading