Introduce threading refactoring commands

CHANGELOG.md

@@ -11,6 +11,8 @@
   - Consistent indentation with regular forms.
   - Support for automatic aligning forms.
 - [#88](https://github.com/clojure-emacs/clojure-ts-mode/pull/88): Introduce `clojure-ts-unwind` and `clojure-ts-unwind-all`.
+- [#89](https://github.com/clojure-emacs/clojure-ts-mode/pull/89): Introduce `clojure-ts-thread`, `clojure-ts-thread-first-all` and
+  `clojure-ts-thread-last-all`.
 
 ## 0.3.0 (2025-04-15)
 

README.md

@@ -376,24 +376,66 @@ following customization:
 
 ### Threading macros related features
 
+`clojure-thread`: Thread another form into the surrounding thread. Both
+`->>`/`some->>` and `->`/`some->` variants are supported.
+
 `clojure-unwind`: Unwind a threaded expression. Supports both `->>`/`some->>`
 and `->`/`some->`.
 
+`clojure-thread-first-all`: Introduce the thread first macro (`->`) and rewrite
+the entire form. With a prefix argument do not thread the last form.
+
+`clojure-thread-last-all`: Introduce the thread last macro and rewrite the
+entire form. With a prefix argument do not thread the last form.
+
 `clojure-unwind-all`: Fully unwind a threaded expression removing the threading
 macro.
 
 ### Default keybindings
 
-| Keybinding  | Command             |
-|:------------|:--------------------|
-| `C-c SPC`   | `clojure-ts-align`  |
-| `C-c C-r u` | `clojure-ts-unwind` |
+| Keybinding                  | Command                       |
+|:----------------------------|:------------------------------|
+| `C-c SPC`                   | `clojure-ts-align`            |
+| `C-c C-r t` / `C-c C-r C-t` | `clojure-ts-thread`           |
+| `C-c C-r u` / `C-c C-r C-u` | `clojure-ts-unwind`           |
+| `C-c C-r f` / `C-c C-r C-f` | `clojure-ts-thread-first-all` |
+| `C-c C-r l` / `C-c C-r C-l` | `clojure-ts-thread-last-all`  |
 
 ### Customize refactoring commands prefix
 
 By default prefix for all refactoring commands is `C-c C-r`. It can be changed
 by customizing `clojure-ts-refactor-map-prefix` variable.
 
+### Customize threading refactoring behavior
+
+By default `clojure-ts-thread-first-all` and `clojure-ts-thread-last-all` will
+thread all nested expressions. For example this expression:
+
+```clojure
+(->map (assoc {} :key "value") :lock)
+```
+
+After executing `clojure-ts-thread-last-all` will be converted to:
+
+```clojure
+(-> {}
+    (assoc :key "value")
+    (->map :lock))
+```
+
+This behavior can be changed by setting:
+
+```emacs-lisp
+(setopt clojure-ts-thread-all-but-last t)
+```
+
+Then the last expression will not be threaded and the result will be:
+
+```clojure
+(-> (assoc {} :key "value")
+    (->map :lock))
+```
+
 ## Migrating to clojure-ts-mode
 
 If you are migrating to `clojure-ts-mode` note that `clojure-mode` is still

clojure-ts-mode.el

@@ -150,6 +150,16 @@ three or more semicolons will be treated as outline headings.  If set to
   :type 'string
   :package-version '(clojure-ts-mode . "0.4"))
 
+(defcustom clojure-ts-thread-all-but-last nil
+  "Non-nil means do not thread the last expression.
+
+This means that `clojure-ts-thread-first-all' and
+`clojure-ts-thread-last-all' not thread the deepest sexp inside the
+current sexp."
+  :package-version '(clojure-ts-mode . "0.4.0")
+  :safe #'booleanp
+  :type 'boolean)
+
 (defcustom clojure-ts-align-reader-conditionals nil
   "Whether to align reader conditionals, as if they were maps."
   :package-version '(clojure-ts-mode . "0.4")
@@ -1291,9 +1301,9 @@ according to the rule.  If NODE is nil, use next node after BOL."
            (clojure-ts--anon-fn-node-p parent))
        ;; Can the following two clauses be replaced by checking indexes?
        ;; Does the second child exist, and is it not equal to the current node?
-       (treesit-node-child parent 1 t)
-       (not (treesit-node-eq (treesit-node-child parent 1 t) node))
-       (let ((first-child (treesit-node-child parent 0 t)))
+       (clojure-ts--node-child-skip-metadata parent 1)
+       (not (treesit-node-eq (clojure-ts--node-child-skip-metadata parent 1) node))
+       (let ((first-child (clojure-ts--node-child-skip-metadata parent 0)))
          (or (clojure-ts--symbol-node-p first-child)
              (clojure-ts--keyword-node-p first-child)
              (clojure-ts--var-node-p first-child)))))
@@ -1381,17 +1391,11 @@ if NODE has metadata and its parent has type NODE-TYPE."
                   (treesit-node-type
                    (clojure-ts--node-with-metadata-parent node)))))
 
