Complete function argument values

CHANGELOG.md

@@ -14,6 +14,10 @@
 
 ## v1.10.0
 
+#### :rocket: New Feature
+
+- 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
+
 #### :nail_care: Polish
 
 - Remove spacing between type definition in clients that do not support markdown links. https://github.com/rescript-lang/rescript-vscode/pull/619

analysis/src/CompletionBackEnd.ml

@@ -1455,6 +1455,123 @@ let getOpens ~debug ~rawOpens ~package ~env =
   (* Last open takes priority *)
   List.rev resolvedOpens
 
+let getArgs ~env (t : Types.type_expr) ~full =
+  let rec getArgsLoop ~env (t : Types.type_expr) ~full ~currentArgumentPosition
+      =
+    match t.desc with
+    | Tlink t1 | Tsubst t1 | Tpoly (t1, []) ->
+      getArgsLoop ~full ~env ~currentArgumentPosition t1
+    | Tarrow (Labelled l, tArg, tRet, _) ->
+      (SharedTypes.Completable.Labelled l, tArg)
+      :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
+    | Tarrow (Optional l, tArg, tRet, _) ->
+      (Optional l, tArg) :: getArgsLoop ~full ~env ~currentArgumentPosition tRet
+    | Tarrow (Nolabel, tArg, tRet, _) ->
+      (Unlabelled {argumentPosition = currentArgumentPosition}, tArg)
+      :: getArgsLoop ~full ~env
+           ~currentArgumentPosition:(currentArgumentPosition + 1)
+           tRet
+    | Tconstr (path, typeArgs, _) -> (
+      match References.digConstructor ~env ~package:full.package path with
+      | Some
+          ( env,
+            {
+              item = {decl = {type_manifest = Some t1; type_params = typeParams}};
+            } ) ->
+        let t1 = t1 |> instantiateType ~typeParams ~typeArgs in
+        getArgsLoop ~full ~env ~currentArgumentPosition t1
+      | _ -> [])
+    | _ -> []
+  in
+  t |> getArgsLoop ~env ~full ~currentArgumentPosition:0
+
+(** Pulls out a type we can complete from a type expr. *)
+let rec extractType ~env ~package (t : Types.type_expr) =
+  match t.desc with
+  | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractType ~env ~package t1
+  | Tconstr (Path.Pident {name = "option"}, [payloadTypeExpr], _) ->
+    Some (Completable.Toption (env, payloadTypeExpr))
+  | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env)
+  | Tconstr (path, _, _) -> (
+    match References.digConstructor ~env ~package path with
+    | Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
+      extractType ~env ~package t1
+    | Some (env, {name; item = {decl; kind = Type.Variant constructors}}) ->
+      Some
+        (Tvariant
+           {env; constructors; variantName = name.txt; variantDecl = decl})
+    | _ -> None)
+  | Ttuple expressions -> Some (Tuple (env, expressions))
+  | _ -> None
+
+let filterItems items ~prefix =
+  if prefix = "" then items
+  else
+    items
+    |> List.filter (fun (item : Completion.t) ->
+           Utils.startsWith item.name prefix)
+
+let completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+    ~expandOption =
+  let namesUsed = Hashtbl.create 10 in
+  let rec completeTypedValueInner t ~env ~full ~prefix ~expandOption =
+    let items =
+      match t |> extractType ~env ~package:full.package with
+      | Some (Toption (env, typ)) when expandOption ->
+        typ |> completeTypedValueInner ~env ~full ~prefix ~expandOption:false
+      | Some (Tbool env) ->
+        [
+          Completion.create ~name:"true"
+            ~kind:(Label (t |> Shared.typeToString))
+            ~env;
+          Completion.create ~name:"false"
+            ~kind:(Label (t |> Shared.typeToString))
+            ~env;
+        ]
+        |> filterItems ~prefix
+      | Some (Tvariant {env; constructors; variantDecl; variantName}) ->
+        constructors
+        |> List.map (fun (constructor : Constructor.t) ->
+               Completion.create
+                 ~name:
+                   (constructor.cname.txt
+                   ^
+                   if constructor.args |> List.length > 0 then
+                     "("
+                     ^ (constructor.args
+                       |> List.map (fun _ -> "_")
+                       |> String.concat ", ")
+                     ^ ")"
+                   else "")
+                 ~kind:
+                   (Constructor
+                      ( constructor,
+                        variantDecl |> Shared.declToString variantName ))
+                 ~env)
+        |> filterItems ~prefix
+      | Some (Toption (env, t)) ->
+        [
+          Completion.create ~name:"None"
+            ~kind:(Label (t |> Shared.typeToString))
+            ~env;
+          Completion.create ~name:"Some(_)"
+            ~kind:(Label (t |> Shared.typeToString))
+            ~env;
+        ]
+        |> filterItems ~prefix
+      | _ -> []
+    in
+    (* Include all values and modules in completion if there's a prefix, not otherwise *)
+    if prefix = "" then items
+    else
+      items
+      @ completionForExportedValues ~env:envWhereCompletionStarted ~prefix
+          ~exact:false ~namesUsed
+      @ completionForExportedModules ~env:envWhereCompletionStarted ~prefix
+          ~exact:false ~namesUsed
+  in
+  completeTypedValueInner ~env ~full ~prefix ~expandOption
+
 let processCompletable ~debug ~full ~scope ~env ~pos ~forHover
     (completable : Completable.t) =
   let package = full.package in
@@ -1817,6 +1934,38 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
            in
            (dec2, doc))
     |> List.map mkDecorator
