basic completion for variant constructors

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,54 @@ 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);
+          constructors
+          |> List.filter (fun constructor ->
+                 (* This currently omits any constructor with a payload. Probably don't want to emit them. Maybe we can just move the cursor inside of the payload and continue from there.*)
+                 (* TODO: Account for existing prefix (e.g what the user has already started typing, if anything) *)
+                 constructor.Constructor.args |> List.length = 0)
+          |> List.map (fun constructor ->
+                 Completion.create ~name:constructor.Constructor.cname.txt
+                   ~kind:(Constructor (constructor, ""))
+                   ~env))))

analysis/src/CompletionFrontEnd.ml

@@ -162,7 +162,7 @@ let findNamedArgCompletable ~(args : arg list) ~endPos ~posBeforeCursor
         || charBeforeCursor = Some '='
       then (
         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,26 +1,26 @@
 type someVariant = One | Two | Three | Four
 
-let someVariantToString = (~someVariant) =>
-  switch someVariant {
-  | One => "One"
+let someVariantToString = (~someConfig, ~otherRandomArg) =>
+  switch someConfig {
+  | One => "One " ++ otherRandomArg
   | Two => "Two"
   | Three => "Three"
   | Four => "Four"
   }
 
-// let x = someVariantToString(~someVaria
+// let x = someVariantToString(~someConfi
 //                                       ^com
 
-// let x = someVariantToString(~someVariant=
-//                                          ^com
+// let x = someVariantToString(~someConfig=
+//                                         ^com
 
-// let x = someVariantToString(~someVariant=T
-//                                           ^com
+// let x = someVariantToString(~someConfig=T
+//                                          ^com
 
 module SomeComponent = {
   @react.component
   let make = (~whatever) => {
-    someVariantToString(~someVariant=whatever)->React.string
+    someVariantToString(~someConfig=whatever, ~otherRandomArg="123")->React.string
   }
 }
 

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

@@ -1,29 +1,82 @@
 Complete src/TypeContextCompletion.res 10:41
 posCursor:[10:41] posNoWhite:[10:40] Found expr:[10:11->24:1]
-Pexp_apply ...[10:11->10:30] (~someVaria10:32->10:41=...[10:32->10:41], ...[19:0->23:3])
-Completable: CnamedArg(Value[someVariantToString], someVaria, [someVaria])
-Found type for function (~someVariant: someVariant) => string
+Pexp_apply ...[10:11->10:30] (~someConfi10:32->10:41=...[10:32->10:41], ...[19:0->23:3])
+Completable: CnamedArg(Value[someVariantToString], someConfi, [someConfi])
+Found type for function (
+  ~someConfig: someVariant,
+  ~otherRandomArg: string,
+) => string
 [{
-    "label": "someVariant",
+    "label": "someConfig",
     "kind": 4,
     "tags": [],
     "detail": "someVariant",
     "documentation": null
   }]
 
-Complete src/TypeContextCompletion.res 13:44
-posCursor:[13:44] posNoWhite:[13:43] Found expr:[13:11->24:1]
-Pexp_apply ...[13:11->13:30] (~someVariant13:32->13:43=...[19:0->23:3])
+Complete src/TypeContextCompletion.res 13:43
+posCursor:[13:43] posNoWhite:[13:42] Found expr:[13:11->24:1]
+Pexp_apply ...[13:11->13:30] (~someConfig13:32->13:42=...[19:0->23:3])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someConfig))
+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
+  }]
 
-Complete src/TypeContextCompletion.res 16:45
-posCursor:[16:45] posNoWhite:[16:44] Found expr:[16:11->24:1]
-Pexp_apply ...[16:11->16:30] (~someVariant16:32->16:43=...[16:44->16:45], ...[19:0->23:3])
+Complete src/TypeContextCompletion.res 16:44
+posCursor:[16:44] posNoWhite:[16:43] Found expr:[16:11->24:1]
+Pexp_apply ...[16:11->16:30] (~someConfig16:32->16:42=...[16:43->16:44], ...[19:0->23:3])
 found typed context 
-Completable: CtypedContext(Value[someVariantToString])
-[]
+Completable: CtypedContext(Value[someVariantToString], NamedArg(someConfig))
+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
+  }]
 
 Complete src/TypeContextCompletion.res 26:37
 posCursor:[26:37] posNoWhite:[26:36] Found expr:[26:14->26:37]

server/src/server.ts

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