complete function snippets

analysis/src/CompletionBackEnd.ml

@@ -972,8 +972,10 @@ let printConstructorArgs argsLen ~asSnippet =
   if List.length !args > 0 then "(" ^ (!args |> String.concat ", ") ^ ")"
   else ""
 
+type completionMode = Pattern | Expression
+
 let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
-    ~completionContext =
+    ~completionContext ~mode =
   let extractedType =
     match t with
     | TypeExpr t -> t |> TypeUtils.extractType ~env ~package:full.package
@@ -1030,7 +1032,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
     let innerType = Utils.unwrapIfOption t in
     let expandedCompletions =
       TypeExpr innerType
-      |> completeTypedValue ~env ~full ~prefix ~completionContext
+      |> completeTypedValue ~env ~full ~prefix ~completionContext ~mode
       |> List.map (fun (c : Completion.t) ->
              {
                c with
@@ -1117,6 +1119,58 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
           ~env ();
       ]
     else []
+  | Some (Tfunction {env; typ; args}) when prefix = "" && mode = Expression ->
+    let prettyPrintArgTyp ?currentIndex (argTyp : Types.type_expr) =
+      let indexText =
+        match currentIndex with
+        | None -> ""
+        | Some i -> string_of_int i
+      in
+      match argTyp |> TypeUtils.pathFromTypeExpr with
+      | None -> "v" ^ indexText
+      | Some p -> (
+        (* Pretty print a few common patterns. *)
+        match Path.head p |> Ident.name with
+        | "unit" -> "()"
+        | "ReactEvent" -> "event"
+        | _ -> "v" ^ indexText)
+    in
+    let mkFnArgs ~asSnippet =
+      match args with
+      | [(Nolabel, argTyp)] when TypeUtils.typeIsUnit argTyp -> "()"
+      | [(Nolabel, argTyp)] ->
+        let varName = prettyPrintArgTyp argTyp in
+        if asSnippet then "${1:" ^ varName ^ "}" else varName
+      | _ ->
+        let currentUnlabelledIndex = ref 0 in
+        let argsText =
+          args
+          |> List.map (fun ((label, typ) : typedFnArg) ->
+                 match label with
+                 | Optional name -> "~" ^ name ^ "=?"
+                 | Labelled name -> "~" ^ name
+                 | Nolabel ->
+                   if TypeUtils.typeIsUnit typ then "()"
+                   else (
+                     currentUnlabelledIndex := !currentUnlabelledIndex + 1;
+                     let num = !currentUnlabelledIndex in
+                     let varName = prettyPrintArgTyp typ ~currentIndex:num in
+                     if asSnippet then
+                       "${" ^ string_of_int num ^ ":" ^ varName ^ "}"
+                     else varName))
+          |> String.concat ", "
+        in
+        "(" ^ argsText ^ ")"
+    in
+    [
+      Completion.createWithSnippet
+        ~name:(mkFnArgs ~asSnippet:false ^ " => {}")
+        ~insertText:
+          (mkFnArgs ~asSnippet:!Cfg.supportsSnippets
+          ^ " => "
+          ^ if !Cfg.supportsSnippets then "{$0}" else "{}")
+        ~sortText:"A" ~kind:(Value typ) ~env ();
+    ]
   | _ -> []
 
 let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
@@ -1241,7 +1295,9 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
       | None -> fallbackOrEmpty ()
       | Some (typ, env, completionContext) ->
         let items =
-          typ |> completeTypedValue ~env ~full ~prefix ~completionContext
+          typ
+          |> completeTypedValue ~mode:Pattern ~env ~full ~prefix
+               ~completionContext
         in
         fallbackOrEmpty ~items ())
     | None -> fallbackOrEmpty ())
@@ -1261,7 +1317,9 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover
       | None -> []
       | Some (typ, env, completionContext) -> (
         let items =
-          typ |> completeTypedValue ~env ~full ~prefix ~completionContext
+          typ
+          |> completeTypedValue ~mode:Expression ~env ~full ~prefix
+               ~completionContext
         in
         match (prefix, completionContext) with
         | "", _ -> items

analysis/src/SharedTypes.ml

@@ -4,6 +4,8 @@ let ident l = l |> List.map str |> String.concat "."
 
 type path = string list
 
+type typedFnArg = Asttypes.arg_label * Types.type_expr
+
 let pathToString (path : path) = path |> String.concat "."
 
 module ModulePath = struct
@@ -644,6 +646,11 @@ module Completable = struct
         typeExpr: Types.type_expr;
       }
     | TinlineRecord of {env: QueryEnv.t; fields: field list}
