Draft: Refactor extract at toplevel

CHANGES.md

@@ -3,6 +3,7 @@ unreleased
 
 - Allows known compilation artifacts to be displayed via the `ocamlobjinfo` binary ([#56](https://github.com/tarides/ocaml-eglot/pull/56), [#61](https://github.com/tarides/ocaml-eglot/pull/61))
 - A total reimplementation of `xref` more suitable for OCaml ([#64](https://github.com/tarides/ocaml-eglot/pull/64))
+- Add `ocaml-eglot-refactor-extract` to extract region a local definition ([#65](https://github.com/tarides/ocaml-eglot/pull/65)) and attach the feature to `type-enclosing`
 
 ocaml-eglot 1.2.0
 ======================

README.md

@@ -274,6 +274,7 @@ illustrations of each command in the next section.).
 | `ocaml-eglot-type-enclosing` | <kbd>C-c</kbd> <kbd>C-t</kbd> |
 | `ocaml-eglot-occurences` | |
 | `ocaml-eglot-rename` | |
+| `ocaml-eglot-refactor-extract` | |
 
 
 ### Browsing errors
@@ -311,6 +312,8 @@ During a "type enclosing" session the following commands are available:
   expression
 - `ocaml-eglot-type-enclosing-copy` (<kbd>C-w</kbd>): to copy the
   type expression to the _kill-ring_ (clipboard)
+- `ocaml-eglot-type-enclosing-refactor-extract` (<kbd>C-e</kbd>): to
+  extract the current enclosing into a toplevel definition
 
 You can also enter an expression in the mini-buffer for which you want
 to display the type:
@@ -525,6 +528,16 @@ there are variations for controlling the window to jump to:
 - `ocaml-eglot-search-declaration-in-current-window`
 - `ocaml-eglot-search-declaration-in-new-window`
 
+### Refactoring
+
+#### Extract expression
+
+Extract the selected region into a top-level variable. If a prefix is
+provided, the command allows entering a name and passing free
+variables (_after extraction_) as arguments:
+
+![Extract Example](media/extract.gif)
+
 ### Opening up build artefacts
 
 Used to hook the opening of a compilation artefact with
@@ -561,3 +574,4 @@ Used to hook the opening of a compilation artefact with
 | `merlin-next-hole`          | `ocaml-eglot-hole-next`            |                                                                                                              |
 | `merlin-previous-hole`      | `ocaml-eglot-hole-prev`            |                                                                                                              |
 | `merlin-toggle-view-errors` | —                                  | An `eglot` configuration                                                                                     |
+| ❌                          | `ocaml-eglot-refactor-extract` |                                                                          |

ocaml-eglot-req.el

@@ -69,7 +69,8 @@ request fails.  SERVER can also be conditionnaly given."
 
 (defun ocaml-eglot-req--TextDocumentIdentifier ()
   "Compute `TextDocumentIdentifier' object for current buffer."
-  (eglot--TextDocumentIdentifier))
+  (append (list :textDocument (eglot--TextDocumentIdentifier))
+          (eglot--TextDocumentIdentifier)))
 
 (defun ocaml-eglot-req--PlainUri ()
   "A hack for requests that do not respect the URI parameter scheme."
@@ -84,8 +85,7 @@ request fails.  SERVER can also be conditionnaly given."
 (defun ocaml-eglot-req--TextDocumentPositionParamsWithPos (position)
   "Compute `TextDocumentPositionParams' object for the current buffer.
 With a given POSITION"
-  (append (list :textDocument (ocaml-eglot-req--TextDocumentIdentifier)
-                :position position)
+  (append (list :position position)
           (ocaml-eglot-req--TextDocumentIdentifier)))
 
 (defun ocaml-eglot-req--ConstructParams (position depth with-local-values)
@@ -121,8 +121,7 @@ A potential IDENTIFIER can be given and MARKUP-KIND can be parametrized."
 AT is the range or the position.
 INDEX is the index of the enclosing.
 VERBOSITY is a potential verbosity index."
-  (append (list :textDocument (ocaml-eglot-req--TextDocumentIdentifier))
-          (ocaml-eglot-req--TextDocumentIdentifier)
+  (append (ocaml-eglot-req--TextDocumentIdentifier)
           `(:at, at)
           `(:index, index)
           `(:verbosity, verbosity)))
@@ -216,6 +215,15 @@ VERBOSITY is a potential verbosity index."
   (let ((params (ocaml-eglot-req--TypeEnclosingParams at index verbosity)))
     (ocaml-eglot-req--send :ocamllsp/typeEnclosing params)))
 
+(defun ocaml-eglot-req--refactor-extract (beg end &optional name)
+  "Extract the given range (BEG END) as a toplevel expression named NAME.
+If NAME is empty, it will be computed"
+  (let ((params (append (ocaml-eglot-req--TextDocumentIdentifier)
+                        `(:start, beg)
+                        `(:stop, end)
+                        `(:extract_name, name))))
+    (ocaml-eglot-req--send :ocamllsp/refactorExtract params)))
+
 (defun ocaml-eglot-req--call-code-action (beg end action-kind)
   "Call ACTION-KIND promptly (at BEG . END)."
   (eglot-code-actions beg end action-kind t))

ocaml-eglot-type-enclosing.el

@@ -49,6 +49,7 @@
     (define-key keymap (kbd "C-c C-t") #'ocaml-eglot-type-enclosing-increase-verbosity)
     (define-key keymap (kbd "C-<right>") #'ocaml-eglot-type-enclosing-increase-verbosity)
     (define-key keymap (kbd "C-<left>") #'ocaml-eglot-type-enclosing-decrease-verbosity)
+    (define-key keymap (kbd "C-e") #'ocaml-eglot-type-enclosing-refactor-extract)
     keymap)
   "Keymap for OCaml-eglot's type enclosing transient mode.")
 
@@ -110,6 +111,20 @@ If PREV-VERB is given, the verbosity change ensure that the type is different."
                (length ocaml-eglot-type-enclosing-types)))
     (ocaml-eglot-type-enclosing--with-fixed-offset)))
 
+(defun ocaml-eglot-type-enclosing-refactor-extract ()
+  "Extract the current enclosing as a toplevel expression."
+  (interactive)
+  (ocaml-eglot-req--server-capable-or-lose :experimental :ocamllsp :handleRefactorExtract)
+  (when (and ocaml-eglot-type-enclosing-types
+             (>= (length ocaml-eglot-type-enclosing-types)
+                 ocaml-eglot-type-enclosing-offset))
+    (let* ((enclosing (aref ocaml-eglot-type-enclosing-types
+                            ocaml-eglot-type-enclosing-offset))
+           (start (cl-getf enclosing :start))
+           (end (cl-getf enclosing :end))
+           (result (ocaml-eglot-req--refactor-extract start end)))
+      (ocaml-eglot-util--perform-extraction result))))
+
 (defun ocaml-eglot-type-enclosing--type-buffer (type-expr)
   "Create buffer with content TYPE-EXPR of the enclosing type buffer."
   ; We store the current major mode to be used in the type buffer for

ocaml-eglot-util.el

@@ -22,6 +22,10 @@
 
 ;; Generic util
 
+(defun ocaml-eglot-util--nil-if-blank (term)
+  "Return nil if a TERM is blank."
+  (when (and term (not (string-blank-p term))) term))
+
 (defun ocaml-eglot-util--goto-char (target)
   "Goto the point TARGET."
   (when (or (< target (point-min))
@@ -217,12 +221,21 @@ current window otherwise."
         (t (find-file-other-window new-file)))
   (ocaml-eglot-util--jump-to-range range))
 
+(defun ocaml-eglot-util--select-range (range)
+  "Active mark for the given RANGE."
+  (let ((beg (eglot--lsp-position-to-point (cl-getf range :start)))
+        (end (eglot--lsp-position-to-point (cl-getf range :end))))
+    (goto-char beg)
+    (set-mark beg)
+    (goto-char end)
+    (activate-mark)))
+
 (defun ocaml-eglot-util--highlight-range (range face)
   "Highlight a given RANGE using a given FACE."
   (remove-overlays nil nil 'ocaml-eglot-highlight 'highlight)
   (let* ((beg (eglot--lsp-position-to-point (cl-getf range :start)))
-        (end (eglot--lsp-position-to-point (cl-getf range :end)))
-        (overlay (make-overlay beg end)))
+         (end (eglot--lsp-position-to-point (cl-getf range :end)))
+         (overlay (make-overlay beg end)))
     (overlay-put overlay 'face face)
     (overlay-put overlay 'ocaml-eglot-highlight 'highlight)
     (unwind-protect (sit-for 60) (delete-overlay overlay))))
@@ -245,5 +258,19 @@ current window otherwise."
   (string-match-p "\\.cm\\(i\\|ti\\|t\\|o\\|x\\|a\\|xa\\|xs\\)\\'"
                   filename))
 
+(defun ocaml-eglot-util--substitute-content-with-selection
+    (deletion-range content selection-range)
+  "Replace the DELETION-RANGE with CONTENT and select the SELECTION-RANGE."
+  (let ((deactivate-mark nil))
+    (ocaml-eglot-util--replace-region deletion-range content))
+  (ocaml-eglot-util--select-range selection-range))
+
+(defun ocaml-eglot-util--perform-extraction (result)
+  "Perform a refactoring extraction based on RESULT."
+  (let ((del (cl-getf result :position))
+        (ctn (cl-getf result :content))
+        (sel (cl-getf result :selection_range)))
+    (ocaml-eglot-util--substitute-content-with-selection del ctn sel)))
+
 (provide 'ocaml-eglot-util)
 ;;; ocaml-eglot-util.el ends here

ocaml-eglot.el

@@ -694,6 +694,21 @@ and print its type."
   (interactive)
   (call-interactively #'eglot-rename))
 
+;; Refactoring features
+
+(defun ocaml-eglot-refactor-extract (&optional prefix)
+  "A documentation PREFIX."
+  (interactive "P")
+  (ocaml-eglot-req--server-capable-or-lose :experimental :ocamllsp :handleRefactorExtract)
+  (if (region-active-p)
+      (let* ((input-name (if prefix (read-string "Name: ")))
+             (extract-name (ocaml-eglot-util--nil-if-blank input-name)))
+        (let* ((current-range (ocaml-eglot-util--current-range))
+               (start (cl-getf current-range :start))
+               (end (cl-getf current-range :end))
+               (result (ocaml-eglot-req--refactor-extract start end extract-name)))
+          (ocaml-eglot-util--perform-extraction result)))))
+
 ;;; Custom command handler
 
 (defun ocaml-eglot--command-next-hole (arguments)