Skip to content

Commit 7cb10d7

Browse files
lreadlread
committed
paredit: barf fns: support ops after update
`barf-forward` and `barf-backward` rewritten to not use `global-find-by-node`. Contributes to #256
1 parent 819a769 commit 7cb10d7

File tree

2 files changed

+98
-57
lines changed

2 files changed

+98
-57
lines changed

‎src/rewrite_clj/paredit.cljc

+53-36
Original file line numberDiff line numberDiff line change
@@ -555,48 +555,65 @@
555555
(slurp-backward-fully-into zloc {:from :parent})))
556556

557557
(defn barf-forward
558-
"Push out the rightmost node of the current S-expression into outer right form.
558+
"Returns `zloc` with rightmost node of the parent sequence pushed right out of the sequence.
559559
560-
- `[1 2 [|3 4] 5] => [1 2 [|3] 4 5]`"
561-
[zloc]
562-
(let [barfee-loc (z/rightmost zloc)]
560+
Comments and newlines preceding barfed node are also barfed.
563561
564-
(if-not (z/up zloc)
565-
zloc
566-
(let [preserves (->> (-> barfee-loc
567-
z/left*
568-
(nodes-by-dir z/left* ws/whitespace-or-comment?))
569-
(filter #(or (nd/linebreak? %) (nd/comment? %)))
570-
reverse)]
571-
(-> barfee-loc
572-
(u/remove-left-while ws/whitespace-or-comment?)
573-
(u/remove-right-while ws/whitespace?)
574-
u/remove-and-move-up
575-
(z/insert-right (z/node barfee-loc))
576-
((partial reduce z/insert-right) preserves)
577-
(#(or (global-find-by-node % (z/node zloc))
578-
(global-find-by-node % (z/node barfee-loc)))))))))
562+
- `[1 2 [|3 4] 5] => [1 2 [|3] 4 5]`
563+
- `[1 2 [|3] 4 5] => [1 2 [] |3 4 5]`"
564+
[zloc]
565+
(if-not (z/up zloc)
566+
zloc
567+
(let [barfee-loc (z/rightmost zloc)
568+
also-barf (linebreak-and-comment-nodes barfee-loc z/left*)
569+
adjust-location (fn [zloc-barf-seq]
570+
(let [left-sibs (count (zraw/lefts zloc))
571+
barf-loc (if (z/whitespace-or-comment? zloc)
572+
(or (z/right zloc) (z/left zloc))
573+
zloc)]
574+
(if (= barfee-loc barf-loc)
575+
(z/right zloc-barf-seq)
576+
(-> zloc-barf-seq z/down (move-n z/right* left-sibs)))))
577+
adjust-ws (fn [zloc-before-also-barf]
578+
(if (and (seq also-barf)
579+
(some-> zloc-before-also-barf z/right* z/whitespace?))
580+
(u/remove-right zloc-before-also-barf)
581+
zloc-before-also-barf))]
582+
(-> barfee-loc
583+
(u/remove-left-while ws/whitespace-or-comment?)
584+
(u/remove-right-while ws/whitespace?)
585+
u/remove-and-move-up
586+
(z/insert-right (z/node barfee-loc))
587+
adjust-ws
588+
(reduce-into-zipper z/insert-right* also-barf)
589+
adjust-location))))
579590

