clean up details and documentation output on completion items

Author: zth

analysis/src/Commands.ml

@@ -4,13 +4,12 @@ let completion ~debug ~path ~pos ~currentFile =
       Completions.getCompletions ~debug ~path ~pos ~currentFile ~forHover:false
     with
     | None -> []
-    | Some (completions, _, _) -> completions
+    | Some (completions, full, _) ->
+      completions
+      |> List.map (CompletionBackEnd.completionToItem ~full)
+      |> List.map Protocol.stringifyCompletionItem
   in
-  print_endline
-    (completions
-    |> List.map CompletionBackEnd.completionToItem
-    |> List.map Protocol.stringifyCompletionItem
-    |> Protocol.array)
+  completions |> Protocol.array |> print_endline
 
 let inlayhint ~path ~pos ~maxLength ~debug =
   let result =

analysis/src/CompletionBackEnd.ml

@@ -79,7 +79,7 @@ let completionForExporteds iterExported getDeclared ~prefix ~exact ~env
           res :=
             {
               (Completion.create declared.name.txt ~env
-                 ~kind:(transformContents declared.item))
+                 ~kind:(transformContents declared))
               with
               deprecated = declared.deprecated;
               docstring = declared.docstring;
@@ -90,18 +90,20 @@ let completionForExporteds iterExported getDeclared ~prefix ~exact ~env
 
 let completionForExportedModules ~env ~prefix ~exact ~namesUsed =
   completionForExporteds (Exported.iter env.QueryEnv.exported Exported.Module)
-    (Stamps.findModule env.file.stamps) ~prefix ~exact ~env ~namesUsed (fun m ->
-      Completion.Module m)
+    (Stamps.findModule env.file.stamps) ~prefix ~exact ~env ~namesUsed
+    (fun declared ->
+      Completion.Module
+        {docstring = declared.docstring; module_ = declared.item})
 
 let completionForExportedValues ~env ~prefix ~exact ~namesUsed =
   completionForExporteds (Exported.iter env.QueryEnv.exported Exported.Value)
-    (Stamps.findValue env.file.stamps) ~prefix ~exact ~env ~namesUsed (fun v ->
-      Completion.Value v)
+    (Stamps.findValue env.file.stamps) ~prefix ~exact ~env ~namesUsed
+    (fun declared -> Completion.Value declared.item)
 
 let completionForExportedTypes ~env ~prefix ~exact ~namesUsed =
   completionForExporteds (Exported.iter env.QueryEnv.exported Exported.Type)
-    (Stamps.findType env.file.stamps) ~prefix ~exact ~env ~namesUsed (fun t ->
-      Completion.Type t)
+    (Stamps.findType env.file.stamps) ~prefix ~exact ~env ~namesUsed
+    (fun declared -> Completion.Type declared.item)
 
 let completionsForExportedConstructors ~(env : QueryEnv.t) ~prefix ~exact
     ~namesUsed =
@@ -224,39 +226,104 @@ let getEnvWithOpens ~scope ~(env : QueryEnv.t) ~package
       | None -> None
       | Some env -> ResolvePath.resolvePath ~env ~package ~path))
 