+  | Cargument {functionContextPath; argumentLabel; prefix} -> (
+    let envWhereCompletionStarted = env in
+    let labels =
+      match
+        functionContextPath
+        |> getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos
+             ~env ~exact:true ~scope
+        |> completionsGetTypeEnv
+      with
+      | Some (typ, _env) -> typ |> getArgs ~full ~env
+      | None -> []
+    in
+    let targetLabel =
+      labels
+      |> List.find_opt (fun (label, _) ->
+             match argumentLabel with
+             | Unlabelled _ -> label = argumentLabel
+             | Labelled name | Optional name -> (
+               match label with
+               | (Labelled n | Optional n) when name = n -> true
+               | _ -> false))
+    in
+    match targetLabel with
+    | None -> []
+    | Some (Optional _, typ) ->
+      typ
+      |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+           ~expandOption:true
+    | Some ((Unlabelled _ | Labelled _), typ) ->
+      typ
+      |> completeTypedValue ~env ~envWhereCompletionStarted ~full ~prefix
+           ~expandOption:false)
   | CnamedArg (cp, prefix, identsSeen) ->
     let labels =
       match
@@ -1829,29 +1978,13 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
         if debug then
           Printf.printf "Found type for function %s\n"
             (typ |> Shared.typeToString);
-        let rec getLabels ~env (t : Types.type_expr) =
-          match t.desc with
-          | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels ~env t1
-          | Tarrow ((Labelled l | Optional l), tArg, tRet, _) ->
-            (l, tArg) :: getLabels ~env tRet
-          | Tarrow (Nolabel, _, tRet, _) -> getLabels ~env tRet
-          | Tconstr (path, typeArgs, _) -> (
-            match References.digConstructor ~env ~package path with
-            | Some
-                ( env,
-                  {
-                    item =
-                      {
-                        decl =
-                          {type_manifest = Some t1; type_params = typeParams};
-                      };
-                  } ) ->
-              let t1 = t1 |> instantiateType ~typeParams ~typeArgs in
-              getLabels ~env t1
-            | _ -> [])
-          | _ -> []
-        in
-        typ |> getLabels ~env
+
+        typ |> getArgs ~full ~env
+        |> List.filter_map (fun arg ->
+               match arg with
+               | SharedTypes.Completable.Labelled name, a -> Some (name, a)
+               | Optional name, a -> Some (name, a)
+               | _ -> None)
       | None -> []
     in
     let mkLabel (name, typ) =

analysis/src/CompletionFrontEnd.ml

@@ -106,8 +106,24 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args =
   in
   args |> processProps ~acc:[]
 
-let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor
-    ~(contextPath : Completable.contextPath) ~posAfterFunExpr =
+let extractCompletableArgValueInfo exp =
+  match exp.Parsetree.pexp_desc with
+  | Pexp_ident {txt = Lident txt} -> Some txt
+  | Pexp_construct ({txt = Lident "()"}, _) -> Some ""
+  | Pexp_construct ({txt = Lident txt}, _) -> Some txt
+  | _ -> None
+
+let isExprHole exp =
+  match exp.Parsetree.pexp_desc with
+  | Pexp_extension ({txt = "rescript.exprhole"}, _) -> true
+  | _ -> false
+
+let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor
+    ~(contextPath : Completable.contextPath) ~posAfterFunExpr ~charBeforeCursor
+    ~isPipedExpr =
+  let fnHasCursor =
+    posAfterFunExpr <= posBeforeCursor && posBeforeCursor < endPos
+  in
   let allNames =
     List.fold_right
       (fun arg allLabels ->
@@ -116,24 +132,90 @@ let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor
         | {label = None} -> allLabels)
       args []
   in
+  let unlabelledCount = ref (if isPipedExpr then 1 else 0) in
   let rec loop args =
     match args with
     | {label = Some labelled; exp} :: rest ->
       if
         labelled.posStart <= posBeforeCursor
         && posBeforeCursor < labelled.posEnd
       then Some (Completable.CnamedArg (contextPath, labelled.name, allNames))
