move Toption to use completion type as well

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -1059,35 +1059,30 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~full ~prefix
              ~env ())
     |> filterItems ~prefix
   | Toption (env, t) ->
-    let innerType =
-      Utils.unwrapIfOption t |> TypeUtils.extractType ~env ~package:full.package
-    in
+    let innerType = TypeUtils.unwrapCompletionTypeIfOption t in
     let expandedCompletions =
       innerType
-      |> Option.map (fun innerType ->
-             innerType
-             |> completeTypedValue ~full ~prefix ~completionContext ~mode
-             |> List.map (fun (c : Completion.t) ->
-                    {
-                      c with
-                      name = "Some(" ^ c.name ^ ")";
-                      sortText = None;
-                      insertText =
-                        (match c.insertText with
-                        | None -> None
-                        | Some insertText -> Some ("Some(" ^ insertText ^ ")"));
-                    }))
+      |> completeTypedValue ~full ~prefix ~completionContext ~mode
+      |> List.map (fun (c : Completion.t) ->
+             {
+               c with
+               name = "Some(" ^ c.name ^ ")";
+               sortText = None;
+               insertText =
+                 (match c.insertText with
+                 | None -> None
+                 | Some insertText -> Some ("Some(" ^ insertText ^ ")"));
+             })
     in
-    ([
-       Completion.create "None" ~kind:(Label (t |> Shared.typeToString)) ~env;
-       Completion.createWithSnippet ~name:"Some(_)"
-         ~kind:(Label (t |> Shared.typeToString))
-         ~env ~insertText:"Some(${1:_})" ();
-     ]
-    @
-    match expandedCompletions with
-    | None -> []
-    | Some expandedCompletions -> expandedCompletions)
+    [
+      Completion.create "None"
+        ~kind:(Label (t |> TypeUtils.extractedTypeToString))
+        ~env;
+      Completion.createWithSnippet ~name:"Some(_)"
+        ~kind:(Label (t |> TypeUtils.extractedTypeToString))
+        ~env ~insertText:"Some(${1:_})" ();
+    ]
+    @ expandedCompletions
     |> filterItems ~prefix
   | Tuple (env, exprs, typ) ->
     let numExprs = List.length exprs in

analysis/src/SharedTypes.ml

@@ -297,7 +297,7 @@ type polyVariantConstructor = {name: string; args: Types.type_expr list}
 (** An type that can be used to drive completion *)
 type completionType =
   | Tuple of QueryEnv.t * Types.type_expr list * Types.type_expr
-  | Toption of QueryEnv.t * Types.type_expr
+  | Toption of QueryEnv.t * completionType
   | Tbool of QueryEnv.t
   | Tarray of QueryEnv.t * Types.type_expr
   | Tstring of QueryEnv.t

analysis/src/TypeUtils.ml

@@ -112,7 +112,8 @@ 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 (Toption (env, payloadTypeExpr))
+    payloadTypeExpr |> extractType ~env ~package
+    |> Option.map (fun payloadTyp -> Toption (env, payloadTyp))
   | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) ->
     Some (Tarray (env, payloadTypeExpr))
   | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env)
@@ -299,10 +300,7 @@ let rec resolveNested (typ : completionType) ~env ~full ~nested =
           Some (Completable.RecordField {seenFields}) )
     | NVariantPayload {constructorName = "Some"; itemNum = 0}, Toption (env, typ)
       ->
-      typ
-      |> extractType ~env ~package:full.package
-      |> Utils.Option.flatMap (fun typ ->
-             typ |> resolveNested ~env ~full ~nested)
+      typ |> resolveNested ~env ~full ~nested
     | NVariantPayload {constructorName; itemNum}, Tvariant {env; constructors}
       -> (
       match
@@ -400,18 +398,23 @@ let printRecordFromFields ?name (fields : field list) =
     |> String.concat ", ")
   ^ "}"
 
-let extractedTypeToString = function
+let rec extractedTypeToString = function
   | Tuple (_, _, typ)
-  | Toption (_, typ)
   | Tpolyvariant {typeExpr = typ}
   | Tfunction {typ}
   | Trecord {definition = `TypeExpr typ} ->
     Shared.typeToString typ
   | Tbool _ -> "bool"
   | Tstring _ -> "string"
   | Tarray (_, innerTyp) -> "array<" ^ Shared.typeToString innerTyp ^ ">"
+  | Toption (_, typ) -> "option<" ^ extractedTypeToString typ ^ ">"
   | Tvariant {variantDecl; variantName} ->
     Shared.declToString variantName variantDecl
   | Trecord {definition = `NameOnly name; fields} ->
     printRecordFromFields ~name fields
-  | TinlineRecord {fields} -> printRecordFromFields fields
+  | TinlineRecord {fields} -> printRecordFromFields fields
+
+let unwrapCompletionTypeIfOption (t : SharedTypes.completionType) =
+  match t with
+  | Toption (_, unwrapped) -> unwrapped
+  | _ -> t

analysis/src/Utils.ml

@@ -168,6 +168,7 @@ let rec unwrapIfOption (t : Types.type_expr) =
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> unwrapIfOption t1
   | Tconstr (Path.Pident {name = "option"}, [unwrappedType], _) -> unwrappedType
   | _ -> t
+
 let isReactComponent (vb : Parsetree.value_binding) =
   vb.pvb_attributes
   |> List.exists (function

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

@@ -497,13 +497,13 @@ Completable: Cexpression CArgument Value[fnTakingRecordWithOptVariant]($0)->reco
     "label": "None",
     "kind": 4,
     "tags": [],
-    "detail": "someVariant",
+    "detail": "type someVariant = One | Two | Three(int, string)",
     "documentation": null
   }, {
     "label": "Some(_)",
     "kind": 4,
     "tags": [],
-    "detail": "someVariant",
+    "detail": "type someVariant = One | Two | Three(int, string)",
     "documentation": null,
     "insertText": "Some(${1:_})",
     "insertTextFormat": 2

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

@@ -158,7 +158,7 @@ Completable: Cexpression CArgument Value[someFnTakingVariant]($0)=So
     "label": "Some(_)",
     "kind": 4,
     "tags": [],
-    "detail": "someVariant",
+    "detail": "type someVariant = One | Two | Three(int, string)",
     "documentation": null,
     "sortText": "A Some(_)",
     "insertText": "Some(${1:_})",