Clickable links in hovers

CHANGELOG.md

@@ -17,6 +17,7 @@
 - Add support for prop completion for JSX V4 https://github.com/rescript-lang/rescript-vscode/pull/579
 - Add support for create interface file for JSX V4 https://github.com/rescript-lang/rescript-vscode/pull/580
 - Expand one level of type definition on hover. Dig into record/variant body. https://github.com/rescript-lang/rescript-vscode/pull/584
+- Add clickable links to type definitions in hovers. https://github.com/rescript-lang/rescript-vscode/pull/585
 
 #### :bug: Bug Fix
 

analysis/src/Cli.ml

@@ -7,7 +7,7 @@ API examples:
   ./rescript-editor-analysis.exe definition src/MyFile.res 9 3
   ./rescript-editor-analysis.exe typeDefinition src/MyFile.res 9 3
   ./rescript-editor-analysis.exe documentSymbol src/Foo.res
-  ./rescript-editor-analysis.exe hover src/MyFile.res 10 2
+  ./rescript-editor-analysis.exe hover src/MyFile.res 10 2 true
   ./rescript-editor-analysis.exe references src/MyFile.res 10 2
   ./rescript-editor-analysis.exe rename src/MyFile.res 10 2 foo
   ./rescript-editor-analysis.exe diagnosticSyntax src/MyFile.res
@@ -39,9 +39,9 @@ Options:
 
     ./rescript-editor-analysis.exe documentSymbol src/MyFile.res
 
-  hover: get inferred type for MyFile.res at line 10 column 2:
+  hover: get inferred type for MyFile.res at line 10 column 2 (supporting markdown links):
 
-    ./rescript-editor-analysis.exe hover src/MyFile.res 10 2
+    ./rescript-editor-analysis.exe hover src/MyFile.res 10 2 true
 
   references: get all references to item in MyFile.res at line 10 column 2:
 
@@ -95,10 +95,14 @@ let main () =
       ~pos:(int_of_string line, int_of_string col)
       ~debug:false
   | [_; "documentSymbol"; path] -> DocumentSymbol.command ~path
-  | [_; "hover"; path; line; col; currentFile] ->
+  | [_; "hover"; path; line; col; currentFile; supportsMarkdownLinks] ->
     Commands.hover ~path
       ~pos:(int_of_string line, int_of_string col)
       ~currentFile ~debug:false
+      ~supportsMarkdownLinks:
+        (match supportsMarkdownLinks with
+        | "true" -> true
+        | _ -> false)
   | [_; "inlayHint"; path; line_start; line_end; maxLength] ->
     Commands.inlayhint ~path
       ~pos:(int_of_string line_start, int_of_string line_end)

analysis/src/Commands.ml

@@ -36,7 +36,7 @@ let codeLens ~path ~debug =
   let result = Hint.codeLens ~path ~debug |> Protocol.array in
   print_endline result
 
-let hover ~path ~pos ~currentFile ~debug =
+let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks =
   let result =
     match Cmt.fullFromPath ~path with
     | None -> Protocol.null
@@ -81,7 +81,7 @@ let hover ~path ~pos ~currentFile ~debug =
         in
         if skipZero then Protocol.null
         else
-          let hoverText = Hover.newHover ~full locItem in
+          let hoverText = Hover.newHover ~supportsMarkdownLinks ~full locItem in
           match hoverText with
           | None -> Protocol.null
           | Some s -> Protocol.stringifyHover s))
@@ -341,7 +341,8 @@ let test ~path =
               ("Hover " ^ path ^ " " ^ string_of_int line ^ ":"
              ^ string_of_int col);
             let currentFile = createCurrentFile () in
-            hover ~path ~pos:(line, col) ~currentFile ~debug:true;
+            hover ~supportsMarkdownLinks:true ~path ~pos:(line, col)
+              ~currentFile ~debug:true;
             Sys.remove currentFile
           | "int" ->
             print_endline ("Create Interface " ^ path);

analysis/src/Hover.ml

@@ -2,6 +2,36 @@ open SharedTypes
 
 let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code
 
+let encodeURIComponent text =
+  let ln = String.length text in
+  let buf = Buffer.create ln in
+  let rec loop i =
+    if i < ln then (
+      (match text.[i] with
+      | '"' -> Buffer.add_string buf "%22"
+      | ':' -> Buffer.add_string buf "%3A"
+      | '/' -> Buffer.add_string buf "%2F"
+      | '\\' -> Buffer.add_string buf "%5C"
+      | ',' -> Buffer.add_string buf "%2C"
+      | '&' -> Buffer.add_string buf "%26"
+      | '[' -> Buffer.add_string buf "%5B"
+      | ']' -> Buffer.add_string buf "%5D"
+      | c -> Buffer.add_char buf c);
+      loop (i + 1))
+  in
+  loop 0;
+  Buffer.contents buf
+
+type link = {startPos: Protocol.position; file: string; label: string}
+
+let linkToCommandArgs link =
+  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
+    (encodeURIComponent (linkToCommandArgs link))
+
 let showModuleTopLevel ~docstring ~name (topLevel : Module.item list) =
   let contents =
     topLevel
