Skip to content

Commit fb97069

Browse files
lreadlread
committed
paredit: support ops after update
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
1 parent 5542b62 commit fb97069

File tree

3 files changed

+161
-54
lines changed

3 files changed

+161
-54
lines changed

‎CHANGELOG.adoc

+2
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ A release with known breaking changes is marked with:
2727
* `rewrite-clj.zip/insert-right` and `rewrite-clj.zip/append-child` no longer insert a space when inserting/appending after a comment node.
2828
{issue}346[#346] ({lread})
2929
* `rewrite.clj.paredit`
30+
** now supports paredit ops on new/changed nodes in a zipper
31+
{issue}256[#256] ({lread}, thanks for the issue {person}mrkam2[mrkam2]!)
3032
** `pos` arguments now accept vector `[row col]` in addition to map `{:row :col}`
3133
{issue}344[#344] ({lread})
3234
** `join` now takes type of left sequence

‎src/rewrite_clj/paredit.cljc

+63-43
Original file line numberDiff line numberDiff line change
@@ -51,18 +51,13 @@
5151
loc
5252
(->> loc (iterate f) (take (inc n)) last)))
5353

54-
(defn- top
55-
[zloc]
56-
(->> zloc
57-
(iterate z/up)
54+
(defn- count-moves [zloc f]
55+
(->> (iterate f zloc)
5856
(take-while identity)
59-
last))
57+
count))
6058

61-
(defn- global-find-by-node
62-
[zloc n]
63-
(-> zloc
64-
top
65-
(z/find z/next* #(= (meta (z/node %)) (meta n)))))
59+
(defn- thread-friendly-skip [zloc f p?]
60+
(ws/skip f p? zloc))
6661

6762
(defn- nodes-by-dir
6863
([zloc f] (nodes-by-dir zloc f constantly))
@@ -420,7 +415,6 @@
420415
(take (inc n-slurps))
421416
last))))))
422417

423-
424418
(defn ^{:deprecated "1.1.49"} slurp-forward-fully
425419
"DEPRECATED: We recommend [[slurp-forward-fully-into]]] for more control.
426420
@@ -657,33 +651,56 @@
657651
"See [[rewrite-clj.zip/splice]]"
658652
z/splice)
659653

660-
(defn- splice-killing
661-
[zloc f]
662-
(if-not (z/up zloc)
663-
zloc
664-
(-> zloc
665-
(f (constantly true))
666-
z/up
667-
splice
668-
(global-find-by-node (z/node zloc)))))
669-
670654
(defn splice-killing-backward
671-
"Remove left siblings of current given node in S-Expression and unwrap remaining into enclosing S-expression
655+
"Return `zloc` with current and right siblings spliced into parent sequence.
672656
673-
- `(foo (let ((x 5)) |(sqrt n)) bar) => (foo (sqrt n) bar)`"
657+
- `(a (b c |d e f) g) => (a |d e f g)`
658+
- `(foo (let ((x 5)) |(sqrt n)) bar) => (foo |(sqrt n) bar)`"
674659
[zloc]
675-
(splice-killing zloc u/remove-left-while))
660+
(cond
661+
(not (z/up zloc))
662+
zloc
663+
664+
(empty-seq? (z/up zloc))
665+
(let [zloc-parent (z/up zloc)]
666+
(or
667+
(some-> zloc-parent z/left (u/remove-right-while z/whitespace?) u/remove-right)
668+
(some-> zloc-parent z/right (u/remove-left-while z/whitespace?) u/remove-left)
669+
(-> zloc-parent z/remove)))
670+
671+
:else
672+
(-> zloc
673+
(u/remove-left-while (constantly true))
674+
z/up
675+
splice)))
676676

677677
(defn splice-killing-forward
678-
"Remove current given node and its right siblings in S-Expression and unwrap remaining into enclosing S-expression
678+
"Return `zloc` with left siblings spliced into parent sequence.
679679
680-
- `(a (b c |d e) f) => (a b |c f)`"
680+
- `(a (b c |d e f) g) => (a b |c g)`"
681681
[zloc]
682-
(if (and (z/up zloc) (not (z/leftmost? zloc)))
683-
(splice-killing (z/left zloc) u/remove-right-while)
684-
(if (z/up zloc)
685-
(-> zloc z/up z/remove)
686-
zloc)))
682+
(cond
683+
(not (z/up zloc))
684+
zloc
685+
686+
(or (z/leftmost? zloc) (empty-seq? (z/up zloc)))
687+
(let [zloc-parent (z/up zloc)]
688+
(or
689+
(some-> zloc-parent z/left (u/remove-right-while z/whitespace?) u/remove-right)
690+
(some-> zloc-parent z/right (u/remove-left-while z/whitespace?) u/remove-left)
691+
(-> zloc-parent z/remove)))
692+
693+
:else
694+
(let [n-right-sibs-parent (-> zloc z/up (count-moves z/right))
695+
zloc (-> zloc
696+
kill
697+
(thread-friendly-skip z/left* z/whitespace?))
698+
n-left-sibs-seq (count-moves zloc z/left)]
699+
(-> zloc
700+
z/up
701+
splice
702+
z/rightmost
703+
(move-n z/left (inc (- n-right-sibs-parent n-left-sibs-seq)))))))
687704

