Explore type based autocomplete

analysis/src/CompletionBackEnd.ml

@@ -992,6 +992,18 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) =
     | _ -> None)
   | _ -> None
 
+let rec extractVariantType ~env ~package (t : Types.type_expr) =
+  match t.desc with
+  | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractVariantType ~env ~package t1
+  | Tconstr (path, _, _) -> (
+    match References.digConstructor ~env ~package path with
+    | Some (env, ({item = {kind = Variant constructors}} as typ)) ->
+      Some (env, constructors, typ)
+    | Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
+      extractVariantType ~env ~package t1
+    | _ -> None)
+  | _ -> None
+
 let rec extractObjectType ~env ~package (t : Types.type_expr) =
   match t.desc with
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractObjectType ~env ~package t1
@@ -1337,7 +1349,6 @@ let processCompletable ~debug ~package ~scope ~env ~pos ~forHover
   in
   match completable with
   | Cnone -> []
-  | CtypedContext _contextPath -> []
   | Cpath contextPath ->
     contextPath
     |> getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
@@ -1687,3 +1698,62 @@ Note: The `@react.component` decorator requires the react-jsx config to be set i
            Utils.startsWith name prefix
            && (forHover || not (List.mem name identsSeen)))
     |> List.map mkLabel
+  | CtypedContext (cp, typedContext) -> (
+    match typedContext with
+    | NamedArg argName -> (
+      (* TODO: Should probably share this with the branch handling CnamedArg... *)
+      let labels =
+        match
+          cp
+          |> getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles
+               ~pos ~env ~exact:true ~scope
+          |> completionsGetTypeEnv
+        with
+        | Some (typ, _env) ->
+          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, _, _) -> (
+              match References.digConstructor ~env ~package path with
+              | Some (env, {item = {decl = {type_manifest = Some t1}}}) ->
+                getLabels ~env t1
+              | _ -> [])
+            | _ -> []
+          in
+          typ |> getLabels ~env
+        | None -> []
+      in
+      let targetLabel =
+        labels |> List.find_opt (fun (name, _t) -> name = argName)
+      in
+      match targetLabel with
+      | None -> []
+      | Some (_, typeExpr) -> (
+        match extractVariantType ~env ~package typeExpr with
+        | None ->
+          if debug then Printf.printf "Could not extract variant type\n";
+          []
+        | Some (_env, constructors, _typ) ->
+          if debug then
+            Printf.printf "Found variant type for NamedArg typed context %s\n"
+              (typeExpr |> Shared.typeToString);
+
+          (* TODO: Account for existing prefix (e.g what the user has already started typing, if anything)?
+                According to the LS protocol the client can perform that filtering by itself in the simplest cases.
+                Investigate if doing it ourselves here would be more robust. *)
+          (* TODO: Investigate completing seen identifiers _with the correct type_ here too. If completing
+             variant someVariant, and there's a someVariable of type someVariant, add that to the completion list. *)
+          constructors
+          |> List.map (fun constructor ->
+                 (* TODO: Can we leverage snippets here for automatically moving the cursor when there are multiple payloads?
+                    Eg. Some($1) as completion item. *)
+                 Completion.create
+                   ~name:
+                     (constructor.Constructor.cname.txt
+                     ^ if constructor.args |> List.length > 0 then "(_)" else ""
+                     )
+                   ~kind:(Constructor (constructor, ""))
+                   ~env))))

analysis/src/CompletionFrontEnd.ml

@@ -156,12 +156,12 @@ let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor
       then Some (Completable.CnamedArg (contextPath, labelled.name, allNames))
       else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then (
         if debug then Printf.printf "found typed context \n";
-        Some (Completable.CtypedContext contextPath))
+        Some (Completable.CtypedContext (contextPath, NamedArg labelled.name)))
       else if exp.pexp_loc |> Loc.end_ = (Location.none |> Loc.end_) then (
         (* Expr assigned presumably is "rescript.exprhole" after parser recovery.
            Assume this is an empty expression. *)
         if debug then Printf.printf "found typed context \n";
-        Some (Completable.CtypedContext contextPath))
+        Some (Completable.CtypedContext (contextPath, NamedArg labelled.name)))
       else loop rest
     | {label = None; exp} :: rest ->
       if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None

analysis/src/SharedTypes.ml

@@ -425,6 +425,12 @@ module Completable = struct
     | CPObj of contextPath * string
     | CPPipe of contextPath * string
 