@@ -36,7 +66,7 @@ let rec showModule ~docstring ~(file : File.t) ~name
   | Some {item = Ident path} ->
     Some ("Unable to resolve module reference " ^ Path.name path)
 
-let newHover ~full:{file; package} locItem =
+let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
   match locItem.locType with
   | TypeDefinition (name, decl, _stamp) ->
     let typeDef = Shared.declToString name decl in
@@ -101,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
@@ -142,7 +178,28 @@ 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
+                 let linkToTypeDefinitionStr =
+                   if supportsMarkdownLinks then
+                     "\nGo to: "
+                     ^ makeGotoCommand
+                         {
+                           label = "Type definition";
+                           file = Uri.toString env.file.uri;
+                           startPos = {line = startLine; character = startCol};
+                         }
+                   else ""
+                 in
+                 Some
+                   (Shared.markdownSpacing ^ codeBlock typString
+                  ^ linkToTypeDefinitionStr ^ "\n\n---\n"))
       in
       let typeString = typeString :: typeDefinitions |> String.concat "\n\n" in
       (typeString, docstring)

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"}
+{"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

@@ -8,7 +8,7 @@ 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. "}
 
 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"}
+{"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```"}

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```"}
+{"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/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```"}
+{"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.

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

@@ -75,10 +75,10 @@ Hover src/Hover.res 106:21
 {"contents": "```rescript\nint\n```"}
 
 Hover src/Hover.res 116:16
-{"contents": "```rescript\nAA.cond<[< #str(string)]> => AA.cond<[< #str(string)]>\n```\n\n```rescript\ntype cond<'a> = 'a\n  constraint 'a = [< #str(string)]\n```"}
+{"contents": "```rescript\nAA.cond<[< #str(string)]> => AA.cond<[< #str(string)]>\n```\n\n\n```\n \n```\n```rescript\ntype AA.cond<'a> = 'a\n  constraint 'a = [< #str(string)]\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C110%2C2%5D)\n\n---\n"}
 
 Hover src/Hover.res 119:25
-{"contents": "```rescript\nAA.cond<[< #str(string)]> => AA.cond<[< #str(string)]>\n```\n\n```rescript\ntype cond<'a> = 'a\n  constraint 'a = [< #str(string)]\n```"}
+{"contents": "```rescript\nAA.cond<[< #str(string)]> => AA.cond<[< #str(string)]>\n```\n\n\n```\n \n```\n```rescript\ntype AA.cond<'a> = 'a\n  constraint 'a = [< #str(string)]\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C110%2C2%5D)\n\n---\n"}
 
 Hover src/Hover.res 122:3
 Nothing at that position. Now trying to use completion.
@@ -105,10 +105,10 @@ Hover src/Hover.res 148:6
 {"contents": "```rescript\nint\n```\n\n doc comment 2 "}
 
 Hover src/Hover.res 165:23
-{"contents": "```rescript\nfoo<bar>\n```\n\n```rescript\ntype foo<'a> = {content: 'a, zzz: string}\n```\n\n```rescript\ntype bar = {age: int}\n```"}
+{"contents": "```rescript\nfoo<bar>\n```\n\n\n```\n \n```\n```rescript\ntype foo<'a> = {content: 'a, zzz: string}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C161%2C2%5D)\n\n---\n\n\n\n```\n \n```\n```rescript\ntype bar = {age: int}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C162%2C2%5D)\n\n---\n"}
 
 Hover src/Hover.res 167:22
-{"contents": "```rescript\nfoobar\n```\n\n```rescript\ntype foobar = foo<bar>\n```"}
+{"contents": "```rescript\nfoobar\n```\n\n\n```\n \n```\n```rescript\ntype foobar = foo<bar>\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C163%2C2%5D)\n\n---\n"}
 
 Complete src/Hover.res 170:16
 posCursor:[170:16] posNoWhite:[170:15] Found expr:[170:5->170:16]
@@ -159,8 +159,8 @@ Completable: Cpath Value[y2].content.""
   }]
 
 Hover src/Hover.res 197:4
-{"contents": "```rescript\nCompV4.props<int, string> => React.element\n```\n\n```rescript\ntype props<'n, 's> = {?n: 'n, s: 's}\n```\n\n```rescript\ntype element\n```"}
+{"contents": "```rescript\nCompV4.props<int, string> => React.element\n```\n\n\n```\n \n```\n```rescript\ntype CompV4.props<'n, 's> = {?n: 'n, s: 's}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C190%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"}
 
 Hover src/Hover.res 202:16
