print function templates as uncurried when wanted

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -1354,15 +1354,19 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
           ~env ();
       ]
     else []
-  | Tfunction {env; typ; args} when prefix = "" && mode = Expression ->
+  | Tfunction {env; typ; args; uncurried} when prefix = "" && mode = Expression
+    ->
+    let shouldPrintAsUncurried = uncurried && !Config.uncurried <> Uncurried in
     let mkFnArgs ~asSnippet =
       match args with
-      | [(Nolabel, argTyp)] when TypeUtils.typeIsUnit argTyp -> "()"
+      | [(Nolabel, argTyp)] when TypeUtils.typeIsUnit argTyp ->
+        if shouldPrintAsUncurried then "(. )" else "()"
       | [(Nolabel, argTyp)] ->
         let varName =
           CompletionExpressions.prettyPrintFnTemplateArgName ~env ~full argTyp
         in
-        if asSnippet then "${1:" ^ varName ^ "}" else varName
+        let argsText = if asSnippet then "${1:" ^ varName ^ "}" else varName in
+        if shouldPrintAsUncurried then "(. " ^ argsText ^ ")" else argsText
       | _ ->
         let currentUnlabelledIndex = ref 0 in
         let argsText =
@@ -1385,7 +1389,7 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
                      else varName))
           |> String.concat ", "
         in
-        "(" ^ argsText ^ ")"
+        "(" ^ if shouldPrintAsUncurried then ". " else "" ^ argsText ^ ")"
     in
     [
       Completion.createWithSnippet

analysis/src/SharedTypes.ml

@@ -335,7 +335,12 @@ and completionType =
           (** When we have the full type expr from the compiler. *) ];
     }
   | TinlineRecord of {env: QueryEnv.t; fields: field list}
-  | Tfunction of {env: QueryEnv.t; args: typedFnArg list; typ: Types.type_expr}
+  | Tfunction of {
+      env: QueryEnv.t;
+      args: typedFnArg list;
+      typ: Types.type_expr;
+      uncurried: bool;
+    }
 
 module Env = struct
   type t = {stamps: Stamps.t; modulePath: ModulePath.t}

analysis/src/TypeUtils.ml

@@ -120,6 +120,12 @@ let rec extractType ~env ~package (t : Types.type_expr) =
   | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env)
   | Tconstr (Path.Pident {name = "string"}, [], _) -> Some (Tstring env)
   | Tconstr (Path.Pident {name = "exn"}, [], _) -> Some (Texn env)
+  | Tconstr (Pident {name = "function$"}, [t; _], _) -> (
+    (* Uncurried functions. *)
+    match extractFunctionType t ~env ~package with
+    | args, _tRet when args <> [] ->
+      Some (Tfunction {env; args; typ = t; uncurried = true})
+    | _args, _tRet -> None)
   | Tconstr (path, _, _) -> (
     match References.digConstructor ~env ~package path with
     | Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
@@ -151,7 +157,8 @@ let rec extractType ~env ~package (t : Types.type_expr) =
     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 when args <> [] ->
+      Some (Tfunction {env; args; typ = t; uncurried = false})
     | _args, _tRet -> None)
   | _ -> None
 

analysis/tests/src/Completion.res

@@ -461,4 +461,4 @@ type withUncurried = {
 }
 
 // let f: withUncurried = {fn: }
-//                            ^com
+//                            ^com

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

@@ -1944,8 +1944,8 @@ Path red
   }]
 
 Complete src/Completion.res 405:22
-posCursor:[405:22] posNoWhite:[405:21] Found expr:[405:11->464:0]
-Pexp_apply ...__ghost__[0:-1->0:-1] (...[405:11->423:17], ...[428:0->464:0])
+posCursor:[405:22] posNoWhite:[405:21] Found expr:[405:11->465:0]
+Pexp_apply ...__ghost__[0:-1->0:-1] (...[405:11->423:17], ...[428:0->465:0])
 posCursor:[405:22] posNoWhite:[405:21] Found expr:[405:11->423:17]
 Pexp_apply ...__ghost__[0:-1->0:-1] (...[405:11->405:19], ...[405:21->423:17])
 posCursor:[405:22] posNoWhite:[405:21] Found expr:[405:21->423:17]
@@ -2189,5 +2189,14 @@ Package opens Pervasives.JsxModules.place holder
 Resolved opens 3 Completion.res Completion.res pervasives
 ContextPath Type[withUncurried]
 Path withUncurried
-[]
+[{
+    "label": "(. v) => {}",
+    "kind": 12,
+    "tags": [],
+    "detail": "int => unit",
+    "documentation": null,
+    "sortText": "A",
+    "insertText": "(. ${1:v}) => {$0}",
+    "insertTextFormat": 2
+  }]