pick up all props needed to print types both from type_expr and declarations

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -233,6 +233,7 @@ let detail name (kind : Completion.kind) =
         ^ ")")
     ^ "\n\n" ^ s
   | Snippet s -> s
+  | ExtractedType extractedType -> TypeUtils.extractedTypeToString extractedType
 
 let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed
     ~(completionContext : Completable.completionContext) =
@@ -587,6 +588,8 @@ let completionsGetCompletionType = function
   | {Completion.kind = ObjLabel typ; env} :: _ -> Some (TypeExpr typ, env)
   | {Completion.kind = Field ({typ}, _); env} :: _ -> Some (TypeExpr typ, env)
   | {Completion.kind = Type typ; env} :: _ -> Some (ResolvedType typ, env)
+  | {Completion.kind = ExtractedType typ; env} :: _ ->
+    Some (ExtractedType typ, env)
   | _ -> None
 
 let rec getCompletionsForContextPath ~full ~opens ~rawOpens ~allFiles ~pos ~env
@@ -1083,7 +1086,7 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
         ~insertText:(printConstructorArgs numExprs ~asSnippet:true)
         ~kind:(Value typ) ~env ();
     ]
-  | Some (Trecord {env; fields; typeExpr}) -> (
+  | Some (Trecord {env; fields} as extractedType) -> (
     (* As we're completing for a record, we'll need a hint (completionContext)
        here to figure out whether we should complete for a record field, or
        the record body itself. *)
@@ -1094,15 +1097,16 @@ let rec completeTypedValue (t : SharedTypes.completionType) ~env ~full ~prefix
              List.mem field.fname.txt seenFields = false)
       |> List.map (fun (field : field) ->
              Completion.create field.fname.txt
-               ~kind:(Field (field, typeExpr |> Shared.typeToString))
+               ~kind:
+                 (Field (field, TypeUtils.extractedTypeToString extractedType))
                ~env)
       |> filterItems ~prefix
     | None ->
       if prefix = "" then
         [
           Completion.createWithSnippet ~name:"{}"
             ~insertText:(if !Cfg.supportsSnippets then "{$0}" else "{}")
-            ~sortText:"A" ~kind:(Value typeExpr) ~env ();
+            ~sortText:"A" ~kind:(ExtractedType extractedType) ~env ();
         ]
       else [])
   | Some (TinlineRecord {env; fields}) -> (

analysis/src/ProcessCmt.ml

@@ -64,6 +64,7 @@ let rec forTypeSignatureItem ~(env : SharedTypes.Env.t) ~(exported : Exported.t)
         ~item:
           {
             Type.decl;
+            name = ident.name;
             kind =
               (match type_kind with
               | Type_abstract -> (
@@ -167,6 +168,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t)
       ~item:
         {
           Type.decl = typ_type;
+          name = name.txt;
           kind =
             (match typ_kind with
             | Ttype_abstract -> (

analysis/src/SharedTypes.ml

@@ -57,7 +57,7 @@ module Type = struct
     | Record of field list
     | Variant of Constructor.t list
 
-  type t = {kind: kind; decl: Types.type_declaration}
+  type t = {kind: kind; decl: Types.type_declaration; name: string}
 end
 
 module Exported = struct
@@ -140,11 +140,6 @@ module Declared = struct
   }
 end
 
-type completionType =
-  | TypeExpr of Types.type_expr
-  | InlineRecord of field list
-  | ResolvedType of Type.t
-
 module Stamps : sig
   type t
 
@@ -299,6 +294,38 @@ end
 
 type polyVariantConstructor = {name: string; args: Types.type_expr list}
 
+(** An extracted type from a type expr *)
+type extractedType =
+  | Tuple of QueryEnv.t * Types.type_expr list * Types.type_expr
+  | Toption of QueryEnv.t * Types.type_expr
+  | Tbool of QueryEnv.t
+  | Tarray of QueryEnv.t * Types.type_expr
+  | Tstring of QueryEnv.t
+  | Tvariant of {
+      env: QueryEnv.t;
+      constructors: Constructor.t list;
+      variantDecl: Types.type_declaration;
+      variantName: string;
+    }
+  | Tpolyvariant of {
+      env: QueryEnv.t;
+      constructors: polyVariantConstructor list;
+      typeExpr: Types.type_expr;
+    }
+  | Trecord of {
+      env: QueryEnv.t;
+      fields: field list;
+      name: [`Str of string | `TypeExpr of Types.type_expr];
+    }
+  | TinlineRecord of {env: QueryEnv.t; fields: field list}
+  | Tfunction of {env: QueryEnv.t; args: typedFnArg list; typ: Types.type_expr}
+
+type completionType =
+  | TypeExpr of Types.type_expr
+  | InlineRecord of field list
+  | ResolvedType of Type.t
+  | ExtractedType of extractedType
+
 module Completion = struct
   type kind =
     | Module of Module.t
@@ -311,6 +338,7 @@ module Completion = struct
     | Field of field * string
     | FileModule of string
     | Snippet of string
+    | ExtractedType of extractedType
 
   type t = {
     name: string;
@@ -361,7 +389,7 @@ module Completion = struct
     | ObjLabel _ -> 4
     | Label _ -> 4
     | Field (_, _) -> 5
-    | Type _ -> 22
+    | Type _ | ExtractedType _ -> 22
     | Value _ -> 12
     | Snippet _ -> 15
 end
@@ -625,36 +653,6 @@ module Completable = struct
       }
     | CexhaustiveSwitch of {contextPath: contextPath; exprLoc: Location.t}
 
-  (** An extracted type from a type expr *)
-  type extractedType =
-    | Tuple of QueryEnv.t * Types.type_expr list * Types.type_expr
-    | Toption of QueryEnv.t * Types.type_expr
-    | Tbool of QueryEnv.t
-    | Tarray of QueryEnv.t * Types.type_expr
-    | Tstring of QueryEnv.t
-    | Tvariant of {
-        env: QueryEnv.t;
-        constructors: Constructor.t list;
-        variantDecl: Types.type_declaration;
-        variantName: string;
-      }
-    | Tpolyvariant of {
-        env: QueryEnv.t;
-        constructors: polyVariantConstructor list;
-        typeExpr: Types.type_expr;
-      }
-    | Trecord of {
-        env: QueryEnv.t;
-        fields: field list;
-        typeExpr: Types.type_expr;
-      }
-    | TinlineRecord of {env: QueryEnv.t; fields: field list}
-    | Tfunction of {
-        env: QueryEnv.t;
-        args: typedFnArg list;
-        typ: Types.type_expr;
-      }
-
   let toString =
     let completionContextToString = function
       | Value -> "Value"

analysis/src/TypeUtils.ml

@@ -112,7 +112,7 @@ 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))
+    Some (Toption (env, payloadTypeExpr))
   | Tconstr (Path.Pident {name = "array"}, [payloadTypeExpr], _) ->
     Some (Tarray (env, payloadTypeExpr))
   | Tconstr (Path.Pident {name = "bool"}, [], _) -> Some (Tbool env)
@@ -126,7 +126,7 @@ let rec extractType ~env ~package (t : Types.type_expr) =
         (Tvariant
            {env; constructors; variantName = name.txt; variantDecl = decl})
     | Some (env, {item = {kind = Record fields}}) ->
-      Some (Trecord {env; fields; typeExpr = t})
+      Some (Trecord {env; fields; name = `TypeExpr t})
     | _ -> None)
   | Ttuple expressions -> Some (Tuple (env, expressions, t))
   | Tvariant {row_fields} ->
@@ -244,15 +244,17 @@ let rec resolveTypeForPipeCompletion ~env ~package ~lhsLoc ~full
 
 let extractTypeFromCompletionType (t : completionType) ~env ~full =
   match t with
+  | ExtractedType extractedType -> Some extractedType
   | TypeExpr t -> t |> extractType ~env ~package:full.package
   | InlineRecord fields -> Some (TinlineRecord {env; fields})
   | ResolvedType typ -> (
     match typ.kind with
     | Tuple items -> Some (Tuple (env, items, Ctype.newty (Ttuple items)))
-    | Record fields -> Some (TinlineRecord {env; fields})
+    | Record fields -> Some (Trecord {env; fields; name = `Str typ.name})
     | Variant constructors ->
       Some
-        (Tvariant {env; constructors; variantName = ""; variantDecl = typ.decl})
+        (Tvariant
+           {env; constructors; variantName = typ.name; variantDecl = typ.decl})
     | Abstract _ | Open -> (
       match typ.decl.type_manifest with
       | None -> None
@@ -279,8 +281,15 @@ let rec resolveNested (typ : completionType) ~env ~full ~nested =
       | Some {typ; optional} ->
         let typ = if optional then Utils.unwrapIfOption typ else typ in
         TypeExpr typ |> resolveNested ~env ~full ~nested)
-    | NRecordBody {seenFields}, Some (Trecord {env; typeExpr}) ->
+    | NRecordBody {seenFields}, Some (Trecord {env; name = `TypeExpr typeExpr})
+      ->
       Some (TypeExpr typeExpr, env, Some (Completable.RecordField {seenFields}))
+    | ( NRecordBody {seenFields},
+        Some (Trecord {env; name = `Str _} as extractedType) ) ->
+      Some
+        ( ExtractedType extractedType,
+          env,
+          Some (Completable.RecordField {seenFields}) )
     | NRecordBody {seenFields}, Some (TinlineRecord {env; fields}) ->
       Some
         (InlineRecord fields, env, Some (Completable.RecordField {seenFields}))
@@ -362,3 +371,28 @@ let contextPathFromCoreType (coreType : Parsetree.core_type) =
   | Ptyp_constr (loc, []) ->
     Some (Completable.CPId (loc.txt |> Utils.flattenLongIdent, Type))
   | _ -> None
+
+let printRecordFromFields ?name (fields : field list) =
+  (match name with
+  | None -> ""
+  | Some name -> "type " ^ name ^ " = ")
+  ^ "{"
+  ^ (fields
+    |> List.map (fun f -> f.fname.txt ^ ": " ^ Shared.typeToString f.typ)
+    |> String.concat ", ")
+  ^ "}"
+
+let extractedTypeToString = function
+  | Tuple (_, _, typ)
+  | Toption (_, typ)
+  | Tpolyvariant {typeExpr = typ}
+  | Tfunction {typ}
+  | Trecord {name = `TypeExpr typ} ->
+    Shared.typeToString typ
+  | Tbool _ -> "bool"
+  | Tstring _ -> "string"
+  | Tarray (_, innerTyp) -> "array<" ^ Shared.typeToString innerTyp ^ ">"
+  | Tvariant {variantDecl; variantName} ->
+    Shared.declToString variantName variantDecl
+  | Trecord {name = `Str name; fields} -> printRecordFromFields ~name fields
+  | TinlineRecord {fields} -> printRecordFromFields fields

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

@@ -169,7 +169,7 @@ Completable: Cexpression CArgument Value[fnTakingRecord]($0)->recordField(nested
     "insertTextFormat": 2
   }, {
     "label": "Some({})",
-    "kind": 12,
+    "kind": 22,
     "tags": [],
     "detail": "otherRecord",
     "documentation": null,
@@ -264,7 +264,7 @@ Pexp_apply ...[56:11->56:25] (...[56:26->56:60])
 Completable: Cexpression CArgument Value[fnTakingRecord]($0)->recordField(polyvariant), polyvariantPayload::three($0)
 [{
     "label": "{}",
-    "kind": 12,
+    "kind": 22,
     "tags": [],
     "detail": "someRecord",
     "documentation": null,
@@ -590,7 +590,7 @@ Pexp_apply ...[135:11->135:31] (...[135:32->135:66])
 Completable: Cexpression CArgument Value[fnTakingInlineRecord]($0)->variantPayload::WithInlineRecord($0), recordField(nestedRecord)
 [{
     "label": "{}",
-    "kind": 12,
+    "kind": 22,
     "tags": [],
     "detail": "otherRecord",
     "documentation": null,

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

@@ -76,7 +76,7 @@ XXX Not found!
 Completable: Cpattern Value[f]
 [{
     "label": "{}",
-    "kind": 12,
+    "kind": 22,
     "tags": [],
     "detail": "someRecord",
     "documentation": null,
@@ -166,7 +166,7 @@ posCursor:[61:22] posNoWhite:[61:21] Found pattern:[61:16->61:25]
 Completable: Cpattern Value[f]->recordField(nest)
 [{
     "label": "{}",
-    "kind": 12,
+    "kind": 22,
     "tags": [],
     "detail": "nestedRecord",
     "documentation": null,

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

@@ -3,9 +3,9 @@ XXX Not found!
 Completable: Cexpression Type[someRecord]
 [{
     "label": "{}",
-    "kind": 4,
+    "kind": 22,
     "tags": [],
-    "detail": "Inline record",
+    "detail": "type someRecord = {age: int, name: string}",
     "documentation": null,
     "sortText": "A",
     "insertText": "{$0}",
@@ -17,15 +17,15 @@ XXX Not found!
 Completable: Cexpression Type[someRecord]->recordBody
 [{
     "label": "age",
-    "kind": 4,
+    "kind": 5,
     "tags": [],
-    "detail": "Inline record",
+    "detail": "age: int\n\ntype someRecord = {age: int, name: string}",
     "documentation": null
   }, {
     "label": "name",
-    "kind": 4,
+    "kind": 5,
     "tags": [],
-    "detail": "Inline record",
+    "detail": "name: string\n\ntype someRecord = {age: int, name: string}",
     "documentation": null
   }]
 
@@ -36,15 +36,15 @@ Completable: Cexpression Type[someVariant]
     "label": "One",
     "kind": 4,
     "tags": [],
-    "detail": "One\n\ntype  = One | Two(bool)",
+    "detail": "One\n\ntype someVariant = One | Two(bool)",
     "documentation": null,
     "insertText": "One",
     "insertTextFormat": 2
   }, {
     "label": "Two(_)",
     "kind": 4,
     "tags": [],
-    "detail": "Two(bool)\n\ntype  = One | Two(bool)",
+    "detail": "Two(bool)\n\ntype someVariant = One | Two(bool)",
     "documentation": null,
     "insertText": "Two(${1:_})",
     "insertTextFormat": 2
@@ -57,7 +57,7 @@ Completable: Cexpression Type[someVariant]=O
     "label": "One",
     "kind": 4,
     "tags": [],
-    "detail": "One\n\ntype  = One | Two(bool)",
+    "detail": "One\n\ntype someVariant = One | Two(bool)",
     "documentation": null,
     "sortText": "A One",
     "insertText": "One",