+    | Tfunction of {
+        env: QueryEnv.t;
+        args: typedFnArg list;
+        typ: Types.type_expr;
+      }
 
   let toString =
     let completionContextToString = function

analysis/src/TypeUtils.ml

@@ -146,6 +146,10 @@ let rec extractType ~env ~package (t : Types.type_expr) =
              })
     in
     Some (Tpolyvariant {env; constructors; typeExpr = t})
+  | Tarrow _ -> (
+    match extractFunctionType t ~env ~package with
+    | args, _tRet when args <> [] -> Some (Tfunction {env; args; typ = t})
+    | _args, _tRet -> None)
   | _ -> None
 
 let findReturnTypeOfFunctionAtLoc loc ~(env : QueryEnv.t) ~full ~debug =
@@ -188,16 +192,21 @@ let getBuiltinFromTypePath path =
     Some Result
   | _ -> None
 
+let pathFromTypeExpr (t : Types.type_expr) =
+  match t.desc with
+  | Tconstr (path, _typeArgs, _)
+  | Tlink {desc = Tconstr (path, _typeArgs, _)}
+  | Tsubst {desc = Tconstr (path, _typeArgs, _)}
+  | Tpoly ({desc = Tconstr (path, _typeArgs, _)}, []) ->
+    Some path
+  | _ -> None
+
 let rec resolveTypeForPipeCompletion ~env ~package ~lhsLoc ~full
     (t : Types.type_expr) =
   let builtin =
-    match t.desc with
-    | Tconstr (path, _typeArgs, _)
-    | Tlink {desc = Tconstr (path, _typeArgs, _)}
-    | Tsubst {desc = Tconstr (path, _typeArgs, _)}
-    | Tpoly ({desc = Tconstr (path, _typeArgs, _)}, []) ->
-      path |> getBuiltinFromTypePath
-    | _ -> None
+    match t |> pathFromTypeExpr with
+    | Some path -> path |> getBuiltinFromTypePath
+    | None -> None
   in
   match builtin with
   | Some builtin -> (env, Builtin (builtin, t))
@@ -325,3 +334,13 @@ let getArgs ~env (t : Types.type_expr) ~full =
     | _ -> []
   in
   t |> getArgsLoop ~env ~full ~currentArgumentPosition:0
+
+let typeIsUnit (typ : Types.type_expr) =
+  match typ.desc with
+  | Tconstr (Pident id, _typeArgs, _)
+  | Tlink {desc = Tconstr (Pident id, _typeArgs, _)}
+  | Tsubst {desc = Tconstr (Pident id, _typeArgs, _)}
+  | Tpoly ({desc = Tconstr (Pident id, _typeArgs, _)}, [])
+    when Ident.name id = "unit" ->
+    true
+  | _ -> false

analysis/tests/src/CompletionExpressions.res

@@ -138,3 +138,42 @@ let fnTakingInlineRecord = (r: variantWithInlineRecord) => {
 
 // let _ = fnTakingInlineRecord(WithInlineRecord({nestedRecord: {} }))
 //                                                               ^com
+
+type variant = First | Second(bool)
+
+let fnTakingCallback = (
+  cb: unit => unit,
+  cb2: bool => unit,
+  cb3: ReactEvent.Mouse.t => unit,
+  cb4: (~on: bool, ~off: bool=?, variant) => int,
+  cb5: (bool, option<bool>, bool) => unit,
+  cb6: (~on: bool=?, ~off: bool=?, unit) => int,
+) => {
+  let _ = cb
+  let _ = cb2
+  let _ = cb3
+  let _ = cb4
+  let _ = cb5
+  let _ = cb6
+}
+
+// fnTakingCallback()
+//                  ^com
+
+// fnTakingCallback(a)
+//                   ^com
+
+// fnTakingCallback(a, )
+//                    ^com
+
+// fnTakingCallback(a, b, )
+//                       ^com
+
+// fnTakingCallback(a, b, c, )
+//                           ^com
+
+// fnTakingCallback(a, b, c, d, )
+//                              ^com
+
+// fnTakingCallback(a, b, c, d, e, )
+//                                ^com

analysis/tests/src/CompletionPattern.res

@@ -194,3 +194,10 @@ let s = (true, Some(true), [false])
 
 // switch s { | (true, _, []) }
 //                      ^com
+
+type recordWithFn = {someFn: unit => unit}
+
+let ff: recordWithFn = {someFn: () => ()}
+
+// switch ff { | {someFn: }}
+//                       ^com

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

@@ -617,3 +617,99 @@ Completable: Cexpression CArgument Value[fnTakingInlineRecord]($0)->variantPaylo
     "documentation": null
   }]
 
