correctly insert completion item text removing the dot when selecting a pipe function

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -653,7 +653,8 @@ let rec digToRecordFieldsForCompletion ~debug ~package ~opens ~full ~pos ~env
   | {kind = Type {kind = Record fields}} :: _ -> Some fields
   | _ -> None
 
-let mkItem ?data name ~kind ~detail ~deprecated ~docstring =
+let mkItem ?data ?(range : Location.t option) name ~kind ~detail ~deprecated
+    ~docstring =
   let docContent =
     (match deprecated with
     | None -> ""
@@ -682,6 +683,23 @@ let mkItem ?data name ~kind ~detail ~deprecated ~docstring =
       insertTextFormat = None;
       filterText = None;
       data;
+      range =
+        (match range with
+        | None -> None
+        | Some range ->
+          Some
+            {
+              start =
+                {
+                  line = range.loc_start.pos_lnum - 1;
+                  character = range.loc_start.pos_cnum - range.loc_start.pos_bol;
+                };
+              end_ =
+                {
+                  line = range.loc_end.pos_lnum - 1;
+                  character = range.loc_end.pos_cnum - range.loc_end.pos_bol;
+                };
+            });
     }
 
 let completionToItem
@@ -696,9 +714,10 @@ let completionToItem
       filterText;
       detail;
       env;
+      range;
     } ~full =
   let item =
-    mkItem name
+    mkItem name ?range
       ?data:(kindToData (full.file.uri |> Uri.toPath) kind)
       ~kind:(Completion.kindToInt kind)
       ~deprecated
@@ -950,13 +969,14 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
         [Completion.create "dummy" ~env ~kind:(Completion.Value retType)]
       | _ -> [])
     | _ -> [])
-  | CPField (CPId {path; completionContext = Module}, fieldName) ->
+  | CPField {contextPath = CPId {path; completionContext = Module}; fieldName}
+    ->
     if Debug.verbose () then print_endline "[ctx_path]--> CPField: M.field";
     (* M.field *)
     path @ [fieldName]
     |> getCompletionsForPath ~debug ~opens ~full ~pos ~exact
          ~completionContext:Field ~env ~scope
-  | CPField (cp, fieldName) -> (
+  | CPField {contextPath = cp; fieldName; fieldNameLoc} -> (
     if Debug.verbose () then print_endline "[ctx_path]--> CPField";
     let completionsForCtxPath =
       cp
@@ -1054,6 +1074,7 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
                           |> List.hd);
                        insertText = Some nameWithPipe;
                        env;
+                       range = Some fieldNameLoc;
                      }
                  | _ -> None)
         | None -> []

analysis/src/CompletionFrontEnd.ml

@@ -222,21 +222,26 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
   | Pexp_ident {txt; loc} ->
     Some
       (CPId {path = Utils.flattenLongIdent txt; completionContext = Value; loc})
-  | Pexp_field (e1, {txt = Lident name}) -> (
+  | Pexp_field (e1, {txt = Lident name; loc}) -> (
     match exprToContextPath e1 with
-    | Some contextPath -> Some (CPField (contextPath, name))
+    | Some contextPath ->
+      Some (CPField {contextPath; fieldName = name; fieldNameLoc = loc})
     | _ -> None)
   | Pexp_field (_, {loc; txt = Ldot (lid, name)}) ->
     (* Case x.M.field ignore the x part *)
     Some
       (CPField
-         ( CPId
-             {
-               path = Utils.flattenLongIdent lid;
-               completionContext = Module;
-               loc;
-             },
-           name ))
+         {
+           contextPath =
+             CPId
+               {
+                 path = Utils.flattenLongIdent lid;
+                 completionContext = Module;
+                 loc;
+               };
+           fieldName = name;
+           fieldNameLoc = loc;
+         })
   | Pexp_send (e1, {txt}) -> (
     match exprToContextPath e1 with
     | None -> None
@@ -1130,29 +1135,54 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             | Lident name -> (
               match exprToContextPath e with
               | Some contextPath ->
-                let contextPath = Completable.CPField (contextPath, name) in
+                let contextPath =
+                  Completable.CPField
+                    {
+                      contextPath;
+                      fieldName = name;
+                      fieldNameLoc = fieldName.loc;
+                    }
+                in
                 setResult (Cpath contextPath)
               | None -> ())
             | Ldot (id, name) ->
               (* Case x.M.field ignore the x part *)
               let contextPath =
                 Completable.CPField
-                  ( CPId
-                      {
-                        loc = fieldName.loc;
-                        path = Utils.flattenLongIdent id;
-                        completionContext = Module;
-                      },
-                    if blankAfterCursor = Some '.' then
-                      (* x.M. field  --->  M. *) ""
-                    else if name = "_" then ""
-                    else name )
+                  {
+                    contextPath =
+                      CPId
+                        {
+                          loc = fieldName.loc;
+                          path = Utils.flattenLongIdent id;
+                          completionContext = Module;
+                        };
+                    fieldName =
+                      (if blankAfterCursor = Some '.' then
+                         (* x.M. field  --->  M. *) ""
+                       else if name = "_" then ""
+                       else name);
+                    fieldNameLoc = fieldName.loc;
+                  }
               in
               setResult (Cpath contextPath)
             | Lapply _ -> ()
           else if Loc.end_ e.pexp_loc = posBeforeCursor then
             match exprToContextPath e with
-            | Some contextPath -> setResult (Cpath (CPField (contextPath, "")))
+            | Some contextPath ->
+              setResult
+                (Cpath
+                   (CPField
+                      {
+                        contextPath;
+                        fieldName = "";
+                        fieldNameLoc =
+                          {
+                            loc_start = e.pexp_loc.loc_end;
+                            loc_end = e.pexp_loc.loc_end;
+                            loc_ghost = false;
+                          };
+                      }))
             | None -> ())
         | Pexp_apply ({pexp_desc = Pexp_ident compName}, args)
           when Res_parsetree_viewer.is_jsx_expression expr ->

