print link to type definition inline next to expanded type

Author: zth

analysis/src/Hover.ml

@@ -22,11 +22,11 @@ let encodeURIComponent text =
   loop 0;
   Buffer.contents buf
 
-type link = {range: Protocol.range; file: string; label: string}
+type link = {startPos: Protocol.position; file: string; label: string}
 
 let linkToCommandArgs link =
-  Printf.sprintf "[\"%s\",%i,%i,%i,%i]" link.file link.range.start.character
-    link.range.start.line link.range.end_.character link.range.end_.line
+  Printf.sprintf "[\"%s\",%i,%i]" link.file link.startPos.line
+    link.startPos.character
 
 let makeGotoCommand link =
   Printf.sprintf "[%s](command:rescript-vscode.go_to_location?%s)" link.label
@@ -131,9 +131,15 @@ let newHover ~full:{file; package} locItem =
     let fromConstructorPath ~env path =
       match References.digConstructor ~env ~package path with
       | None -> None
-      | Some (_env, {name = {txt}; item = {decl}}) ->
+      | Some (env, {extentLoc; item = {decl}}) ->
         if Utils.isUncurriedInternal path then None
-        else Some (decl |> Shared.declToString txt |> codeBlock)
+        else
+          Some
+            ( decl
+              |> Shared.declToString ~printNameAsIs:true
+                   (SharedTypes.pathIdentToString path),
+              extentLoc,
+              env )
     in
     let fromType ~docstring typ =
       let typeString = codeBlock (typ |> Shared.typeToString) in
@@ -172,40 +178,40 @@ let newHover ~full:{file; package} locItem =
           | None -> (env, [typ])
         in
         let constructors = Shared.findTypeConstructors typesToSearch in
-        constructors |> List.filter_map (fromConstructorPath ~env:envToSearch)
+        constructors
+        |> List.filter_map (fun constructorPath ->
+               match
+                 constructorPath |> fromConstructorPath ~env:envToSearch
+               with
+               | None -> None
+               | Some (typString, extentLoc, env) ->
+                 let startLine, startCol = Pos.ofLexing extentLoc.loc_start in
+                 Some
+                   (Shared.markdownSpacing ^ codeBlock typString ^ "\n"
+                  ^ "Go to: "
+                   ^ makeGotoCommand
+                       {
+                         label = "Type definition";
+                         file = Uri.toString env.file.uri;
+                         startPos = {line = startLine; character = startCol};
+                       }
+                   ^ "\n\n---\n"))
       in
       let typeString = typeString :: typeDefinitions |> String.concat "\n\n" in
-      let links =
-        "\n---\nGo to: "
-        ^ ([
-             makeGotoCommand
-               {
-                 label = "SomeModule";
-                 file =
-                   "file:///Users/zth/git/rescript-vscode-official/analysis/examples/example-project/src/Json.res";
-                 range =
-                   {
-                     start = {character = 0; line = 34};
-                     end_ = {character = 0; line = 42};
-                   };
-               };
-           ]
-          |> String.concat " | ")
-      in
-      (typeString, docstring, links)
+      (typeString, docstring)
     in
     let parts =
       match References.definedForLoc ~file ~package locKind with
       | None ->