+Complete src/CompletionExpressions.res 159:20
+posCursor:[159:20] posNoWhite:[159:19] Found expr:[159:3->159:21]
+Pexp_apply ...[159:3->159:19] (...[159:20->159:21])
+Completable: Cexpression CArgument Value[fnTakingCallback]($0)
+[{
+    "label": "() => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "unit => unit",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "() => {$0}",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionExpressions.res 162:21
+posCursor:[162:21] posNoWhite:[162:20] Found expr:[162:3->162:22]
+Pexp_apply ...[162:3->162:19] (...[162:20->162:21])
+Completable: Cexpression CArgument Value[fnTakingCallback]($0)=a
+[]
+
+Complete src/CompletionExpressions.res 165:22
+posCursor:[165:22] posNoWhite:[165:21] Found expr:[165:3->165:24]
+Pexp_apply ...[165:3->165:19] (...[165:20->165:21])
+Completable: Cexpression CArgument Value[fnTakingCallback]($1)
+[{
+    "label": "v => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "bool => unit",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "${1:v} => {$0}",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionExpressions.res 168:25
+posCursor:[168:25] posNoWhite:[168:24] Found expr:[168:3->168:27]
+Pexp_apply ...[168:3->168:19] (...[168:20->168:21], ...[168:23->168:24])
+Completable: Cexpression CArgument Value[fnTakingCallback]($2)
+[{
+    "label": "event => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "ReactEvent.Mouse.t => unit",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "${1:event} => {$0}",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionExpressions.res 171:29
+posCursor:[171:29] posNoWhite:[171:27] Found expr:[171:3->171:30]
+Pexp_apply ...[171:3->171:19] (...[171:20->171:21], ...[171:23->171:24], ...[171:26->171:27])
+Completable: Cexpression CArgument Value[fnTakingCallback]($3)
+[{
+    "label": "(~on, ~off=?, v1) => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "(~on: bool, ~off: bool=?, variant) => int",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "(~on, ~off=?, ${1:v1}) => {$0}",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionExpressions.res 174:32
+posCursor:[174:32] posNoWhite:[174:30] Found expr:[174:3->174:33]
+Pexp_apply ...[174:3->174:19] (...[174:20->174:21], ...[174:23->174:24], ...[174:26->174:27], ...[174:29->174:30])
+Completable: Cexpression CArgument Value[fnTakingCallback]($4)
+[{
+    "label": "(v1, v2, v3) => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "(bool, option<bool>, bool) => unit",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "(${1:v1}, ${2:v2}, ${3:v3}) => {$0}",
+    "insertTextFormat": 2
+  }]
+
+Complete src/CompletionExpressions.res 177:34
+posCursor:[177:34] posNoWhite:[177:33] Found expr:[177:3->177:36]
+Pexp_apply ...[177:3->177:19] (...[177:20->177:21], ...[177:23->177:24], ...[177:26->177:27], ...[177:29->177:30], ...[177:32->177:33])
+Completable: Cexpression CArgument Value[fnTakingCallback]($5)
+[{
+    "label": "(~on=?, ~off=?, ()) => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "(~on: bool=?, ~off: bool=?, unit) => int",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "(~on=?, ~off=?, ()) => {$0}",
+    "insertTextFormat": 2
+  }]
+

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

@@ -904,3 +904,9 @@ Completable: Cpattern Value[s]->tuple($1)
     "documentation": null
   }]
 
+Complete src/CompletionPattern.res 201:25
+posCursor:[201:25] posNoWhite:[201:24] Found expr:[201:3->201:28]
+posCursor:[201:25] posNoWhite:[201:24] Found pattern:[201:17->201:28]
+Completable: Cpattern Value[ff]->recordField(someFn)
+[]
+

server/src/server.ts

@@ -1119,7 +1119,7 @@ function onMessage(msg: p.Message) {
           renameProvider: { prepareProvider: true },
           documentSymbolProvider: true,
           completionProvider: {
-            triggerCharacters: [".", ">", "@", "~", '"', "="],
+            triggerCharacters: [".", ">", "@", "~", '"', "=", "("],
           },
           semanticTokensProvider: {
             legend: {