analysis/src/Protocol.ml

@@ -51,6 +51,7 @@ type completionItem = {
   insertText: string option;
   documentation: markupContent option;
   data: (string * string) list option;
+  range: range option;
 }
 
 type location = {uri: string; range: range}
@@ -142,7 +143,10 @@ let stringifyCompletionItem c =
           | Some doc -> stringifyMarkupContent doc) );
       ("sortText", optWrapInQuotes c.sortText);
       ("filterText", optWrapInQuotes c.filterText);
-      ("insertText", optWrapInQuotes c.insertText);
+      ( "insertText",
+        match c.range with
+        | Some _ -> None
+        | None -> optWrapInQuotes c.insertText );
       ( "insertTextFormat",
         match c.insertTextFormat with
         | None -> None
@@ -156,6 +160,20 @@ let stringifyCompletionItem c =
             (fields
             |> List.map (fun (key, value) -> (key, Some (wrapInQuotes value)))
             |> stringifyObject ~indentation:2) );
+      ( "textEdit",
+        match c.range with
+        | Some range ->
+          Some
+            (stringifyObject
+               [
+                 ("range", Some (stringifyRange range));
+                 ( "newText",
+                   optWrapInQuotes
+                     (match c.insertText with
+                     | None -> Some c.label
+                     | v -> v) );
+               ])
+        | None -> None );
     ]
 
 let stringifyHover value =
@@ -282,7 +300,7 @@ let stringifyCodeAction ca =
     (wrapInQuotes (codeActionKindToString ca.codeActionKind))
     (ca.edit |> stringifyCodeActionEdit)
 
-let stringifyHint hint =
+let stringifyHint (hint : inlayHint) =
   Printf.sprintf
     {|{
     "position": %s,

analysis/src/SharedTypes.ml

@@ -612,7 +612,11 @@ module Completable = struct
         completionContext: completionContext;
         loc: Location.t;
       }
-    | CPField of contextPath * string
+    | CPField of {
+        contextPath: contextPath;
+        fieldName: string;
+        fieldNameLoc: Location.t;
+      }
     | CPObj of contextPath * string
     | CPAwait of contextPath
     | CPPipe of {
@@ -696,7 +700,8 @@ module Completable = struct
     | CPArray None -> "array"
     | CPId {path; completionContext} ->
       completionContextToString completionContext ^ list path
-    | CPField (cp, s) -> contextPathToString cp ^ "." ^ str s
+    | CPField {contextPath = cp; fieldName = s} ->
+      contextPathToString cp ^ "." ^ str s
     | CPObj (cp, s) -> contextPathToString cp ^ "[\"" ^ s ^ "\"]"
     | CPPipe {contextPath; id; inJsx} ->
       contextPathToString contextPath
@@ -808,10 +813,12 @@ module Completion = struct
     detail: string option;
     typeArgContext: typeArgContext option;
     data: (string * string) list option;
+    range: Location.t option;
   }
 
-  let create ?data ?typeArgContext ?(includesSnippets = false) ?insertText ~kind
-      ~env ?sortText ?deprecated ?filterText ?detail ?(docstring = []) name =
+  let create ?range ?data ?typeArgContext ?(includesSnippets = false)
+      ?insertText ~kind ~env ?sortText ?deprecated ?filterText ?detail
+      ?(docstring = []) name =
     {
       name;
       env;
@@ -826,6 +833,7 @@ module Completion = struct
       detail;
       typeArgContext;
       data;
+      range;
     }
 
   (* https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_completion *)

analysis/tests/src/expected/CompletionFromModule.res.txt

@@ -19,7 +19,10 @@ Path SomeModule.
     "detail": "t => string",
     "documentation": null,
     "sortText": "getName",
-    "insertText": "->SomeModule.getName"
+    "textEdit": {
+    "range": {"start": {"line": 11, "character": 4}, "end": {"line": 11, "character": 4}},
+    "newText": "->SomeModule.getName"
+  }
   }, {
     "label": "name",
     "kind": 5,