+  type typedContext = NamedArg of string
+
+  let typedContextToString typedContext =
+    match typedContext with
+    | NamedArg argName -> "NamedArg(" ^ argName ^ ")"
+
   type t =
     | Cdecorator of string  (** e.g. @module *)
     | CnamedArg of contextPath * string * string list
@@ -433,7 +439,8 @@ module Completable = struct
     | Cpath of contextPath
     | Cjsx of string list * string * string list
         (** E.g. (["M", "Comp"], "id", ["id1", "id2"]) for <M.Comp id1=... id2=... ... id *)
-    | CtypedContext of contextPath  (** WIP, just a dummy arg for now *)
+    | CtypedContext of contextPath * typedContext
+        (** A typed context we want to complete, like completing a labelled argument assignment  *)
 
   let toString =
     let str s = if s = "" then "\"\"" else s in
@@ -472,5 +479,10 @@ module Completable = struct
     | Cnone -> "Cnone"
     | Cjsx (sl1, s, sl2) ->
       "Cjsx(" ^ (sl1 |> list) ^ ", " ^ str s ^ ", " ^ (sl2 |> list) ^ ")"
-    | CtypedContext cp -> "CtypedContext(" ^ (cp |> contextPathToString) ^ ")"
+    | CtypedContext (cp, typedContext) ->
+      "CtypedContext("
+      ^ (cp |> contextPathToString)
+      ^ ", "
+      ^ (typedContext |> typedContextToString)
+      ^ ")"
 end

analysis/tests/src/TypeContextCompletion.res

@@ -1,11 +1,12 @@
-type someVariant = One | Two | Three | Four
+type someVariant = One | Two | Three | Four | Five(int) | Six(option<string>)
 
 let someVariantToString = (~someVariant) =>
   switch someVariant {
   | One => "One"
   | Two => "Two"
   | Three => "Three"
   | Four => "Four"
+  | _ => "-"
   }
 
 module SomeComponent = {

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

@@ -1,3 +1,3 @@
 DCE src/Dce.res
-issues:241
+issues:243
 

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

@@ -1,6 +1,6 @@
-Complete src/TypeContextCompletion.res 17:41
-posCursor:[17:41] posNoWhite:[17:40] Found expr:[17:11->17:41]
-Pexp_apply ...[17:11->17:30] (~someVaria17:32->17:41=...[17:32->17:41])
+Complete src/TypeContextCompletion.res 18:41
+posCursor:[18:41] posNoWhite:[18:40] Found expr:[18:11->18:41]
+Pexp_apply ...[18:11->18:30] (~someVaria18:32->18:41=...[18:32->18:41])
 Completable: CnamedArg(Value[someVariantToString], someVaria, [someVaria])
 Found type for function (~someVariant: someVariant) => string
 [{
@@ -11,36 +11,184 @@ Found type for function (~someVariant: someVariant) => string
     "documentation": null
   }]
 
-Complete src/TypeContextCompletion.res 20:44
-posCursor:[20:44] posNoWhite:[20:43] Found expr:[20:11->20:44]
-Pexp_apply ...[20:11->20:30] (~someVariant20:32->20:43=...__ghost__[0:-1->0:-1])
+Complete src/TypeContextCompletion.res 21:44
+posCursor:[21:44] posNoWhite:[21:43] Found expr:[21:11->21:44]
+Pexp_apply ...[21:11->21:30] (~someVariant21:32->21:43=...__ghost__[0:-1->0:-1])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someVariant))
+Found variant type for NamedArg typed context someVariant
+[{
+    "label": "One",
+    "kind": 4,
+    "tags": [],
+    "detail": "One\n\n",
+    "documentation": null
+  }, {
+    "label": "Two",
+    "kind": 4,
+    "tags": [],
+    "detail": "Two\n\n",
+    "documentation": null
+  }, {
+    "label": "Three",
+    "kind": 4,
+    "tags": [],
+    "detail": "Three\n\n",
+    "documentation": null
+  }, {
+    "label": "Four",
+    "kind": 4,
+    "tags": [],
+    "detail": "Four\n\n",
+    "documentation": null
+  }, {
+    "label": "Five(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Five(int)\n\n",
+    "documentation": null
+  }, {
+    "label": "Six(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Six(option<string>)\n\n",
+    "documentation": null
+  }]
 