+let rec expandTypeExpr ~env ~package typeExpr =
+  match typeExpr |> Shared.digConstructor with
+  | Some path -> (
+    match References.digConstructor ~env ~package path with
+    | None -> None
+    | Some (env, {item = {decl = {type_manifest = Some t}}}) ->
+      expandTypeExpr ~env ~package t
+    | Some (_, {docstring; item}) -> Some (docstring, item))
+  | None -> None
+
+let kindToDocumentation ~env ~full ~currentDocstring name
+    (kind : Completion.kind) =
+  let docsFromKind =
+    match kind with
+    | ObjLabel _ | Label _ | FileModule _ | Snippet _ | FollowContextPath _ ->
+      []
+    | Module {docstring} -> docstring
+    | Type {decl; name} ->
+      [decl |> Shared.declToString name |> Markdown.codeBlock]
+    | Value typ -> (
+      match expandTypeExpr ~env ~package:full.package typ with
+      | None -> []
+      | Some (docstrings, {decl; name; kind}) ->
+        docstrings
+        @ [
+            (match kind with
+            | Record _ | Tuple _ | Variant _ ->
+              Markdown.codeBlock (Shared.declToString name decl)
+            | _ -> "");
+          ])
+    | Field ({typ; optional; docstring}, s) ->
+      (* Handle optional fields. Checking for "?" is because sometimes optional
+         fields are prefixed with "?" when completing, and at that point we don't
+         need to _also_ add a "?" after the field name, as that looks weird. *)
+      docstring
+      @ [
+          Markdown.codeBlock
+            (if optional && Utils.startsWith name "?" = false then
+               name ^ "?: "
+               ^ (typ |> Utils.unwrapIfOption |> Shared.typeToString)
+             else name ^ ": " ^ (typ |> Shared.typeToString));
+          Markdown.codeBlock s;
+        ]
+    | Constructor (c, s) ->
+      [Markdown.codeBlock (showConstructor c); Markdown.codeBlock s]
+    | PolyvariantConstructor ({displayName; args}, s) ->
+      [
+        Markdown.codeBlock
+          ("#" ^ displayName
+          ^
+          match args with
+          | [] -> ""
+          | typeExprs ->
+            "("
+            ^ (typeExprs
+              |> List.map (fun typeExpr -> typeExpr |> Shared.typeToString)
+              |> String.concat ", ")
+            ^ ")");
+        Markdown.codeBlock s;
+      ]
+    | ExtractedType (extractedType, _) ->
+      [Markdown.codeBlock (TypeUtils.extractedTypeToString extractedType)]
+  in
+  currentDocstring @ docsFromKind
+  |> List.filter (fun s -> s <> "")
+  |> String.concat "\n\n"
+
 let kindToDetail name (kind : Completion.kind) =
   match kind with
-  | Type {decl} -> decl |> Shared.declToString name
+  | Type {name} -> "type " ^ name
   | Value typ -> typ |> Shared.typeToString
   | ObjLabel typ -> typ |> Shared.typeToString
   | Label typString -> typString
-  | Module _ -> "module"
-  | FileModule _ -> "file module"
-  | Field ({typ; optional}, s) ->
+  | Module _ -> "module " ^ name
+  | FileModule f -> "module " ^ f
+  | Field ({typ; optional}, _) ->
     (* Handle optional fields. Checking for "?" is because sometimes optional
        fields are prefixed with "?" when completing, and at that point we don't
        need to _also_ add a "?" after the field name, as that looks weird. *)
     if optional && Utils.startsWith name "?" = false then
-      name ^ "?: "
-      ^ (typ |> Utils.unwrapIfOption |> Shared.typeToString)
-      ^ "\n\n" ^ s
-    else name ^ ": " ^ (typ |> Shared.typeToString) ^ "\n\n" ^ s
-  | Constructor (c, s) -> showConstructor c ^ "\n\n" ^ s
-  | PolyvariantConstructor ({displayName; args}, s) ->
+      typ |> Utils.unwrapIfOption |> Shared.typeToString
+    else typ |> Shared.typeToString
+  | Constructor (c, _) -> showConstructor c
+  | PolyvariantConstructor ({displayName; args}, _) -> (
     "#" ^ displayName
-    ^ (match args with
-      | [] -> ""
-      | typeExprs ->
-        "("
-        ^ (typeExprs
-          |> List.map (fun typeExpr -> typeExpr |> Shared.typeToString)
-          |> String.concat ", ")
-        ^ ")")
-    ^ "\n\n" ^ s
+    ^
+    match args with
+    | [] -> ""
+    | typeExprs ->
+      "("
+      ^ (typeExprs
+        |> List.map (fun typeExpr -> typeExpr |> Shared.typeToString)
+        |> String.concat ", ")
+      ^ ")")
   | Snippet s -> s
   | FollowContextPath _ -> ""
   | ExtractedType (extractedType, _) ->
-    TypeUtils.extractedTypeToString extractedType
+    TypeUtils.extractedTypeToString ~nameOnly:true extractedType
 
 let findAllCompletions ~(env : QueryEnv.t) ~prefix ~exact ~namesUsed
     ~(completionContext : Completable.completionContext) =
@@ -366,7 +433,9 @@ let processLocalModule name loc ~prefix ~exact ~env
         localTables.resultRev <-
           {
             (Completion.create declared.name.txt ~env
-               ~kind:(Module declared.item))
+               ~kind:
+                 (Module
+                    {docstring = declared.docstring; module_ = declared.item}))
             with
             deprecated = declared.deprecated;
             docstring = declared.docstring;
