Completion snippet support

CHANGELOG.md

@@ -18,6 +18,7 @@
 
 - Add autocomplete for function argument values (booleans, variants and options. More values coming), both labelled and unlabelled. https://github.com/rescript-lang/rescript-vscode/pull/665
 - Add autocomplete for JSX prop values. https://github.com/rescript-lang/rescript-vscode/pull/667
+- Add snippet support in completion items. https://github.com/rescript-lang/rescript-vscode/pull/668
 
 #### :nail_care: Polish
 

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)
@@ -1501,7 +1518,7 @@ let rec extractType ~env ~package (t : Types.type_expr) =
         (Tvariant
            {env; constructors; variantName = name.txt; variantDecl = decl})
     | _ -> None)
-  | Ttuple expressions -> Some (Tuple (env, expressions))
+  | Ttuple expressions -> Some (Tuple (env, expressions, t))
   | _ -> None
 
 let filterItems items ~prefix =
@@ -1511,6 +1528,15 @@ let filterItems items ~prefix =
     |> List.filter (fun (item : Completion.t) ->
            Utils.startsWith item.name prefix)
 
+let printConstructorArgs argsLen ~asSnippet =
+  let args = ref [] in
+  for argNum = 1 to argsLen do
+    args :=
+      !args @ [(if asSnippet then Printf.sprintf "${%i:_}" argNum else "_")]
+  done;
+  if List.length !args > 0 then "(" ^ (!args |> String.concat ", ") ^ ")"
+  else ""
+
 let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
     ~expandOption =
   let namesUsed = Hashtbl.create 10 in
@@ -1532,33 +1558,41 @@ let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
       | Some (Tvariant {env; constructors; variantDecl; variantName}) ->
         constructors
         |> List.map (fun (constructor : Constructor.t) ->
-               Completion.create
+               Completion.createWithSnippet
                  ~name:
                    (constructor.cname.txt
-                   ^
-                   if constructor.args |> List.length > 0 then
-                     "("
-                     ^ (constructor.args
-                       |> List.map (fun _ -> "_")
-                       |> String.concat ", ")
-                     ^ ")"
-                   else "")
+                   ^ printConstructorArgs
+                       (List.length constructor.args)
+                       ~asSnippet:false)
+                 ~insertText:
+                   (constructor.cname.txt
+                   ^ printConstructorArgs
+                       (List.length constructor.args)
+                       ~asSnippet:true)
                  ~kind:
                    (Constructor
                       ( constructor,
                         variantDecl |> Shared.declToString variantName ))
-                 ~env)
+                 ~env ())
         |> filterItems ~prefix
       | Some (Toption (env, t)) ->
         [
           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
+      | Some (Tuple (env, exprs, typ)) ->
+        let numExprs = List.length exprs in
+        [
+          Completion.createWithSnippet
+            ~name:(printConstructorArgs numExprs ~asSnippet:false)
+            ~insertText:(printConstructorArgs numExprs ~asSnippet:true)
+            ~kind:(Value typ) ~env ();
+        ]
       | _ -> []
     in
     (* Include all values and modules in completion if there's a prefix, not otherwise *)

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 *)
@@ -545,7 +569,7 @@ module Completable = struct
 
   (** An extracted type from a type expr *)
   type extractedType =
-    | Tuple of QueryEnv.t * Types.type_expr list
+    | Tuple of QueryEnv.t * Types.type_expr list * Types.type_expr
     | Toption of QueryEnv.t * Types.type_expr
     | Tbool of QueryEnv.t
     | Tvariant of {

analysis/tests/src/CompletionFunctionArguments.res

@@ -69,3 +69,10 @@ let someFnTakingVariant = (
 
 // let _ = 1->someOtherFn(1, t)
 //                            ^com
+
+let fnTakingTuple = (arg: (int, int, float)) => {
+  ignore(arg)
+}
+
+// let _ = fnTakingTuple()
+//                       ^com

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

@@ -84,6 +84,12 @@ Completable: Cargument Value[someOtherFn]($0=f)
     "tags": [],
     "detail": "bool",
     "documentation": null
+  }, {
+    "label": "fnTakingTuple",
+    "kind": 12,
+    "tags": [],
+    "detail": "((int, int, float)) => unit",
+    "documentation": null
   }]
 
 Complete src/CompletionFunctionArguments.res 51:39
@@ -95,19 +101,25 @@ Completable: Cargument Value[someFnTakingVariant](~config)
     "kind": 4,
     "tags": [],
     "detail": "One\n\ntype someVariant = One | Two | Three(int, string)",
-    "documentation": null
+    "documentation": null,
+    "insertText": "One",
+    "insertTextFormat": 2
   }, {
     "label": "Two",
     "kind": 4,
     "tags": [],
     "detail": "Two\n\ntype someVariant = One | Two | Three(int, string)",
-    "documentation": null
+    "documentation": null,
+    "insertText": "Two",
+    "insertTextFormat": 2
   }, {
     "label": "Three(_, _)",
     "kind": 4,
     "tags": [],
     "detail": "Three(int, string)\n\ntype someVariant = One | Two | Three(int, string)",
-    "documentation": null
+    "documentation": null,
+    "insertText": "Three(${1:_}, ${2:_})",
+    "insertTextFormat": 2
   }]
 
 Complete src/CompletionFunctionArguments.res 54:40
@@ -119,7 +131,9 @@ Completable: Cargument Value[someFnTakingVariant](~config=O)
     "kind": 4,
     "tags": [],
     "detail": "One\n\ntype someVariant = One | Two | Three(int, string)",
-    "documentation": null
+    "documentation": null,
+    "insertText": "One",
+    "insertTextFormat": 2
   }, {
     "label": "OIncludeMeInCompletions",
     "kind": 9,
@@ -137,7 +151,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
@@ -149,7 +165,9 @@ Completable: Cargument Value[someFnTakingVariant](~configOpt2=O)
     "kind": 4,
     "tags": [],
     "detail": "One\n\ntype someVariant = One | Two | Three(int, string)",
-    "documentation": null
+    "documentation": null,
+    "insertText": "One",
+    "insertTextFormat": 2
   }, {
     "label": "OIncludeMeInCompletions",
     "kind": 9,
@@ -211,3 +229,17 @@ Completable: Cargument Value[someOtherFn]($2=t)
     "documentation": null
   }]
 
+Complete src/CompletionFunctionArguments.res 76:25
+posCursor:[76:25] posNoWhite:[76:24] Found expr:[76:11->76:26]
+Pexp_apply ...[76:11->76:24] (...[76:25->76:26])
+Completable: Cargument Value[fnTakingTuple]($0)
+[{
+    "label": "(_, _, _)",
+    "kind": 12,
+    "tags": [],
+    "detail": "(int, int, float)",
+    "documentation": null,
+    "insertText": "(${1:_}, ${2:_}, ${3:_})",
+    "insertTextFormat": 2
+  }]
+