-Complete src/TypeContextCompletion.res 23:45
-posCursor:[23:45] posNoWhite:[23:43] Found expr:[23:11->23:44]
-Pexp_apply ...[23:11->23:30] (~someVariant23:32->23:43=...__ghost__[0:-1->0:-1])
+Complete src/TypeContextCompletion.res 24:45
+posCursor:[24:45] posNoWhite:[24:43] Found expr:[24:11->24:44]
+Pexp_apply ...[24:11->24:30] (~someVariant24:32->24:43=...__ghost__[0:-1->0:-1])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someVariant))
+Found variant type for NamedArg typed context someVariant
+[{
+    "label": "One",
+    "kind": 4,
+    "tags": [],
+    "detail": "One\n\n",
+    "documentation": null
+  }, {
+    "label": "Two",
+    "kind": 4,
+    "tags": [],
+    "detail": "Two\n\n",
+    "documentation": null
+  }, {
+    "label": "Three",
+    "kind": 4,
+    "tags": [],
+    "detail": "Three\n\n",
+    "documentation": null
+  }, {
+    "label": "Four",
+    "kind": 4,
+    "tags": [],
+    "detail": "Four\n\n",
+    "documentation": null
+  }, {
+    "label": "Five(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Five(int)\n\n",
+    "documentation": null
+  }, {
+    "label": "Six(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Six(option<string>)\n\n",
+    "documentation": null
+  }]
 
-Complete src/TypeContextCompletion.res 26:45
-posCursor:[26:45] posNoWhite:[26:44] Found expr:[26:11->26:45]
-Pexp_apply ...[26:11->26:30] (~someVariant26:32->26:43=...[26:44->26:45])
+Complete src/TypeContextCompletion.res 27:45
+posCursor:[27:45] posNoWhite:[27:44] Found expr:[27:11->27:45]
+Pexp_apply ...[27:11->27:30] (~someVariant27:32->27:43=...[27:44->27:45])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someVariant))
+Found variant type for NamedArg typed context someVariant
+[{
+    "label": "One",
+    "kind": 4,
+    "tags": [],
+    "detail": "One\n\n",
+    "documentation": null
+  }, {
+    "label": "Two",
+    "kind": 4,
+    "tags": [],
+    "detail": "Two\n\n",
+    "documentation": null
+  }, {
+    "label": "Three",
+    "kind": 4,
+    "tags": [],
+    "detail": "Three\n\n",
+    "documentation": null
+  }, {
+    "label": "Four",
+    "kind": 4,
+    "tags": [],
+    "detail": "Four\n\n",
+    "documentation": null
+  }, {
+    "label": "Five(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Five(int)\n\n",
+    "documentation": null
+  }, {
+    "label": "Six(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Six(option<string>)\n\n",
+    "documentation": null
+  }]
 
-Complete src/TypeContextCompletion.res 29:45
-posCursor:[29:45] posNoWhite:[29:44] Found expr:[29:11->29:45]
-Pexp_apply ...[29:11->29:30] (~someVariant29:32->29:43=...[29:44->29:45])
+Complete src/TypeContextCompletion.res 30:45
+posCursor:[30:45] posNoWhite:[30:44] Found expr:[30:11->30:45]
+Pexp_apply ...[30:11->30:30] (~someVariant30:32->30:43=...[30:44->30:45])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someVariant))
+Found variant type for NamedArg typed context someVariant
+[{
+    "label": "One",
+    "kind": 4,
+    "tags": [],
+    "detail": "One\n\n",
+    "documentation": null
+  }, {
+    "label": "Two",
+    "kind": 4,
+    "tags": [],
+    "detail": "Two\n\n",
+    "documentation": null
+  }, {
+    "label": "Three",
+    "kind": 4,
+    "tags": [],
+    "detail": "Three\n\n",
+    "documentation": null
+  }, {
+    "label": "Four",
+    "kind": 4,
+    "tags": [],
+    "detail": "Four\n\n",
+    "documentation": null
+  }, {
+    "label": "Five(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Five(int)\n\n",
+    "documentation": null
+  }, {
+    "label": "Six(_)",
+    "kind": 4,
+    "tags": [],
+    "detail": "Six(option<string>)\n\n",
+    "documentation": null
+  }]
 
-Complete src/TypeContextCompletion.res 32:37
-posCursor:[32:37] posNoWhite:[32:36] Found expr:[32:14->32:37]
-JSX <SomeComponent:[32:14->32:27] whatever[32:28->32:36]=...__ghost__[0:-1->0:-1]> _children:None
+Complete src/TypeContextCompletion.res 33:37
+posCursor:[33:37] posNoWhite:[33:36] Found expr:[33:14->33:37]
+JSX <SomeComponent:[33:14->33:27] whatever[33:28->33:36]=...__ghost__[0:-1->0:-1]> _children:None
 []