-(defun clojure-ts--anchor-nth-sibling (n &optional named)
-  "Return the start of the Nth child of PARENT.
-
-NAMED non-nil means count only named nodes.
-
-NOTE: This is a replacement for built-in `nth-sibling' anchor preset,
-which doesn't work properly for named nodes (see the bug
-https://debbugs.gnu.org/cgi/bugreport.cgi?bug=78065)"
+(defun clojure-ts--anchor-nth-sibling (n)
+  "Return the start of the Nth child of PARENT skipping metadata."
   (lambda (_n parent &rest _)
     (treesit-node-start
-     (treesit-node-child parent n named))))
+     (clojure-ts--node-child-skip-metadata parent n))))
 
 (defun clojure-ts--semantic-indent-rules ()
   "Return a list of indentation rules for `treesit-simple-indent-rules'."
@@ -1423,7 +1427,7 @@ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=78065)"
      ;; https://guide.clojure.style/#threading-macros-alignment
      (clojure-ts--match-threading-macro-arg prev-sibling 0)
      ;; https://guide.clojure.style/#vertically-align-fn-args
-     (clojure-ts--match-function-call-arg ,(clojure-ts--anchor-nth-sibling 1 t) 0)
+     (clojure-ts--match-function-call-arg ,(clojure-ts--anchor-nth-sibling 1) 0)
      ;; https://guide.clojure.style/#one-space-indent
      ((parent-is "list_lit") parent 1))))
 
@@ -1539,8 +1543,8 @@ BOUND bounds the whitespace search."
                      (and (not (treesit-node-child-by-field-name cur-sexp "value"))
                           (string-empty-p (clojure-ts--named-node-text cur-sexp))))
                 (treesit-end-of-thing 'sexp 2 'restricted)
-              (treesit-end-of-thing 'sexp 1 'restrict))
-            (when (looking-at ",")
+              (treesit-end-of-thing 'sexp 1 'restricted))
+            (when (looking-at-p ",")
               (forward-char))
             ;; Move past any whitespace or comment.
             (search-forward-regexp regex bound)