580591
(defn barf-backward
581-
"Push out the leftmost node of the current S-expression into outer left form.
592+
"Returns `zloc` with leftmost node of the parent sequence pushed left out of the sequence.
582593
583-
- `[1 2 [3 |4] 5] => [1 2 3 [|4] 5]`"
594+
- `[1 2 [3 |4] 5] => [1 2 3 [|4] 5]`
595+
- `[1 2 3 [|4] 5] => [1 2 3 |4 [] 5]`"
584596
[zloc]
585-
(let [barfee-loc (z/leftmost zloc)]
586-
(if-not (z/up zloc)
587-
zloc
588-
(let [preserves (->> (-> barfee-loc
589-
z/right*
590-
(nodes-by-dir z/right* ws/whitespace-or-comment?))
591-
(filter #(or (nd/linebreak? %) (nd/comment? %))))]
592-
(-> barfee-loc
593-
(u/remove-left-while ws/whitespace?)
594-
(u/remove-right-while ws/whitespace-or-comment?) ;; probably insert space when on same line !
595-
z/remove*
596-
(z/insert-left (z/node barfee-loc))
597-
((partial reduce z/insert-left) preserves)
598-
(#(or (global-find-by-node % (z/node zloc))
599-
(global-find-by-node % (z/node barfee-loc)))))))))
597+
(if-not (z/up zloc)
598+
zloc
599+
(let [barfee-loc (z/leftmost zloc)
600+
also-barf (linebreak-and-comment-nodes barfee-loc z/right*)
601+
adjust-location (fn [zloc-barf-seq]
602+
(let [right-sibs (count (zraw/rights zloc))
603+
barf-loc (if (z/whitespace-or-comment? zloc)
604+
(or (z/left zloc) (z/right zloc))
605+
zloc)]
606+
607+
(if (= barfee-loc barf-loc)
608+
(z/left zloc-barf-seq)
609+
(-> zloc-barf-seq z/down* z/rightmost* (move-n z/left* right-sibs)))))]
610+
(-> barfee-loc
611+
(u/remove-left-while ws/whitespace?)
612+
(u/remove-right-while ws/whitespace-or-comment?)
613+
u/remove-and-move-up
614+
(z/insert-left (z/node barfee-loc))
615+
(reduce-into-zipper z/insert-left* also-barf)
616+
adjust-location))))
600617

601618
(defn wrap-around
602619
"Wrap current node with a given type `t` where `t` can be one of `:vector`, `:list`, `:set`, `:map` `:fn`.

‎test/rewrite_clj/paredit_test.cljc

+45-21
Original file line numberDiff line numberDiff line change
@@ -291,31 +291,55 @@
291291
(deftest barf-forward-test
292292
(doseq [opts zipper-opts]
293293
(testing (zipper-opts-desc opts)
294-
(doseq [[s expected]
295-
[["[[⊚1 2 3] 4]" "[[⊚1 2] 3 4]"]
296-
["[[1 ⊚2 3] 4]" "[[1 ⊚2] 3 4]"]
297-
["[[1 2 ⊚3] 4]" "[[1 2] ⊚3 4]"]
298-
["[[1 2 3⊚ ] 4]" "[[1 2] ⊚3 4]"]
299-
["[[⊚1] 2]" "[[] ⊚1 2]"]
300-
["(⊚(x) 1)" "(⊚(x)) 1"]
301-
["(⊚(x)1)" "(⊚(x)) 1"]
302-
["(⊚(x)(y))" "(⊚(x)) (y)"]
303-
["[⊚{:a 1} {:b 2} {:c 3}]" "[⊚{:a 1} {:b 2}] {:c 3}"]
304-
["[{:a 1} ⊚{:b 2} {:c 3}]" "[{:a 1} ⊚{:b 2}] {:c 3}"]
305-
["[{:a 1} {:b 2} ⊚{:c 3}]" "[{:a 1} {:b 2}] ⊚{:c 3}"]]]
306-
(let [zloc (th/of-locmarked-string s opts)]
307-
(is (= s (th/root-locmarked-string zloc)) "string before")
308-
(is (= expected (-> zloc pe/barf-forward th/root-locmarked-string)) "string after"))))))
294+
(doseq [[s expected]
295+
[["[[1 ⊚2 3] 4]" "[[1 ⊚2] 3 4]"]
296+
["[[⊚1 2 3] 4]" "[[⊚1 2] 3 4]" ]
297+
["[[1 2 ⊚3] 4]" "[[1 2] ⊚3 4]"]
298+
["[[1 2 3⊚ ] 4]" "[[1 2] ⊚3 4]"]
299+
["[[1 2⊚ 3] 4]" "[[1 2] ⊚3 4]"]
300+
["[[⊚1] 2]" "[[] ⊚1 2]"]
301+
["(⊚(x) 1)" "(⊚(x)) 1"]
302+
["(⊚(x)1)" "(⊚(x)) 1"]
303+
["(⊚(x)(y))" "(⊚(x)) (y)"]
304+
["[⊚{:a 1} {:b 2} {:c 3}]" "[⊚{:a 1} {:b 2}] {:c 3}"]
305+
["[{:a 1} ⊚{:b 2} {:c 3}]" "[{:a 1} ⊚{:b 2}] {:c 3}"]
306+
["[{:a 1} {:b 2} ⊚{:c 3}]" "[{:a 1} {:b 2}] ⊚{:c 3}"]
307+
["[⊚1 ;; comment\n2]" "[⊚1];; comment\n2"]
308+
["[1 ⊚;; comment\n2]" "[1];; comment\n⊚2"]
309+
["[1 ;; comment\n⊚2]" "[1];; comment\n⊚2"]
310+
["[1 ;; comment\n⊚2]" "[1];; comment\n⊚2"]
311+
["[1 ;; cmt1\n;; cmt2\n⊚2]" "[1];; cmt1\n;; cmt2\n⊚2"]
312+
["[1 \n \n;; cmt1\n \n;; cmt2\n \n\n ⊚2]" "[1]\n\n;; cmt1\n\n;; cmt2\n\n\n⊚2"]]]
313+
(testing s
314+
(let [zloc (th/of-locmarked-string s opts)]
315+
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
316+
(is (= expected (-> zloc pe/barf-forward th/root-locmarked-string)) "root string after")))))))
309317

