Merge pull request #10 from tarides/construct-error-relaxation

Construct error relaxation

ocaml-eglot-req.el

@@ -65,11 +65,19 @@ CANCEL-ON-INPUT-RETVAL are hooks for cancellation."
    (eglot--TextDocumentPositionParams)
    (ocaml-eglot-req--TextDocumentIdentifier)))
 
-(defun ocaml-eglot-req--ConstructParams (depth with-local-values)
+(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)
+          (ocaml-eglot-req--TextDocumentIdentifier)))
+
+(defun ocaml-eglot-req--ConstructParams (position depth with-local-values)
   "Compute `ConstructParams' object for current buffer.
+POSITION the position of the hole.
 DEPTH is the depth of the search (default is 1).
 WITH-LOCAL-VALUES is a flag for including local values in construction."
-  (append (ocaml-eglot-req--TextDocumentPositionParams)
+  (append (ocaml-eglot-req--TextDocumentPositionParamsWithPos position)
           `(:depth, depth)
           `(:withValues, with-local-values)))
 
@@ -99,10 +107,11 @@ A potential IDENTIFIER can be given and MARKUP-KIND can be parametrized."
   (let ((params (ocaml-eglot-req--TextDocumentPositionParams)))
     (ocaml-eglot-req--send :ocamllsp/jump params)))
 
-(defun ocaml-eglot-req--construct (depth with-local-value)
-  "Execute the `ocamllsp/construct' request.
+(defun ocaml-eglot-req--construct (position depth with-local-value)
+  "Execute the `ocamllsp/construct' request for a given POSITION.
 DEPTH and WITH-LOCAL-VALUE can be parametrized."
-  (let ((params (ocaml-eglot-req--ConstructParams depth with-local-value)))
+  (let ((params (ocaml-eglot-req--ConstructParams
+                 position depth with-local-value)))
     (ocaml-eglot-req--send :ocamllsp/construct params)))
 
 (defun ocaml-eglot-req--search (query limit with-doc markup-kind)

ocaml-eglot-util.el

@@ -93,6 +93,16 @@
   "Format MARKUP according to LSP's spec."
   (eglot--format-markup markup))
 
+(defun ocaml-eglot-util--current-range ()
+  "Return the current active range."
+  (if (region-active-p)
+      (let ((region-start (region-beginning))
+            (region-stop  (region-end)))
+        (list :start (eglot--pos-to-lsp-position region-start)
+              :end (eglot--pos-to-lsp-position region-stop)))
+    (let ((start (eglot--pos-to-lsp-position)))
+      (list :start start
+            :end (ocaml-eglot-util--position-increase-char start "_")))))
 
 (provide 'ocaml-eglot-util)
 ;;; ocaml-eglot-util.el ends here

ocaml-eglot.el

@@ -180,16 +180,22 @@ If there is no available holes, it returns the first one of HOLES."
   (let ((hole (ocaml-eglot--first-hole-aux holes pos comparison)))
     (if hole hole (car holes))))
 
-(defun ocaml-eglot--first-hole-in (start end)
-  "Jump to the first hole in a given range denoted by START and END."
+(defun ocaml-eglot--get-first-hole-in (start end)
+  "Return the first hole in a given range denoted by START and END."
   (let* ((holes (ocaml-eglot-req--holes))
-         (hole (ocaml-eglot--first-hole-at holes start '>)))
+         (hole (ocaml-eglot--first-hole-at holes start '>=)))
     (when hole
       (let ((hole-start (cl-getf hole :start))
             (hole-end (cl-getf hole :end)))
         (when (and (>= (ocaml-eglot-util--compare-position hole-start start) 0)
                    (<= (ocaml-eglot-util--compare-position hole-end end) 0))
-          (ocaml-eglot-util--jump-to hole-start))))))
+          hole)))))
+
+(defun ocaml-eglot--first-hole-in (start end)
+  "Jump to the first hole in a given range denoted by START and END."
+  (when-let ((hole (ocaml-eglot--get-first-hole-in start end))
+             (hole-start (cl-getf hole :start)))
+    (ocaml-eglot-util--jump-to hole-start)))
 
 (defun ocaml-eglot-hole-prev ()
   "Jump to the previous hole."
@@ -310,24 +316,31 @@ of result (LIMIT)."
 It use the ARG to use local values or not."
   (interactive "P")
   (eglot--server-capable-or-lose :experimental :ocamllsp :handleConstruct)
-  (let* ((with-local-value (ocaml-eglot--construct-local-values arg))
-         (result (ocaml-eglot-req--construct 1 with-local-value))
-         (range (cl-getf result :position))
-         (suggestions (append (cl-getf result :result) nil)))
-    (when (= (length suggestions) 0)
-      (eglot--error "No constructors for this hole"))
-    (cl-labels
-        ((insert-construct-choice (subst)
-           (let* ((start (cl-getf range :start))
-                  (end (ocaml-eglot-util--position-increase-char
-                        start subst)))
-             (ocaml-eglot-util--replace-region range subst)
-             (ocaml-eglot--first-hole-in start end))))
-      (if (= (length suggestions) 1)
-          (insert-construct-choice (car suggestions))
-        (let ((choice (completing-read "Constructor: " suggestions nil t)))
-          (insert-construct-choice choice))))))
-
+  (let* ((_with-local-values (ocaml-eglot--construct-local-values arg))
+         (current-range (ocaml-eglot-util--current-range))
+         (start (cl-getf current-range :start))
+         (end (cl-getf current-range :end))
+         (hole (ocaml-eglot--get-first-hole-in start end)))
+    (if (not hole)
+        (eglot--error "Not a hole")
+      (let* ((with-local-value (ocaml-eglot--construct-local-values arg))
+             (hole-start (cl-getf hole :start))
+             (result (ocaml-eglot-req--construct hole-start 1 with-local-value))
+             (range (cl-getf result :position))
+             (suggestions (append (cl-getf result :result) nil)))
+        (when (= (length suggestions) 0)
+          (eglot--error "No constructors for this hole"))
+        (cl-labels
+            ((insert-construct-choice (subst)
+               (let* ((start (cl-getf range :start))
+                      (end (ocaml-eglot-util--position-increase-char
+                            start subst)))
+                 (ocaml-eglot-util--replace-region range subst)
+                 (ocaml-eglot--first-hole-in start end))))
+          (if (= (length suggestions) 1)
+              (insert-construct-choice (car suggestions))
+            (let ((choice (completing-read "Constructor: " suggestions nil t)))
+              (insert-construct-choice choice))))))))
 
 ;; Get Documentation