@@ -1744,7 +1748,7 @@ Forms between BEG and END are aligned according to
       (goto-char first-child-start)
       (treesit-beginning-of-thing 'sexp -1)
       (let ((contents (clojure-ts--delete-and-extract-sexp)))
-        (when (looking-at " *\n")
+        (when (looking-at-p " *\n")
           (join-line 'following))
         (just-one-space)
         (goto-char first-child-start)
@@ -1753,9 +1757,11 @@ Forms between BEG and END are aligned according to
           (clojure-ts--ensure-parens-around-function-name)
           (down-list)
           (forward-sexp)
-          (insert " " contents)
-          (when multiline-p
-            (insert "\n")))))))
+          (cond
+           ((and multiline-p (looking-at-p " *\n"))
+            (insert "\n" contents))
+           (multiline-p (insert " " contents "\n"))
+           (t (insert " " contents))))))))
 
 (defun clojure-ts--unwind-thread-last ()
   "Unwind a thread last macro once."
@@ -1768,7 +1774,7 @@ Forms between BEG and END are aligned according to
       (goto-char first-child-start)
       (treesit-beginning-of-thing 'sexp -1)
       (let ((contents (clojure-ts--delete-and-extract-sexp)))
-        (when (looking-at " *\n")
+        (when (looking-at-p " *\n")
           (join-line 'following))
         (just-one-space)
         (goto-char first-child-start)
@@ -1804,10 +1810,16 @@ Forms between BEG and END are aligned according to
 
 (defun clojure-ts--pop-out-of-threading ()
   "Raise a sexp up a level to unwind a threading form."
-  (let ((threading-sexp (clojure-ts--threading-sexp-node)))
+  (let* ((threading-sexp (clojure-ts--threading-sexp-node))
+         (beg (thread-first threading-sexp
+                            (treesit-node-child 0 t)
+                            (treesit-node-start))))
     (save-excursion
       (clojure-ts--skip-first-child threading-sexp)
-      (raise-sexp))))
+      (delete-region beg (point))
+      ;; `raise-sexp' doesn't work properly for function literals (it loses one
+      ;; of the parenthesis).  Seems like an Emacs' bug.
+      (delete-pair))))
 
 (defun clojure-ts--fix-sexp-whitespace ()
   "Fix whitespace after unwinding a threading form."
@@ -1870,10 +1882,125 @@ With universal argument \\[universal-argument], fully unwinds thread."
   (interactive)
   (clojure-ts-unwind '(4)))
 
+(defun clojure-ts--remove-superfluous-parens ()
+  "Remove extra parens from a form."
+  (when-let* ((node (treesit-thing-at-point 'sexp 'nested))
+              ((clojure-ts--list-node-p node))
+              ((= 1 (treesit-node-child-count node t))))
+    (let ((delete-pair-blink-delay 0))
+      (delete-pair))))
+
+(defun clojure-ts--thread-first ()
+  "Thread a sexp using ->."
+  (save-excursion
+    (clojure-ts--skip-first-child (clojure-ts--threading-sexp-node))
+    (down-list)
+    (treesit-beginning-of-thing 'sexp -1)
+    (let ((contents (clojure-ts--delete-and-extract-sexp)))
+      (delete-char -1)
+      (when (looking-at-p " *\n")
+        (join-line 'following))
+      (backward-up-list)
+      (insert contents "\n")
+      (clojure-ts--remove-superfluous-parens))))
+
+(defun clojure-ts--thread-last ()
+  "Thread a sexp using ->>."
+  (save-excursion
+    (clojure-ts--skip-first-child (clojure-ts--threading-sexp-node))
+    (treesit-end-of-thing 'sexp)
+    (down-list -1)
+    (treesit-beginning-of-thing 'sexp)
+    (let ((contents (clojure-ts--delete-and-extract-sexp)))
+      (delete-char -1)
+      (treesit-end-of-thing 'sexp -1 'restricted)
+      (when (looking-at-p " *\n")
+        (join-line 'following))
+      (backward-up-list)
+      (insert contents "\n")
+      (clojure-ts--remove-superfluous-parens))))
+
+(defun clojure-ts--threadable-p (node)
+  "Return non-nil if expression NODE can be threaded.
+
+First argument after threading symbol itself should be a list and it
+should have more than one named child."
+  (let ((second-child (treesit-node-child node 1 t)))
+    (and (clojure-ts--list-node-p second-child)
+         (> (treesit-node-child-count second-child t) 1))))
+
+(defun clojure-ts-thread (&optional called-by-user-p)
+  "Thread by one more level an existing threading macro.
+
+If CALLED-BY-USER-P is non-nil (which is always TRUE when called
+interactively), the function signals a `user-error' if threading form
+cannot be found."
+  (interactive "p")
+  (if-let* ((threading-sexp (clojure-ts--threading-sexp-node))
+            ((clojure-ts--threadable-p threading-sexp))
+            (sym (thread-first threading-sexp
+                               (treesit-node-child 0 t)
+                               (clojure-ts--named-node-text))))
+      (let ((beg (thread-first threading-sexp
+                               (treesit-node-start)
+                               (copy-marker)))
+            (end (thread-first threading-sexp
+                               (treesit-node-end)
+                               (copy-marker))))
+        (cond
+         ((string-match-p (rx bol (* "some") "->" eol) sym)
+          (clojure-ts--thread-first))
+         ((string-match-p (rx bol (* "some") "->>" eol) sym)
+          (clojure-ts--thread-last)))
+        (indent-region beg end)
+        (delete-trailing-whitespace beg end)
+        t)
+    (when called-by-user-p
+      (user-error "No threading form at point"))))
+
+(defun clojure-ts--thread-all (first-or-last-thread but-last)
+  "Fully thread the form at point.
+
+FIRST-OR-LAST-THREAD is either \"->\" or \"->>\".
+
+When BUT-LAST is non-nil, the last expression is not threaded. Default
+value is `clojure-ts-thread-all-but-last.'"
+  (if-let* ((list-at-point (treesit-thing-at-point 'list 'nested)))
+      (save-excursion
+        (goto-char (treesit-node-start list-at-point))
+        (insert-parentheses 1)
+        (insert first-or-last-thread)
+        (while (clojure-ts-thread))
+        (when (or but-last clojure-ts-thread-all-but-last)
+          (clojure-ts-unwind)))
+    (user-error "No list to thread at point")))
+
+(defun clojure-ts-thread-first-all (but-last)
+  "Fully thread the form at point using ->.
+
+When BUT-LAST is non-nil, the last expression is not threaded.  Default
+value is `clojure-ts-thread-all-but-last'."
+  (interactive "P")
+  (clojure-ts--thread-all "-> " but-last))
+
+(defun clojure-ts-thread-last-all (but-last)
+  "Fully thread the form at point using ->>.
+
+When BUT-LAST is non-nil, the last expression is not threaded.  Default
+value is `clojure-ts-thread-all-but-last'."
+  (interactive "P")
+  (clojure-ts--thread-all "->> " but-last))
+
 (defvar clojure-ts-refactor-map
   (let ((map (make-sparse-keymap)))
+    (keymap-set map "C-t" #'clojure-ts-thread)
+    (keymap-set map "t" #'clojure-ts-thread)
     (keymap-set map "C-u" #'clojure-ts-unwind)
     (keymap-set map "u" #'clojure-ts-unwind)
+    (keymap-set map "C-f" #'clojure-ts-thread-first-all)
+    (keymap-set map "f" #'clojure-ts-thread-first-all)
+    (keymap-set map "C-l" #'clojure-ts-thread-last-all)
+    (keymap-set map "l" #'clojure-ts-thread-last-all)
     map)
   "Keymap for `clojure-ts-mode' refactoring commands.")
 
@@ -1886,6 +2013,10 @@ With universal argument \\[universal-argument], fully unwinds thread."
       '("Clojure"
         ["Align expression" clojure-ts-align]
         ("Refactor -> and ->>"
+         ["Thread once more" clojure-ts-thread]
+         ["Fully thread a form with ->" clojure-ts-thread-first-all]
+         ["Fully thread a form with ->>" clojure-ts-thread-last-all]
+         "--"
          ["Unwind once" clojure-ts-unwind]
          ["Fully unwind a threading macro" clojure-ts-unwind-all])))
     map)

test/clojure-ts-mode-refactor-threading-test.el

@@ -28,7 +28,142 @@
 (require 'buttercup)
 (require 'test-helper "test/test-helper")
 
-(describe "clojure-unwind"
+(describe "clojure-ts-thread"
+
+  (when-refactoring-it "should work with -> when performed once"
+    "(-> (dissoc (assoc {} :key \"value\") :lock))"
+
+    "(-> (assoc {} :key \"value\")
+    (dissoc :lock))"
+
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with -> when performed twice"
+    "(-> (dissoc (assoc {} :key \"value\") :lock))"
+
+    "(-> {}
+    (assoc :key \"value\")
+    (dissoc :lock))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should not thread maps"
+    "(-> (dissoc (assoc {} :key \"value\") :lock))"
+
+    "(-> {}
+    (assoc :key \"value\")
+    (dissoc :lock))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should not thread last sexp"
+    "(-> (dissoc (assoc (get-a-map) :key \"value\") :lock))"
+
+    "(-> (get-a-map)
+    (assoc :key \"value\")
+    (dissoc :lock))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should thread-first-easy-on-whitespace"
+    "(->
+ (dissoc (assoc {} :key \"value\") :lock))"
+
+    "(->
+ (assoc {} :key \"value\")
+ (dissoc :lock))"
+
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should remove superfluous parens"
+    "(-> (square (sum [1 2 3 4 5])))"
+
+    "(-> [1 2 3 4 5]
+    sum
+    square)"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with cursor before ->"
+    "(-> (not (s-acc/mobile? session)))"
+
+    "(-> (s-acc/mobile? session)
+    not)"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with one step with ->>"
+    "(->> (map square (filter even? [1 2 3 4 5])))"
+
+    "(->> (filter even? [1 2 3 4 5])
+     (map square))"
+
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with two steps with ->>"
+    "(->> (map square (filter even? [1 2 3 4 5])))"
+
+    "(->> [1 2 3 4 5]
+     (filter even?)
+     (map square))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should not thread vectors with ->>"
+    "(->> (map square (filter even? [1 2 3 4 5])))"
+
+    "(->> [1 2 3 4 5]
+     (filter even?)
+     (map square))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should not thread last sexp with ->>"
+    "(->> (map square (filter even? (get-a-list))))"
+
+    "(->> (get-a-list)
+     (filter even?)
+     (map square))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with some->"
+    "(some-> (+ (val (find {:a 1} :b)) 5))"
+
+    "(some-> {:a 1}
+        (find :b)
+        val
+        (+ 5))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread))
+
+  (when-refactoring-it "should work with some->>"
+    "(some->> (+ 5 (val (find {:a 1} :b))))"
+
+    "(some->> :b
+         (find {:a 1})
+         val
+         (+ 5))"
+
+    (clojure-ts-thread)
+    (clojure-ts-thread)
+    (clojure-ts-thread)))
+
+(describe "clojure-ts-unwind"
 
   (when-refactoring-it "should unwind -> one step"
     "(-> {}
@@ -162,5 +297,147 @@
     (clojure-ts-unwind)
     (clojure-ts-unwind)))
 