-      else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None
+      else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then
+        (* Completing in the assignment of labelled argument *)
+        match extractCompletableArgValueInfo exp with
+        | None -> None
+        | Some prefix ->
+          Some
+            (Cargument
+               {
+                 functionContextPath = contextPath;
+                 argumentLabel = Labelled labelled.name;
+                 prefix;
+               })
+      else if isExprHole exp then
+        Some
+          (Cargument
+             {
+               functionContextPath = contextPath;
+               argumentLabel = Labelled labelled.name;
+               prefix = "";
+             })
       else loop rest
     | {label = None; exp} :: rest ->
-      if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None
-      else loop rest
+      if Res_parsetree_viewer.isTemplateLiteral exp then None
+      else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then
+        (* Completing in an unlabelled argument *)
+        match extractCompletableArgValueInfo exp with
+        | None -> None
+        | Some prefix ->
+          Some
+            (Cargument
+               {
+                 functionContextPath = contextPath;
+                 argumentLabel =
+                   Unlabelled {argumentPosition = !unlabelledCount};
+                 prefix;
+               })
+      else if isExprHole exp then
+        Some
+          (Cargument
+             {
+               functionContextPath = contextPath;
+               argumentLabel = Unlabelled {argumentPosition = !unlabelledCount};
+               prefix = "";
+             })
+      else (
+        unlabelledCount := !unlabelledCount + 1;
+        loop rest)
     | [] ->
-      if posAfterFunExpr <= posBeforeCursor && posBeforeCursor < endPos then
-        Some (CnamedArg (contextPath, "", allNames))
+      if fnHasCursor then
+        match charBeforeCursor with
+        | Some '~' -> Some (Completable.CnamedArg (contextPath, "", allNames))
+        | _ ->
+          Some
+            (Cargument
+               {
+                 functionContextPath = contextPath;
+                 argumentLabel =
+                   Unlabelled {argumentPosition = !unlabelledCount};
+                 prefix = "";
+               })
       else None
   in
-  loop args
+  match args with
+  (* Special handling for empty fn calls, e.g. `let _ = someFn(<com>)` *)
+  | [
+   {label = None; exp = {pexp_desc = Pexp_construct ({txt = Lident "()"}, _)}};
+  ]
+    when fnHasCursor ->
+    Some
+      (Completable.Cargument
+         {
+           functionContextPath = contextPath;
+           argumentLabel = Unlabelled {argumentPosition = 0};
+           prefix = "";
+         })
+  | _ -> loop args
 
 let rec exprToContextPath (e : Parsetree.expression) =
   match e.pexp_desc with
@@ -553,15 +635,36 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
           when Loc.end_ opLoc = posCursor ->
           (* Case foo-> *)
           setPipeResult ~lhs ~id:"" |> ignore
-        | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
-          ()
-        | Pexp_apply (funExpr, args)
+        | Pexp_apply
+            ( {pexp_desc = Pexp_ident {txt = Lident "|."}},
+              [_; (_, {pexp_desc = Pexp_apply (funExpr, args)})] )
           when (* Normally named arg completion fires when the cursor is right after the expression.
                   E.g in foo(~<---there
                   But it should not fire in foo(~a)<---there *)
                not
                  (Loc.end_ expr.pexp_loc = posCursor
                  && charBeforeCursor = Some ')') ->
+          (* Complete fn argument values and named args when the fn call is piped. E.g. someVar->someFn(<com>). *)
+          let args = extractExpApplyArgs ~args in
+          let argCompletable =
+            match exprToContextPath funExpr with
+            | Some contextPath ->
+              findArgCompletables ~contextPath ~args
+                ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor
+                ~posAfterFunExpr:(Loc.end_ funExpr.pexp_loc)
+                ~charBeforeCursor ~isPipedExpr:true
+            | None -> None
+          in
+
+          setResultOpt argCompletable
+        | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
+          (* Ignore any other pipe. *)
+          ()
+        | Pexp_apply (funExpr, args)
+          when not
+                 (Loc.end_ expr.pexp_loc = posCursor
+                 && charBeforeCursor = Some ')') ->
+          (* Complete fn argument values and named args when the fn call is _not_ piped. E.g. someFn(<com>). *)
           let args = extractExpApplyArgs ~args in
           if debug then
             Printf.printf "Pexp_apply ...%s (%s)\n"
@@ -578,16 +681,17 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor ~text =
                        (Loc.toString exp.pexp_loc))
               |> String.concat ", ");
 
-          let namedArgCompletable =
+          let argCompletable =
             match exprToContextPath funExpr with
             | Some contextPath ->
-              findNamedArgCompletable ~contextPath ~args
+              findArgCompletables ~contextPath ~args
                 ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor
                 ~posAfterFunExpr:(Loc.end_ funExpr.pexp_loc)
+                ~charBeforeCursor ~isPipedExpr:false
             | None -> None
           in
 
-          setResultOpt namedArgCompletable
+          setResultOpt argCompletable
         | Pexp_send (lhs, {txt; loc}) -> (
           (* e["txt"]
              If the string for txt is not closed, it could go over several lines.