basic snippet support in completions

Author: zth

analysis/src/Cfg.ml

@@ -0,0 +1 @@
+let supportsSnippets = ref false

analysis/src/Cli.ml

@@ -3,7 +3,7 @@ let help =
 **Private CLI For rescript-vscode usage only**
 
 API examples:
-  ./rescript-editor-analysis.exe completion src/MyFile.res 0 4 currentContent.res
+  ./rescript-editor-analysis.exe completion src/MyFile.res 0 4 currentContent.res true
   ./rescript-editor-analysis.exe definition src/MyFile.res 9 3
   ./rescript-editor-analysis.exe typeDefinition src/MyFile.res 9 3
   ./rescript-editor-analysis.exe documentSymbol src/Foo.res
@@ -86,7 +86,11 @@ Options:
 
 let main () =
   match Array.to_list Sys.argv with
-  | [_; "completion"; path; line; col; currentFile] ->
+  | [_; "completion"; path; line; col; currentFile; supportsSnippets] ->
+    (Cfg.supportsSnippets :=
+       match supportsSnippets with
+       | "true" -> true
+       | _ -> false);
     Commands.completion ~debug:false ~path
       ~pos:(int_of_string line, int_of_string col)
       ~currentFile
@@ -143,7 +147,9 @@ let main () =
       (Json.escape (CreateInterface.command ~path ~cmiFile))
   | [_; "format"; path] ->
     Printf.printf "\"%s\"" (Json.escape (Commands.format ~path))
-  | [_; "test"; path] -> Commands.test ~path
+  | [_; "test"; path] ->
+    Cfg.supportsSnippets := true;
+    Commands.test ~path
   | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help
   | _ ->
     prerr_endline help;

analysis/src/CompletionBackEnd.ml

@@ -1144,12 +1144,29 @@ let mkItem ~name ~kind ~detail ~deprecated ~docstring =
       documentation =
         (if docContent = "" then None
         else Some {kind = "markdown"; value = docContent});
+      sortText = None;
+      insertText = None;
+      insertTextFormat = None;
     }
 
-let completionToItem {Completion.name; deprecated; docstring; kind} =
-  mkItem ~name
-    ~kind:(Completion.kindToInt kind)
-    ~deprecated ~detail:(detail name kind) ~docstring
+let completionToItem
+    {
+      Completion.name;
+      deprecated;
+      docstring;
+      kind;
+      sortText;
+      insertText;
+      insertTextFormat;
+    } =
+  let item =
+    mkItem ~name
+      ~kind:(Completion.kindToInt kind)
+      ~deprecated ~detail:(detail name kind) ~docstring
+  in
+  if !Cfg.supportsSnippets then
+    {item with sortText; insertText; insertTextFormat}
+  else item
 
 let completionsGetTypeEnv = function
   | {Completion.kind = Value typ; env} :: _ -> Some (typ, env)
@@ -1554,9 +1571,9 @@ let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
           Completion.create ~name:"None"
             ~kind:(Label (t |> Shared.typeToString))
             ~env;
-          Completion.create ~name:"Some(_)"
+          Completion.createWithSnippet ~name:"Some(_)"
             ~kind:(Label (t |> Shared.typeToString))
-            ~env;
+            ~env ~insertText:"Some(${1:_})" ();
         ]
         |> filterItems ~prefix
       | _ -> []

analysis/src/Protocol.ml

@@ -33,11 +33,22 @@ type signatureHelp = {
   activeParameter: int option;
 }
 