-        let typeString, docstring, links = t |> fromType ~docstring:[] in
-        List.concat [[typeString]; docstring; [links]]
+        let typeString, docstring = t |> fromType ~docstring:[] in
+        typeString :: docstring
       | Some (docstring, res) -> (
         match res with
         | `Declared ->
-          let typeString, docstring, links = t |> fromType ~docstring in
-          List.concat [[typeString]; docstring; [links]]
+          let typeString, docstring = t |> fromType ~docstring in
+          typeString :: docstring
         | `Constructor {cname = {txt}; args} ->
-          let typeString, docstring, links = t |> fromType ~docstring in
+          let typeString, docstring = t |> fromType ~docstring in
           let argsString =
             match args with
             | [] -> ""
@@ -214,10 +220,9 @@ let newHover ~full:{file; package} locItem =
               |> List.map (fun (t, _) -> Shared.typeToString t)
               |> String.concat ", " |> Printf.sprintf "(%s)"
           in
-          List.concat
-            [[typeString; codeBlock (txt ^ argsString)]; docstring; [links]]
+          typeString :: codeBlock (txt ^ argsString) :: docstring
         | `Field ->
-          let typeString, docstring, links = t |> fromType ~docstring in
-          List.concat [[typeString]; docstring; [links]])
+          let typeString, docstring = t |> fromType ~docstring in
+          typeString :: docstring)
     in
     Some (String.concat "\n\n" parts)

analysis/src/PrintType.ml

@@ -3,8 +3,8 @@ let printExpr ?(lineWidth = 60) typ =
   Res_doc.toString ~width:lineWidth
     (Res_outcome_printer.printOutTypeDoc (Printtyp.tree_of_typexp false typ))
 
-let printDecl ~recStatus name decl =
+let printDecl ?printNameAsIs ~recStatus name decl =
   Printtyp.reset_names ();
   Res_doc.toString ~width:60
-    (Res_outcome_printer.printOutSigItemDoc
+    (Res_outcome_printer.printOutSigItemDoc ?printNameAsIs
        (Printtyp.tree_of_type_declaration (Ident.create name) decl recStatus))

analysis/src/Shared.ml

@@ -63,8 +63,8 @@ let findTypeConstructors (tel : Types.type_expr list) =
   tel |> List.iter loop;
   !paths |> List.rev
 
-let declToString ?(recStatus = Types.Trec_not) name t =
-  PrintType.printDecl ~recStatus name t
+let declToString ?printNameAsIs ?(recStatus = Types.Trec_not) name t =
+  PrintType.printDecl ?printNameAsIs ~recStatus name t
 
 let cacheTypeToString = ref false
 let typeTbl = Hashtbl.create 1
@@ -78,3 +78,5 @@ let typeToString ?lineWidth (t : Types.type_expr) =
     Hashtbl.replace typeTbl (t.id, t) s;
     s
   | Some s -> s
+
+let markdownSpacing = "\n```\n \n```\n"

analysis/src/SharedTypes.ml

@@ -315,6 +315,13 @@ type path = string list
 
 let pathToString (path : path) = path |> String.concat "."
 
+let rec pathIdentToString (p : Path.t) =
+  match p with
+  | Pident {name} -> name
+  | Pdot (nextPath, id, _) ->
+    Printf.sprintf "%s.%s" (pathIdentToString nextPath) id
+  | Papply _ -> ""
+
 type locKind =
   | LocalReference of int * Tip.t
   | GlobalReference of string * string list * Tip.t

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

@@ -1,3 +1,3 @@
 Hover src/Auto.res 2:13
-{"contents": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n```rescript\ntype t<'a> = list<'a>\n```\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n\n```\n \n```\n```rescript\ntype Belt.List.t<'a> = list<'a>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22belt_List.mli%22%2C34%2C0%5D)\n\n---\n\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n"}
 

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

@@ -5,13 +5,13 @@ Definition src/Definition.res 10:23
 {"uri": "Definition.res", "range": {"start": {"line": 6, "character": 7}, "end": {"line": 6, "character": 13}}}
 
 Hover src/Definition.res 14:14
-{"contents": "```rescript\n('a => 'b, list<'a>) => list<'b>\n```\n\n [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],\n   and builds the list [[f a1; ...; f an]]\n   with the results returned by [f].  Not tail-recursive. \n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\n('a => 'b, list<'a>) => list<'b>\n```\n\n [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],\n   and builds the list [[f a1; ...; f an]]\n   with the results returned by [f].  Not tail-recursive. "}
 
 Hover src/Definition.res 18:14