-{"contents": "```rescript\nuseR\n```\n\n```rescript\ntype useR = {x: int, y: list<option<r<float>>>}\n```\n\n```rescript\ntype r<'a> = {i: 'a, f: float}\n```"}
+{"contents": "```rescript\nuseR\n```\n\n\n```\n \n```\n```rescript\ntype useR = {x: int, y: list<option<r<float>>>}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C200%2C0%5D)\n\n---\n\n\n\n```\n \n```\n```rescript\ntype r<'a> = {i: 'a, f: float}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C101%2C0%5D)\n\n---\n"}
 

analysis/vendor/res_outcome_printer/res_outcome_printer.ml

@@ -563,7 +563,7 @@ let printTypeParameterDoc (typ, (co, cn)) =
       (if typ = "_" then Doc.text "_" else Doc.text ("'" ^ typ));
     ]
 
-let rec printOutSigItemDoc (outSigItem : Outcometree.out_sig_item) =
+let rec printOutSigItemDoc ?(printNameAsIs=false) (outSigItem : Outcometree.out_sig_item)  =
   match outSigItem with
   | Osig_class _ | Osig_class_type _ -> Doc.nil
   | Osig_ellipsis -> Doc.dotdotdot
@@ -728,7 +728,7 @@ let rec printOutSigItemDoc (outSigItem : Outcometree.out_sig_item) =
                 [
                   attrs;
                   kw;
-                  printIdentLike ~allowUident:false outTypeDecl.otype_name;
+                  if printNameAsIs then  Doc.text outTypeDecl.otype_name else printIdentLike ~allowUident:false outTypeDecl.otype_name;
                   typeParams;
                   kind;
                 ]);

analysis/vendor/res_outcome_printer/res_outcome_printer.mli

@@ -13,4 +13,4 @@ val setup : unit lazy_t [@@live]
 
 (* Needed for e.g. the playground to print typedtree data *)
 val printOutTypeDoc : Outcometree.out_type -> Res_doc.t [@@live]
-val printOutSigItemDoc : Outcometree.out_sig_item -> Res_doc.t [@@live]
+val printOutSigItemDoc : ?printNameAsIs: bool -> Outcometree.out_sig_item -> Res_doc.t [@@live]

client/src/extension.ts

@@ -6,6 +6,9 @@ import {
   languages,
   window,
   StatusBarAlignment,
+  Uri,
+  Range,
+  Position,
 } from "vscode";
 
 import {
@@ -103,8 +106,17 @@ export function activate(context: ExtensionContext) {
       // We'll leave it like this for now, but might be worth revisiting later on.
       initializationOptions: {
         extensionConfiguration: workspace.getConfiguration("rescript.settings"),
+
+        // Keep this in sync with the `extensionClientCapabilities` type in the
+        // server.
+        extensionClientCapabilities: {
+          supportsMarkdownLinks: true,
+        },
       },
       outputChannel,
+      markdown: {
+        isTrusted: true,
+      },
     };
 
     const client = new LanguageClient(
@@ -189,6 +201,18 @@ export function activate(context: ExtensionContext) {
     customCommands.openCompiled(client);
   });
 
+  commands.registerCommand(
+    "rescript-vscode.go_to_location",
+    async (fileUri: string, startLine: number, startCol: number) => {
+      await window.showTextDocument(Uri.parse(fileUri), {
+        selection: new Range(
+          new Position(startLine, startCol),
+          new Position(startLine, startCol)
+        ),
+      });
+    }
+  );
+
   // Starts the code analysis mode.
   commands.registerCommand("rescript-vscode.start_code_analysis", () => {
     // Save the directory this first ran from, and re-use that when continuously

server/src/server.ts

@@ -35,6 +35,14 @@ interface extensionConfiguration {
   binaryPath: string | null;
 }
 
+// This holds client capabilities specific to our extension, and not necessarily
+// related to the LS protocol. It's for enabling/disabling features that might
+// work in one client, like VSCode, but perhaps not in others, like vim.
+export interface extensionClientCapabilities {
+  supportsMarkdownLinks?: boolean | null;
+}
+let extensionClientCapabilities: extensionClientCapabilities = {};
+
 // All values here are temporary, and will be overridden as the server is
 // initialized, and the current config is received from the client.
 let extensionConfiguration: extensionConfiguration = {
@@ -436,6 +444,7 @@ function hover(msg: p.RequestMessage) {
       params.position.line,
       params.position.character,
       tmpname,
+      Boolean(extensionClientCapabilities.supportsMarkdownLinks),
     ],
     msg
   );
@@ -1070,6 +1079,16 @@ function onMessage(msg: p.Message) {
         extensionConfiguration = initialConfiguration;
       }
 
+      // These are static configuration options the client can set to enable certain
+      let extensionClientCapabilitiesFromClient = initParams
+        .initializationOptions?.extensionClientCapabilities as
+        | extensionClientCapabilities
+        | undefined;
+
+      if (extensionClientCapabilitiesFromClient != null) {
+        extensionClientCapabilities = extensionClientCapabilitiesFromClient;
+      }
+
       // send the list of features we support
       let result: p.InitializeResult = {
         // This tells the client: "hey, we support the following operations".