+(* https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#insertTextFormat *)
+type insertTextFormat = PlainText | Snippet
+
+let insertTextFormatToInt f =
+  match f with
+  | PlainText -> 1
+  | Snippet -> 2
+
 type completionItem = {
   label: string;
   kind: int;
   tags: int list;
   detail: string;
+  sortText: string option;
+  insertTextFormat: insertTextFormat option;
+  insertText: string option;
   documentation: markupContent option;
 }
 
@@ -86,21 +97,45 @@ let stringifyRange r =
 let stringifyMarkupContent (m : markupContent) =
   Printf.sprintf {|{"kind": "%s", "value": "%s"}|} m.kind (Json.escape m.value)
 
+(** None values are not emitted in the output. *)
+let stringifyObject properties =
+  {|{
+|}
+  ^ (properties
+    |> List.filter_map (fun (key, value) ->
+           match value with
+           | None -> None
+           | Some v -> Some (Printf.sprintf {|    "%s": %s|} key v))
+    |> String.concat ",\n")
+  ^ "\n  }"
+
+let wrapInQuotes s = "\"" ^ s ^ "\""
+
+let optWrapInQuotes s =
+  match s with
+  | None -> None
+  | Some s -> Some (wrapInQuotes s)
+
 let stringifyCompletionItem c =
-  Printf.sprintf
-    {|{
-    "label": "%s",
-    "kind": %i,
-    "tags": %s,
-    "detail": "%s",
-    "documentation": %s
-  }|}
-    (Json.escape c.label) c.kind
-    (c.tags |> List.map string_of_int |> array)
-    (Json.escape c.detail)
-    (match c.documentation with
-    | None -> null
-    | Some doc -> stringifyMarkupContent doc)
+  stringifyObject
+    [
+      ("label", Some (wrapInQuotes (Json.escape c.label)));
+      ("kind", Some (string_of_int c.kind));
+      ("tags", Some (c.tags |> List.map string_of_int |> array));
+      ("detail", Some (wrapInQuotes (Json.escape c.detail)));
+      ( "documentation",
+        Some
+          (match c.documentation with
+          | None -> null
+          | Some doc -> stringifyMarkupContent doc) );
+      ("sortText", optWrapInQuotes c.sortText);
+      ("insertText", optWrapInQuotes c.insertText);
+      ( "insertTextFormat",
+        match c.insertTextFormat with
+        | None -> None
+        | Some insertTextFormat ->
+          Some (Printf.sprintf "%i" (insertTextFormatToInt insertTextFormat)) );
+    ]
 
 let stringifyHover value =
   Printf.sprintf {|{"contents": %s}|}

analysis/src/SharedTypes.ml

@@ -292,14 +292,38 @@ module Completion = struct
 
   type t = {
     name: string;
+    sortText: string option;
+    insertText: string option;
+    insertTextFormat: Protocol.insertTextFormat option;
     env: QueryEnv.t;
     deprecated: string option;
     docstring: string list;
     kind: kind;
   }
 
   let create ~name ~kind ~env =
-    {name; env; deprecated = None; docstring = []; kind}
+    {
+      name;
+      env;
+      deprecated = None;
+      docstring = [];
+      kind;
+      sortText = None;
+      insertText = None;
+      insertTextFormat = None;
+    }
+
+  let createWithSnippet ~name ?insertText ~kind ~env ?sortText () =
+    {
+      name;
+      env;
+      deprecated = None;
+      docstring = [];
+      kind;
+      sortText;
+      insertText;
+      insertTextFormat = Some Protocol.Snippet;
+    }
 
   (* https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_completion *)
   (* https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#completionItemKind *)

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

@@ -137,7 +137,9 @@ Completable: Cargument Value[someFnTakingVariant]($0=S)
     "kind": 4,
     "tags": [],
     "detail": "someVariant",
-    "documentation": null
+    "documentation": null,
+    "insertText": "Some(${1:_})",
+    "insertTextFormat": 2
   }]
 
 Complete src/CompletionFunctionArguments.res 60:44

server/src/server.ts

@@ -680,6 +680,7 @@ function completion(msg: p.RequestMessage) {
       params.position.line,
       params.position.character,
       tmpname,
+      "true",
     ],
     msg
   );
@@ -946,7 +947,7 @@ function createInterface(msg: p.RequestMessage): p.Message {
       jsonrpc: c.jsonrpcVersion,
       id: msg.id,
       result: {
-        uri: utils.pathToURI(resiPath)
+        uri: utils.pathToURI(resiPath),
       },
     };
     return response;
@@ -1013,7 +1014,7 @@ function openCompiledFile(msg: p.RequestMessage): p.Message {
     id: msg.id,
     result: {
       uri: utils.pathToURI(compiledFilePath.result),
-    }
+    },
   };
 
   return response;
@@ -1111,7 +1112,9 @@ function onMessage(msg: p.Message) {
           codeActionProvider: true,
           renameProvider: { prepareProvider: true },
           documentSymbolProvider: true,
-          completionProvider: { triggerCharacters: [".", ">", "@", "~", '"', "="] },
+          completionProvider: {
+            triggerCharacters: [".", ">", "@", "~", '"', "="],
+          },
           semanticTokensProvider: {
             legend: {
               tokenTypes: [