Jump Custom Request

CHANGES.md

@@ -1,5 +1,7 @@
 # Unreleased
 
+- Add custom [`ocamllsp/merlinJump`](/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md) request (#1374)
+
 ## Fixes
 
 - Fix fd leak in running external processes for preprocessing (#1349)
@@ -10,6 +12,7 @@
 
 - Add custom [`ocamllsp/getDocumentation`](/ocaml-lsp-server/docs/ocamllsp/getDocumentation-spec.md) request (#1336)
 
+
 - Add support for OCaml 5.2 (#1233)
 
 ## Fixes

ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md

@@ -0,0 +1,43 @@
+# Merlin Jump Request
+
+## Description
+
+This custom request allows Merlin-type code navigation in a source buffer.
+
+## Server capability
+
+- propert name: `handleMerlinJump`
+- property type: `boolean`
+
+## Request
+
+```js
+export interface JumpParams extends TextDocumentPositionParams
+{
+    target: string;
+}
+```
+
+- method: `ocamllsp/merlinJump`
+- params:
+    - `TextDocumentIdentifier`: Specifies the document for which the request is sent. It includes a uri property that points to the document.
+    - `Position`: Specifies the position in the document for which the documentation is requested. It includes line and character properties.
+    More details can be found in the [TextDocumentPositionParams - LSP Specification](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentPositionParams).
+    - `Target`: A string representing the identifier within the document to search for and jump to.
+                The target can be any of `fun`, `let`, `module`, `module-type`, `match`, `match-next-case`, `match-prev-case`.
+
+## Response
+
+```js
+result: Jump | String
+export interface Jump extends TextDocumentPositionParams {
+}
+```
+
+- result:
+    - Type: Jump or string
+    - Description: If the jump is successful, a position and document path is returned. If no relevant jump location is found, the result will be a string "no matching target" or an error message.
+    - Jump:
+        - Type: TextDocumentPositionParams
+            - `Position`: The position to jump to
+            - `TextDocumentIdentifier`: the document path which contains this position (ideally the same document as the request)

ocaml-lsp-server/src/custom_requests/custom_request.ml

@@ -6,3 +6,4 @@ module Typed_holes = Req_typed_holes
 module Type_enclosing = Req_type_enclosing
 module Wrapping_ast_node = Req_wrapping_ast_node
 module Get_documentation = Req_get_documentation
+module Merlin_jump = Req_merlin_jump

ocaml-lsp-server/src/custom_requests/custom_request.mli

@@ -8,3 +8,4 @@ module Typed_holes = Req_typed_holes
 module Type_enclosing = Req_type_enclosing
 module Wrapping_ast_node = Req_wrapping_ast_node
 module Get_documentation = Req_get_documentation
+module Merlin_jump = Req_merlin_jump

ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml

@@ -0,0 +1,77 @@
+open Import
+module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams
+
+let meth = "ocamllsp/jump"
+let capability = "handleJump", `Bool true
+
+module JumpParams = struct
+  type t =
+    { text_document : TextDocumentIdentifier.t
+    ; position : Position.t
+    ; target : string
+    }
+
+  let t_of_yojson json =
+    let open Yojson.Safe.Util in
+    let textDocumentPosition = TextDocumentPositionParams.t_of_yojson json in
+    let target = json |> member "target" |> to_string in
+    { position = textDocumentPosition.position
+    ; text_document = textDocumentPosition.textDocument
+    ; target
+    }
+  ;;
+
+  let yojson_of_t { text_document; position; target } =
+    `Assoc
+      [ "textDocument", TextDocumentIdentifier.yojson_of_t text_document
+      ; "position", Position.yojson_of_t position
+      ; "target", `String target
+      ]
+  ;;
+end
+
+module Jump = struct
+  type t = Lsp.Types.TextDocumentPositionParams.t
+
+  let yojson_of_t t = TextDocumentPositionParams.yojson_of_t t
+end
+
+type t = Jump.t
+
+module Request_params = struct
+  type t = JumpParams.t
+
+  let yojson_of_t t = JumpParams.yojson_of_t t
+  let create ~text_document ~position ~target () : t = { text_document; position; target }
+end
+
+let dispatch ~merlin ~position ~target =
+  Document.Merlin.with_pipeline_exn merlin (fun pipeline ->
+    let pposition = Position.logical position in
+    let query = Query_protocol.Jump (target, pposition) in
+    Query_commands.dispatch pipeline query)
+;;
+
+let on_request ~params state =
+  Fiber.of_thunk (fun () ->
+    let params = (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) in
+    let JumpParams.{ text_document; position; target } = JumpParams.t_of_yojson params in
+    let uri = text_document.uri in
+    let doc = Document_store.get state.State.store uri in
+    match Document.kind doc with
+    | `Other -> Fiber.return `Null
+    | `Merlin merlin ->
+      Fiber.map (dispatch ~merlin ~position ~target) ~f:(fun res ->
+        match res with
+        | `Error err -> `String err
+        | `Found pos ->
+          (match Position.of_lexical_position pos with
+           | None -> `Null
+           | Some position ->
+             let loc =
+               Lsp.Types.TextDocumentPositionParams.create
+                 ~position
+                 ~textDocument:(TextDocumentIdentifier.create ~uri)
+             in
+             Jump.yojson_of_t loc)))
+;;

ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli

@@ -0,0 +1,20 @@
+open Import
+
+module Request_params : sig
+  type t
+
+  val yojson_of_t : t -> Json.t
+
+  val create
+    :  text_document:TextDocumentIdentifier.t
+    -> position:Position.t
+    -> target:string
+    -> unit
+    -> t
+end
+
+type t
+
+val meth : string
+val capability : string * [> `Bool of bool ]
+val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -537,6 +537,7 @@ let on_request
        ; Req_merlin_call_compatible.meth, Req_merlin_call_compatible.on_request
        ; Req_type_enclosing.meth, Req_type_enclosing.on_request
        ; Req_get_documentation.meth, Req_get_documentation.on_request
+       ; Req_merlin_jump.meth, Req_merlin_jump.on_request
        ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request
        ; ( Semantic_highlighting.Debug.meth_request_full
          , Semantic_highlighting.Debug.on_request_full )

ocaml-lsp-server/test/e2e-new/dune

@@ -62,6 +62,7 @@
     test
     type_enclosing
     documentation
+    merlin_jump
     with_pp
     with_ppx
     workspace_change_config))))

ocaml-lsp-server/test/e2e-new/merlin_jump.ml

@@ -0,0 +1,94 @@
+open Test.Import
+module Req = Ocaml_lsp_server.Custom_request.Merlin_jump
+
+module Util = struct
+  let call_jump position target client =
+    let uri = DocumentUri.of_path "test.ml" in
+    let text_document = TextDocumentIdentifier.create ~uri in
+    let params =
+      Req.Request_params.create ~text_document ~position ~target ()
+      |> Req.Request_params.yojson_of_t
+      |> Jsonrpc.Structured.t_of_yojson
+      |> Option.some
+    in
+    let req = Lsp.Client_request.UnknownRequest { meth = "ocamllsp/jump"; params } in
+    Client.request client req
+  ;;
+
+  let test ~line ~character ~target ~source =
+    let position = Position.create ~character ~line in
+    let request client =
+      let open Fiber.O in
+      let+ response = call_jump position target client in
+      Test.print_result response
+    in
+    Helpers.test source request
+  ;;
+end
+
+let%expect_test "Get location of the next match case" =
+  let source =
+    {|
+let find_vowel x =
+match x with
+| 'A' -> true
+| 'E' -> true
+| 'I' -> true
+| 'O' -> true
+| 'U' -> true
+| _ -> false
+|}
+  in
+  let line = 3 in
+  let character = 2 in
+  let target = "match-next-case" in
+  Util.test ~line ~character ~target ~source;
+  [%expect
+    {|
+  {
+    "position": { "character": 2, "line": 4 },
+    "textDocument": { "uri": "file:///test.ml" }
+  } |}]
+;;
+
+let%expect_test "Get location of a the module" =
+  let source =
+    {|type a = Foo | Bar
+
+module A = struct
+  let f () = 10
+  let g = Bar
+  let h x = x
+
+  module B = struct
+    type b = Baz
+
+    let x = (Baz, 10)
+    let y = (Bar, Foo)
+  end
+
+  type t = { a : string; b : float }
+
+  let z = { a = "Hello"; b = 1.0 }
+end|}
+  in
+  let line = 10 in
+  let character = 3 in
+  let target = "module" in
+  Util.test ~line ~character ~target ~source;
+  [%expect
+    {|
+  {
+    "position": { "character": 2, "line": 7 },
+    "textDocument": { "uri": "file:///test.ml" }
+  } |}]
+;;
+
+let%expect_test "Same line should output no locations" =
+  let source = {|let x = 5 |} in
+  let line = 1 in
+  let character = 5 in
+  let target = "let" in
+  Util.test ~line ~character ~target ~source;
+  [%expect {| "No matching target" |}]
+;;