gate link to definition behind flag, to gracefully degrade for clients that cannot handle markdown links

Author: zth

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

@@ -66,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
@@ -186,16 +186,20 @@ let newHover ~full:{file; package} locItem =
                | 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 ^ "\n"
-                  ^ "Go to: "
-                   ^ makeGotoCommand
-                       {
-                         label = "Type definition";
-                         file = Uri.toString env.file.uri;
-                         startPos = {line = startLine; character = startCol};
-                       }
-                   ^ "\n\n---\n"))
+                   (Shared.markdownSpacing ^ codeBlock typString
+                  ^ linkToTypeDefinitionStr ^ "\n\n---\n"))
       in
       let typeString = typeString :: typeDefinitions |> String.concat "\n\n" in
       (typeString, docstring)

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\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"}
+{"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  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\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"}
+{"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  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\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"}
+{"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```rescript\ntype React.element\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22React.res%22%2C0%2C0%5D)"}
 
 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\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"}
+{"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)"}
 
 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\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"}
+{"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)"}
 
 Hover src/Hover.res 119:25
-{"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"}
+{"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)"}
 
 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\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"}
+{"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```rescript\ntype bar = {age: int}\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22Hover.res%22%2C162%2C2%5D)"}
 
 Hover src/Hover.res 167:22
-{"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"}
+{"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)"}
 
 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\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"}
+{"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```rescript\ntype React.element\n```\nGo to: [Type definition](command:rescript-vscode.go_to_location?%5B%22React.res%22%2C0%2C0%5D)"}
 
 Hover src/Hover.res 202:16
-{"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"}
+{"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```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)"}
 

client/src/extension.ts

@@ -106,6 +106,12 @@ 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: {

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".