-{"contents": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n```rescript\ntype t<'a> = list<'a>\n```\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\n(Belt.List.t<'a>, 'a => 'b) => Belt.List.t<'b>\n```\n\n\n```\n \n```\n```rescript\ntype Belt.List.t<'a> = list<'a>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22belt_List.mli%22%2C34%2C0%5D)\n\n---\n\n\n\n  Returns a new list with `f` applied to each element of `someList`.\n\n  ```res example\n  list{1, 2}->Belt.List.map(x => x + 1) // list{3, 4}\n  ```\n"}
 
 Hover src/Definition.res 23:3
-{"contents": "```rescript\n(. int, int) => int\n```\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\n(. int, int) => int\n```"}
 
 Definition src/Definition.res 26:3
 {"uri": "Definition.res", "range": {"start": {"line": 21, "character": 4}, "end": {"line": 21, "character": 13}}}

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

@@ -1,6 +1,6 @@
 Hover src/Div.res 0:10
 getLocItem #3: heuristic for <div>
-{"contents": "```rescript\n(\n  string,\n  ~props: ReactDOMRe.domProps=?,\n  array<React.element>,\n) => React.element\n```\n\n```rescript\ntype domProps = ReactDOM.Props.domProps\n```\n\n```rescript\ntype element\n```\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\n(\n  string,\n  ~props: ReactDOMRe.domProps=?,\n  array<React.element>,\n) => React.element\n```\n\n\n```\n \n```\n```rescript\ntype ReactDOMRe.domProps = ReactDOM.Props.domProps\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22ReactDOMRe.res%22%2C57%2C2%5D)\n\n---\n\n\n\n```\n \n```\n```rescript\ntype React.element\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22React.res%22%2C0%2C0%5D)\n\n---\n"}
 
 Complete src/Div.res 3:17
 posCursor:[3:17] posNoWhite:[3:16] Found expr:[3:4->3:17]

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

@@ -1,12 +1,12 @@
 Hover src/DocComments.res 9:9
-{"contents": "```rescript\nint\n```\n\n  Doc comment with a triple-backquote example\\n  \\n  ```res example\\n    let a = 10\\n    /*\\n     * stuff\\n     */\\n  ```\\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\nint\n```\n\n  Doc comment with a triple-backquote example\\n  \\n  ```res example\\n    let a = 10\\n    /*\\n     * stuff\\n     */\\n  ```\\n"}
 
 Hover src/DocComments.res 22:6
-{"contents": "```rescript\nint\n```\n\n\n  Doc comment with a triple-backquote example\n  \n  ```res example\n    let a = 10\n    /*\n     * stuff\n     */\n  ```\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\nint\n```\n\n\n  Doc comment with a triple-backquote example\n  \n  ```res example\n    let a = 10\n    /*\n     * stuff\n     */\n  ```\n"}
 
 Hover src/DocComments.res 33:9
-{"contents": "```rescript\nint\n```\n\n  Doc comment with a triple-backquote example\\n  \\n  ```res example\\n    let a = 10\\n    let b = 20\\n  ```\\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\nint\n```\n\n  Doc comment with a triple-backquote example\\n  \\n  ```res example\\n    let a = 10\\n    let b = 20\\n  ```\\n"}
 
 Hover src/DocComments.res 44:6
-{"contents": "```rescript\nint\n```\n\n\n  Doc comment with a triple-backquote example\n  \n  ```res example\n    let a = 10\n    let b = 20\n  ```\n\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\nint\n```\n\n\n  Doc comment with a triple-backquote example\n  \n  ```res example\n    let a = 10\n    let b = 20\n  ```\n"}
 

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

@@ -1,7 +1,7 @@
 Hover src/Fragment.res 6:19
 getLocItem #4: heuristic for </Comp> within fragments: take make as makeProps does not work
 the type is not great but jump to definition works
-{"contents": "```rescript\nReact.component<{\"children\": React.element}>\n```\n\n```rescript\ntype component<'props> = componentLike<'props, element>\n```\n\n[SomeModule](command:rescript-vscode.go_to_location?%5B%22file%3A%2F%2Fwhatever%2Ffolder%2FSomeModule.res%22%2C0%2C0%2C0%2C0%5D)"}
+{"contents": "```rescript\nReact.component<{\"children\": React.element}>\n```\n\n\n```\n \n```\n```rescript\ntype React.component<'props> = componentLike<\n  'props,\n  element,\n>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22React.res%22%2C12%2C0%5D)\n\n---\n"}
 
 Hover src/Fragment.res 9:56
 Nothing at that position. Now trying to use completion.