688705
(defn split
689706
"Return `zloc` with parent sequence split into to two sequences at current node.
@@ -719,20 +736,20 @@
719736
z/down
720737
z/rightmost))))))
721738

722-
(defn- split-string [zloc pos]
723-
(let [bounds (-> zloc z/node meta)
724-
row-idx (- (:row pos) (:row bounds))
739+
(defn- split-string [zloc [split-row split-col]]
740+
(let [[elem-row elem-col] (z/position zloc)
741+
lines-ndx (- split-row elem-row)
725742
lines (-> zloc z/node :lines)
726-
split-col (if-not (= (:row pos) (:row bounds))
727-
(dec (:col pos))
728-
(- (:col pos) (inc (:col bounds))))]
743+
split-col (if-not (= split-row elem-row)
744+
(dec split-col)
745+
(- split-col (inc elem-col)))]
729746
(-> zloc
730747
(z/replace (nd/string-node
731-
(-> (take (inc row-idx) lines)
748+
(-> (take (inc lines-ndx) lines)
732749
vec
733-
(update-in [row-idx] #(subs % 0 split-col)))))
750+
(update-in [lines-ndx] #(subs % 0 split-col)))))
734751
(z/insert-right (nd/string-node
735-
(-> (drop row-idx lines)
752+
(-> (drop lines-ndx lines)
736753
vec
737754
(update-in [0] #(subs % split-col))))))))
738755

@@ -750,9 +767,12 @@
750767
- `(\"Hello |World\") => (|\"Hello\" \"World\")`"
751768
[zloc pos]
752769
(if-let [candidate (z/find-last-by-pos zloc pos)]
753-
(let [pos (fz/pos-as-map pos)
754-
candidate-pos (fz/pos-as-map (-> candidate z/position fz/pos-as-map))]
755-
(if (and (string-node? candidate) (not= pos candidate-pos))
770+
(let [pos (fz/pos-as-vec pos)
771+
[candidate-pos candidate-end-pos] (-> candidate z/position-span)
772+
candidate-end-pos (update candidate-end-pos 1 dec)]
773+
(if (and (string-node? candidate)
774+
(not= pos candidate-pos)
775+
(not= pos candidate-end-pos))
756776
(split-string candidate pos)
757777
(split candidate)))
758778
zloc))

‎test/rewrite_clj/paredit_test.cljc

+96-11
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
(ns rewrite-clj.paredit-test
22
(:require [clojure.test :refer [deftest is testing]]
3+
[rewrite-clj.node :as n]
34
[rewrite-clj.paredit :as pe]
45
[rewrite-clj.zip :as z]
56
[rewrite-clj.zip.test-helper :as th]))
@@ -391,22 +392,55 @@
391392
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
392393
(is (= expected (-> zloc (pe/wrap-fully-forward-slurp t) th/root-locmarked-string)) "string after")))))))
393394

395+
;; TODO what about comments?
394396
(deftest splice-killing-backward-test
395397
(doseq [opts zipper-opts]
396-
(testing (zipper-opts-desc opts)
397-
(let [res (-> (th/of-locmarked-string "(foo (let ((x 5)) ⊚(sqrt n)) bar)" opts)
398-
pe/splice-killing-backward)]
399-
(is (= "(foo ⊚(sqrt n) bar)" (th/root-locmarked-string res)))))))
398+
(testing (str "zipper opts" opts)
399+
(doseq [[s expected]
400+
[["(foo (let ((x 5)) ⊚(sqrt n)) bar)" "(foo ⊚(sqrt n) bar)"]
401+
["( a ( b c ⊚d e f) g)" "( a ⊚d e f g)"]
402+
["( [a] ( [b] [c] ⊚[d] [e] [f]) [g])" "( [a] ⊚[d] [e] [f] [g])"]
403+
["( [a] ( [b] [c] [d] [e] ⊚[f]) [g])" "( [a] ⊚[f] [g])"]
404+
["( (⊚ ) [g])" "( ⊚[g])"]
405+
["( [a] (⊚ ))" "( ⊚[a])"]
406+
["( (⊚ ))" "⊚()"]
407+
["[⊚1]" "⊚1"]
408+
["[⊚1 2]" "⊚1 2"]
409+
["[1 2 ⊚3 4 5]" "⊚3 4 5"]
410+
["[1 2⊚ 3 4 5]" "⊚3 4 5"]
411+
["[1 2 3 4 5⊚ ]" "◬"]]]
412+
(testing s
413+
(let [zloc (th/of-locmarked-string s opts)
414+
res (pe/splice-killing-backward zloc)]
415+
(is (= s (th/root-locmarked-string zloc)) "(sanity) s before change")
416+
(is (= expected (th/root-locmarked-string res)) "root-string after")))))))
400417

418+
;; TODO what about comments?
401419
(deftest splice-killing-forward-test
402420
(doseq [opts zipper-opts]
403-
(testing (zipper-opts-desc opts)
404-
(doseq [[s expected]
405-
[["(a (b c ⊚d e) f)" "(a b ⊚c f)"]
406-
["(a (⊚b c d e) f)" "(⊚a f)"]]]
407-
(let [zloc (th/of-locmarked-string s opts)]
408-
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
409-
(is (= expected (-> zloc pe/splice-killing-forward th/root-locmarked-string)) "string after"))))))
421+
(testing (str "zipper opts" opts)
422+
(doseq [[s expected]
423+
[["(a (b c ⊚d e f) g)" "(a b ⊚c g)"]
424+
["(a (⊚b c d e) f)" "(⊚a f)"]
425+
["( a ( b c ⊚d e f) g)" "( a b ⊚c g)"]
426+
["( [a] ( [b] [c] ⊚[d] [e] [f]) [g])" "( [a] [b] ⊚[c] [g])"]
427+
["( [a] ( ⊚[b] [c] [d] [e] [f]) [g])" "( ⊚[a] [g])"]
428+
["( ( ⊚[b] [c] [d] [e] [f]) [g])" "( ⊚[g])"]
429+
["( [a] ( ⊚[b] [c] [d] [e] [f]))" "( ⊚[a])"]
430+
["( ( ⊚[b] [c] [d] [e] [f]))" "⊚()"]
431+
["( (⊚ ) [g])" "( ⊚[g])"]
432+
["( [a] (⊚ ))" "( ⊚[a])"]
433+
["( (⊚ ))" "⊚()"]
434+
["[⊚1]" "◬"]
435+
["[⊚1 2]" "◬"]
436+
["[1 2 ⊚3 4 5]" "1 ⊚2"]
437+
["[1 2⊚ 3 4 5]" "1 ⊚2"]
438+
["[ ⊚1 2 3 4 5 ]" "◬"]]]
439+
(testing s
440+
(let [zloc (th/of-locmarked-string s opts)
441+
res (pe/splice-killing-forward zloc)]
442+
(is (= s (th/root-locmarked-string zloc)) "(sanity) s before change")
443+
(is (= expected (th/root-locmarked-string res)) "root-string after")))))))
410444

411445
(deftest split-test
412446
(doseq [opts zipper-opts]
@@ -436,6 +470,8 @@
436470
[["(\"Hello ⊚World\" 42)" "(⊚\"Hello \" \"World\" 42)"]
437471
["(\"⊚Hello World\" 101)" "(⊚\"\" \"Hello World\" 101)"]
438472
["(\"H⊚ello World\" 101)" "(⊚\"H\" \"ello World\" 101)"]
473+
["(\"Hello World⊚\" 101)" "(⊚\"Hello World\") (101)"]
474+
["bingo bango (\"Hello\n Wor⊚ld\" 101)" "bingo bango (⊚\"Hello\n Wor\" \"ld\" 101)"]
439475
["(⊚\"Hello World\" 101)" "(⊚\"Hello World\") (101)"]]]
440476
(let [{:keys [pos s]} (th/pos-and-s s)
441477
zloc (z/of-string* s {:track-position? true})]
@@ -485,3 +521,52 @@
485521
(let [zloc (th/of-locmarked-string s opts)]
486522
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
487523
(is (= expected (-> zloc pe/move-to-prev th/root-locmarked-string)) "string after"))))))
524+
525+
(deftest ops-on-changed-zipper-test
526+
(doseq [opts zipper-opts]
527+
(testing (str "zipper opts " opts)
528+
;; create our zipper dynamically to avoid any reader metadata
529+
;; we used to rely on this metadata and it was a problem
530+
;; see https://github.com/clj-commons/rewrite-clj/issues/256
531+
(let [zloc (-> (z/of-node (n/forms-node
532+
[(n/token-node 'foo) (n/spaces 1)
533+
(n/list-node
534+
[(n/token-node 'bar) (n/spaces 1)
535+
(n/token-node 'baz) (n/spaces 1)
536+
(n/vector-node
537+
[(n/token-node 1) (n/spaces 1)
538+
(n/token-node 2)])
539+
(n/spaces 1)
540+
(n/vector-node
541+
[(n/token-node 3) (n/spaces 1)
542+
(n/token-node 4)])
543+
(n/spaces 1)
544+
(n/keyword-node :bip) (n/spaces 1)
545+
(n/keyword-node :bop)])
546+
(n/spaces 1)
547+
(n/token-node :bap)])
548+
opts)
549+
z/right z/down z/right z/right z/down)]
550+
;; 1 2 3 4
551+
;; 12345678901234567890123456789012345678901
552+
(is (= "foo (bar baz [⊚1 2] [3 4] :bip :bop) :bap" (th/root-locmarked-string zloc)) "(sanity) before")
553+
(is (= "foo (bar baz ⊚1 [2] [3 4] :bip :bop) :bap" (-> zloc pe/barf-backward th/root-locmarked-string)))
554+
(is (= "foo (bar baz [⊚1] 2 [3 4] :bip :bop) :bap" (-> zloc pe/barf-forward th/root-locmarked-string)))
555+
(is (= "foo (bar baz [1 2 ⊚3 4] :bip :bop) :bap" (-> zloc z/up z/right pe/join th/root-locmarked-string)))
556+
(is (= "foo (bar baz ⊚[] [3 4] :bip :bop) :bap" (-> zloc pe/kill th/root-locmarked-string)))
557+
(when (:track-position? opts)
558+
(is (= "foo (bar baz [1 2] [3 4]⊚ ) :bap" (-> zloc (pe/kill-at-pos {:row 1 :col 28}) th/root-locmarked-string))))
559+
(is (= "foo (bar baz ⊚1 [2] [3 4] :bip :bop) :bap" (-> zloc pe/move-to-prev th/root-locmarked-string)))
560+
(is (= "foo (bar baz ⊚1 [3 4] :bip :bop) :bap" (-> zloc pe/raise th/root-locmarked-string)))
561+
(is (= "foo (bar [baz ⊚1 2] [3 4] :bip :bop) :bap" (-> zloc pe/slurp-backward th/root-locmarked-string)))
562+
(is (= "foo ([bar baz ⊚1 2] [3 4] :bip :bop) :bap" (-> zloc pe/slurp-backward-fully th/root-locmarked-string)))
563+
(is (= "foo (bar baz [⊚1 2 [3 4]] :bip :bop) :bap" (-> zloc pe/slurp-forward th/root-locmarked-string)))
564+
(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)))
565+
(is (= "foo (bar baz ⊚1 2 [3 4] :bip :bop) :bap" (-> zloc z/up pe/splice th/root-locmarked-string)))
566+
(is (= "foo (bar baz ⊚2 [3 4] :bip :bop) :bap" (-> zloc z/right pe/splice-killing-backward th/root-locmarked-string)))
567+
(is (= "foo (bar baz ⊚2 [3 4] :bip :bop) :bap" (-> zloc z/right pe/splice-killing-backward th/root-locmarked-string)))
568+
(is (= "foo (bar baz [⊚1] [2] [3 4] :bip :bop) :bap" (-> zloc pe/split th/root-locmarked-string)))
569+
(when (:track-position? opts)
570+
(is (= "foo (bar baz [1 2] [⊚3] [4] :bip :bop) :bap" (-> zloc (pe/split-at-pos {:row 1 :col 22}) th/root-locmarked-string))))
571+
(is (= "foo (bar baz [#{⊚1} 2] [3 4] :bip :bop) :bap" (-> zloc (pe/wrap-around :set) th/root-locmarked-string)))
572+
(is (= "foo (bar baz [{⊚1 2}] [3 4] :bip :bop) :bap" (-> zloc (pe/wrap-fully-forward-slurp :map) th/root-locmarked-string)))))))

0 commit comments

Comments
 (0)