310318
(deftest barf-backward-test
311319
(doseq [opts zipper-opts]
312320
(testing (zipper-opts-desc opts)
313-
(doseq [[s expected]
314-
[["[1 [2 3 ⊚4]]" "[1 2 [3 ⊚4]]"]
315-
["[1 [⊚2 3 4]]" "[1 ⊚2 [3 4]]"]]]
316-
(let [zloc (th/of-locmarked-string s opts)]
317-
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
318-
(is (= expected (-> zloc pe/barf-backward th/root-locmarked-string)) "string after"))))))
321+
(doseq [[s expected]
322+
[["[1 [2 ⊚3 4]]" "[1 2 [⊚3 4]]"]
323+
["[1 [2 3 ⊚4]]" "[1 2 [3 ⊚4]]"]
324+
["[1 [⊚2 3 4]]" "[1 ⊚2 [3 4]]"]
325+
["[1 [2⊚ 3 4]]" "[1 ⊚2 [3 4]]"]
326+
["[1 [⊚ 2 3 4]]" "[1 ⊚2 [3 4]]"]
327+
["[1 [⊚2]]" "[1 ⊚2 []]"]
328+
["(1 ⊚(x))" "1 (⊚(x))"]
329+
["(1⊚(x))" "1 (⊚(x))"]
330+
["((x)⊚(y))" "(x) (⊚(y))"]
331+
["[{:a 1} {:b 2} ⊚{:c 3}]" "{:a 1} [{:b 2} ⊚{:c 3}]"]
332+
["[{:a 1} ⊚{:b 2} {:c 3}]" "{:a 1} [⊚{:b 2} {:c 3}]"]
333+
["[⊚{:a 1} {:b 2} {:c 3}]" "⊚{:a 1} [{:b 2} {:c 3}]"]
334+
["[1 ;; comment\n⊚2]" "1 ;; comment\n[⊚2]"]
335+
["[1 ⊚;; comment\n2]" "⊚1 ;; comment\n[2]"]
336+
["[⊚1 ;; comment\n2]" "⊚1 ;; comment\n[2]"]
337+
["[⊚1 ;; cmt1\n;; cmt2\n2]" "⊚1 ;; cmt1\n;; cmt2\n[2]"]
338+
["[⊚1 \n \n;; cmt1\n \n;; cmt2\n \n\n 2]" "⊚1 \n\n;; cmt1\n\n;; cmt2\n\n\n[2]"]]]
339+
(testing s
340+
(let [zloc (th/of-locmarked-string s opts)]
341+
(is (= s (th/root-locmarked-string zloc)) "(sanity) string before")
342+
(is (= expected (-> zloc pe/barf-backward th/root-locmarked-string)) "root string after")))))))
319343

320344
(deftest wrap-around-test
321345
(doseq [opts zipper-opts]

0 commit comments

Comments
 (0)