@@ -620,7 +689,8 @@ let completionToItem
       insertTextFormat;
       filterText;
       detail;
-    } =
+      env;
+    } ~full =
   let item =
     mkItem ~name
       ~kind:(Completion.kindToInt kind)
@@ -629,7 +699,12 @@ let completionToItem
         (match detail with
         | None -> kindToDetail name kind
         | Some detail -> detail)
-      ~docstring
+      ~docstring:
+        (match
+           kindToDocumentation ~currentDocstring:docstring ~full ~env name kind
+         with
+        | "" -> []
+        | docstring -> [docstring])
   in
   {item with sortText; insertText; insertTextFormat; filterText}
 

analysis/src/SharedTypes.ml

@@ -775,7 +775,7 @@ end
 
 module Completion = struct
   type kind =
-    | Module of Module.t
+    | Module of {docstring: string list; module_: Module.t}
     | Value of Types.type_expr
     | ObjLabel of Types.type_expr
     | Label of string

analysis/src/TypeUtils.ml

@@ -26,16 +26,22 @@ let printRecordFromFields ?name (fields : field list) =
     |> String.concat ", ")
   ^ "}"
 
-let rec extractedTypeToString ?(inner = false) = function
-  | Tuple (_, _, typ)
-  | Tpolyvariant {typeExpr = typ}
-  | Tfunction {typ}
-  | Trecord {definition = `TypeExpr typ} ->
+let rec extractedTypeToString ?(nameOnly = false) ?(inner = false) = function
+  | Tuple (_, _, typ) | Tpolyvariant {typeExpr = typ} | Tfunction {typ} ->
     if inner then
-      match pathFromTypeExpr typ with
-      | None -> "record" (* Won't happen *)
-      | Some p -> p |> SharedTypes.pathIdentToString
+      try typ |> pathFromTypeExpr |> Option.get |> SharedTypes.pathIdentToString
+      with _ -> ""
     else Shared.typeToString typ
+  | Trecord {definition; fields} ->
+    let name =
+      match definition with
+      | `TypeExpr typ -> (
+        try
+          typ |> pathFromTypeExpr |> Option.get |> SharedTypes.pathIdentToString
+        with _ -> "")
+      | `NameOnly name -> name
+    in
+    if inner || nameOnly then name else printRecordFromFields ~name fields
   | Tbool _ -> "bool"
   | Tstring _ -> "string"
   | TtypeT _ -> "type t"
@@ -53,9 +59,8 @@ let rec extractedTypeToString ?(inner = false) = function
     "option<" ^ extractedTypeToString ~inner:true innerTyp ^ ">"
   | Tpromise (_, innerTyp) -> "promise<" ^ Shared.typeToString innerTyp ^ ">"
   | Tvariant {variantDecl; variantName} ->
-    if inner then variantName else Shared.declToString variantName variantDecl
-  | Trecord {definition = `NameOnly name; fields} ->
-    if inner then name else printRecordFromFields ~name fields
+    if inner || nameOnly then variantName
+    else Shared.declToString variantName variantDecl
   | TinlineRecord {fields} -> printRecordFromFields fields
   | Texn _ -> "exn"
 

analysis/tests-incremental-typechecking/src/expected/ConstructorCompletion__Json.res.txt

@@ -12,7 +12,7 @@ ContextPath CTypeAtPos()
     "kind": 12,
     "tags": [],
     "detail": "t",
-    "documentation": null,
+    "documentation": {"kind": "markdown", "value": " The JSON data structure \n\n```rescript\ntype t =\n  | Boolean(bool)\n  | Null\n  | String(string)\n  | Number(float)\n  | Object(Js.Dict.t<t>)\n  | Array(array<t>)\n```"},
     "sortText": "A",
     "insertText": "[$0]",
     "insertTextFormat": 2

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

@@ -31,6 +31,6 @@ Path ax
     "kind": 12,
     "tags": [],
     "detail": "Test.t",
-    "documentation": null
+    "documentation": {"kind": "markdown", "value": "```rescript\ntype t = {name: int}\n```"}
   }]