+(describe "clojure-ts-thread-first-all"
+
+  (when-refactoring-it "should thread first all sexps"
+    "(->map (assoc {} :key \"value\") :lock)"
+
+    "(-> {}
+    (assoc :key \"value\")
+    (->map :lock))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-first-all nil))
+
+  (when-refactoring-it "should thread a form except the last expression"
+    "(->map (assoc {} :key \"value\") :lock)"
+
+    "(-> (assoc {} :key \"value\")
+    (->map :lock))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-first-all t))
+
+  (when-refactoring-it "should thread with an empty first line"
+    "(map
+   inc
+   [1 2])"
+
+    "(-> inc
+    (map
+     [1 2]))"
+
+    (goto-char (point-min))
+    (clojure-ts-thread-first-all nil))
+
+  (when-refactoring-it "should thread-first-maybe-unjoin-lines"
+    "(map
+ inc
+ [1 2])"
+
+    "(map
+ inc
+ [1 2])"
+
+    (goto-char (point-min))
+    (clojure-ts-thread-first-all nil)
+    (clojure-ts-unwind-all)))
+
+(describe "clojure-ts-thread-last-all"
+
+  (when-refactoring-it "should fully thread a form"
+    "(map square (filter even? (make-things)))"
+
+    "(->> (make-things)
+     (filter even?)
+     (map square))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-last-all nil))
+
+  (when-refactoring-it "should thread a form except the last expression"
+    "(map square (filter even? (make-things)))"
+
+    "(->> (filter even? (make-things))
+     (map square))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-last-all t))
+
+  (when-refactoring-it "should handle dangling parens 1"
+    "(map inc
+        (range))"
+
+    "(->> (range)
+     (map inc))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-last-all nil))
+
+  (when-refactoring-it "should handle dangling parens 2"
+    "(deftask dev []
+  (comp (serve)
+   (cljs)))"
+
+    "(->> (cljs)
+     (comp (serve))
+     (deftask dev []))"
+
+    (beginning-of-buffer)
+    (clojure-ts-thread-last-all nil)))
+
+(describe "clojure-ts-unwind-all"
+
+  (when-refactoring-it "should unwind all in ->"
+    "(-> {}
+     (assoc :key \"value\")
+           (dissoc :lock))"
+
+    "(dissoc (assoc {} :key \"value\") :lock)"
+
+    (beginning-of-buffer)
+    (clojure-ts-unwind-all))
+
+  (when-refactoring-it "should unwind all in ->>"
+    "(->> (make-things)
+           (filter even?)
+           (map square))"
+
+    "(map square (filter even? (make-things)))"
+
+    (beginning-of-buffer)
+    (clojure-ts-unwind-all))
+
+  (when-refactoring-it "should leave multiline sexp alone"
+    "(->> [a b]
+     (some (fn [x]
+             (when x
+               10))))"
+
+    "(some (fn [x]
+        (when x
+          10))
+      [a b])"
+
+    (clojure-ts-unwind-all))
+
+  ;; NOTE: This feature is implemented in `clojure-mode' via text properties and
+  ;; doesn't work for the same expression after restarting Emacs.  For now it's
+  ;; not implemented in `clojure-ts-mode', although we respect multiline
+  ;; expressions in some cases.
+  ;;
+  ;; (when-refactoring-it "should thread-last-maybe-unjoin-lines" "(deftask dev
+  ;; [] (comp (serve) (cljs (lala) 10)))"
+
+  ;;   "(deftask dev []
+  ;; (comp (serve)
+  ;;       (cljs (lala)
+  ;;             10)))"
+
+  ;;   (goto-char (point-min))
+  ;;   (clojure-ts-thread-last-all nil)
+  ;;   (clojure-ts-unwind-all))
+  )
+
 (provide 'clojure-ts-mode-refactor-threading-test)
 ;;; clojure-ts-mode-refactor-threading-test.el ends here

test/samples/indentation.clj

@@ -281,3 +281,13 @@
         user "John Doe"]
     (dotimes [_ (add x y)]
       (hello user))))
+
+(with-open [input-stream
+            ^java.io.BufferedInputStream
+            (foo bar
+                 baz
+                 true)
+
+            reader
+            (io/reader input-stream)]
+  (read-report (into [] (csv/read-csv reader))))

test/samples/refactoring.clj

@@ -2,6 +2,8 @@
 
 ;;; Threading
 
+;;;; Unwind
+
 (-> ;; This is comment
     (foo)
     ;; Another comment
@@ -35,3 +37,36 @@
 
 (some->> (val (find {:a 1} :b))
          (+ 5))
+
+;;;; Thread
+
+(-> (foo (bar (baz)) "arg on a separate line"))
+
+(foo (bar (baz)))
+
+(-> (foo (bar))
+    (baz))
+
+(->> (filter :active? (map :status items)))
+
+(-> (dissoc (assoc {} :key "value") :lock))
+
+
+(-> inc
+    (map [1 2]))
+
+(map
+ inc
+ [1 2])
+
+#(-> (.-value (.-target %)))
+
+(->> (range)
+     (map inc))
+
+(->> (map square (filter even? [1 2 3 4 5])))
+
+(deftask dev []
+         (comp (serve)
+               (cljs (lala)
+                     10)))