Update Jump functionality

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

@@ -2,7 +2,7 @@
 
 ## Description
 
-This custom request allows Merlin-type code navigation in a source buffer.
+This custom request allows Merlin-type code navigation in a source buffer. It will fetch all the possible jump targets and return them.
 
 ## Server capability
 
@@ -12,20 +12,7 @@ This custom request allows Merlin-type code navigation in a source buffer.
 ## Request
 
 - method: `ocamllsp/jump`
-- params: `JumpParams`  extends [TextDocumentPositionParams](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentPositionParams) and is defined as follows:
-
-```js
-export interface JumpParams extends TextDocumentPositionParams
-{
-    /**
-     * The requested target of the jump, one of `fun`, `let`, `module`,
-     * `module-type`, `match`, `match-next-case`, `match-prev-case`.
-     *
-     * If omitted, all valid targets will be considered.
-     */
-    target?: string;
-}
-```
+- params: [TextDocumentPositionParams](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocumentPositionParams)
 
 ## Response
 

ocaml-lsp-server/src/code_actions/action_jump.ml

@@ -4,10 +4,6 @@ open Stdune
 
 let command_name = "ocamllsp/merlin-jump-to-target"
 
-let targets =
-  [ "fun"; "match"; "let"; "module"; "module-type"; "match-next-case"; "match-prev-case" ]
-;;
-
 let rename_target target =
   if String.starts_with ~prefix:"match-" target
   then String.sub target ~pos:6 ~len:(String.length target - 6)
@@ -49,16 +45,11 @@ let command_run server (params : ExecuteCommandParams.t) =
 ;;
 
 (* Dispatch the jump request to Merlin and get the result *)
-let process_jump_request ~merlin ~position ~target =
-  let+ results =
-    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)
-  in
-  match results with
-  | `Error _ -> None
-  | `Found pos -> Some pos
+let get_all_possible_jump_targets ~merlin ~position =
+  Document.Merlin.with_pipeline_exn merlin (fun pipeline ->
+    let position = Mpipeline.get_lexing_pos pipeline position in
+    let typedtree = Mpipeline.typer_result pipeline |> Mtyper.get_typedtree in
+    Merlin_analysis.Jump.get_all typedtree position)
 ;;
 
 let code_actions
@@ -68,26 +59,22 @@ let code_actions
   =
   match Document.kind doc with
   | `Merlin merlin when available capabilities ->
-    let+ actions =
-      (* TODO: Merlin Jump command that returns all available jump locations for a source code buffer. *)
-      Fiber.parallel_map targets ~f:(fun target ->
-        let+ res = process_jump_request ~merlin ~position:params.range.start ~target in
-        let open Option.O in
-        let* lexing_pos = res in
-        let+ position = Position.of_lexical_position lexing_pos in
-        let uri = Document.uri doc in
-        let range = { Range.start = position; end_ = position } in
-        let title = sprintf "%s jump" (String.capitalize_ascii (rename_target target)) in
-        let command =
-          let arguments = [ DocumentUri.yojson_of_t uri; Range.yojson_of_t range ] in
-          Command.create ~title ~command:command_name ~arguments ()
-        in
-        CodeAction.create
-          ~title
-          ~kind:(CodeActionKind.Other (sprintf "merlin-jump-%s" (rename_target target)))
-          ~command
-          ())
-    in
-    List.filter_opt actions
+    let position = Position.logical params.range.start in
+    let+ res = get_all_possible_jump_targets ~merlin ~position in
+    List.filter_map res ~f:(fun (target, lexing_pos) ->
+      let open Option.O in
+      let+ position = Position.of_lexical_position lexing_pos in
+      let uri = Document.uri doc in
+      let range = { Range.start = position; end_ = position } in
+      let title = sprintf "%s jump" (String.capitalize_ascii (rename_target target)) in
+      let command =
+        let arguments = [ DocumentUri.yojson_of_t uri; Range.yojson_of_t range ] in
+        Command.create ~title ~command:command_name ~arguments ()
+      in
+      CodeAction.create
+        ~title
+        ~kind:(CodeActionKind.Other (sprintf "merlin-jump-%s" (rename_target target)))
+        ~command
+        ())
   | _ -> Fiber.return []
 ;;

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

@@ -4,43 +4,6 @@ module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams
 let meth = "ocamllsp/jump"
 let capability = "handleJump", `Bool true
 
-module JumpParams = struct
-  let targets =
-    [ "fun"
-    ; "match"
-    ; "let"
-    ; "module"
-    ; "module-type"
-    ; "match-next-case"
-    ; "match-prev-case"
-    ]
-  ;;
-
-  type t =
-    { textDocument : TextDocumentIdentifier.t
-    ; position : Position.t
-    ; target : string option
-    }
-
-  let t_of_yojson json =
-    let open Yojson.Safe.Util in
-    { textDocument = json |> member "textDocument" |> TextDocumentIdentifier.t_of_yojson
-    ; position = json |> member "position" |> Position.t_of_yojson
-    ; target = json |> member "target" |> to_string_option
-    }
-  ;;
-
-  let yojson_of_t { textDocument; position; target } =
-    let target =
-      Option.value_map target ~default:[] ~f:(fun v -> [ "target", `String v ])
-    in
-    `Assoc
-      (("textDocument", TextDocumentIdentifier.yojson_of_t textDocument)
-       :: ("position", Position.yojson_of_t position)
-       :: target)
-  ;;
-end
-
 module Jump = struct
   type t = (string * Position.t) list
 
@@ -58,47 +21,37 @@ end
 type t = Jump.t
 
 module Request_params = struct
-  type t = JumpParams.t
+  type t = TextDocumentPositionParams.t
 
-  let yojson_of_t t = JumpParams.yojson_of_t t
+  let yojson_of_t t = TextDocumentPositionParams.yojson_of_t t
 
-  let create ~uri ~position ~target =
-    { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position; target }
+  let create ~uri ~position =
+    TextDocumentPositionParams.create
+      ~position
+      ~textDocument:(TextDocumentIdentifier.create ~uri)
   ;;
 end
 
-let dispatch ~merlin ~position ~target =
+let dispatch ~merlin ~position =
   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 position = Mpipeline.get_lexing_pos pipeline position in
+    let typedtree = Mpipeline.typer_result pipeline |> Mtyper.get_typedtree in
+    Merlin_analysis.Jump.get_all typedtree position)
 ;;
 
 let on_request ~params state =
   let open Fiber.O in
   Fiber.of_thunk (fun () ->
     let params = (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) in
-    let params = JumpParams.t_of_yojson params in
+    let params = TextDocumentPositionParams.t_of_yojson params in
     let uri = params.textDocument.uri in
-    let position = params.position in
+    let position = Position.logical params.position in
     let doc = Document_store.get state.State.store uri in
     match Document.kind doc with
     | `Other -> Fiber.return `Null
     | `Merlin merlin ->
-      let targets =
-        match params.target with
-        | None -> JumpParams.targets
-        | Some target -> [ target ]
-      in
-      let+ results =
-        Fiber.parallel_map targets ~f:(fun target ->
-          dispatch ~merlin ~position ~target
-          |> Fiber.map ~f:(function
-            | `Error _ -> None
-            | `Found pos ->
-              (match Position.of_lexical_position pos with
-               | None -> None
-               | Some position -> Some (target, position))))
-      in
-      Jump.yojson_of_t (List.filter_map results ~f:Fun.id))
+      let+ res = dispatch ~merlin ~position in
+      Jump.yojson_of_t
+        (List.filter_map res ~f:(fun (target, position) ->
+           Option.map ~f:(fun pos -> target, pos) (Position.of_lexical_position position))))
 ;;

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

@@ -4,7 +4,7 @@ module Request_params : sig
   type t
 
   val yojson_of_t : t -> Json.t
-  val create : uri:DocumentUri.t -> position:Position.t -> target:string option -> t
+  val create : uri:DocumentUri.t -> position:Position.t -> t
 end
 
 type t

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

@@ -2,10 +2,10 @@ open Test.Import
 module Req = Ocaml_lsp_server.Custom_request.Merlin_jump
 
 module Util = struct
-  let call_jump position ?target client =
+  let call_jump position client =
     let uri = DocumentUri.of_path "test.ml" in
     let params =
-      Req.Request_params.create ~uri ~position ~target
+      Req.Request_params.create ~uri ~position
       |> Req.Request_params.yojson_of_t
       |> Jsonrpc.Structured.t_of_yojson
       |> Option.some
@@ -14,11 +14,11 @@ module Util = struct
     Client.request client req
   ;;
 
-  let test ~line ~character ~source ?target () =
+  let test ~line ~character ~source () =
     let position = Position.create ~character ~line in
     let request client =
       let open Fiber.O in
-      let+ response = call_jump position client ?target in
+      let+ response = call_jump position client in
       Test.print_result response
     in
     Helpers.test source request
@@ -43,17 +43,18 @@ match x with
   Util.test ~line ~character ~source ();
   [%expect
     {|
-  {
-    "jumps": [
-      { "target": "fun", "position": { "character": 0, "line": 1 } },
-      { "target": "match", "position": { "character": 0, "line": 2 } },
-      { "target": "let", "position": { "character": 0, "line": 1 } },
-      {
-        "target": "match-next-case",
-        "position": { "character": 2, "line": 4 }
-      }
-    ]
-  } |}]
+    {
+      "jumps": [
+        { "target": "fun", "position": { "character": 0, "line": 1 } },
+        { "target": "let", "position": { "character": 0, "line": 1 } },
+        { "target": "match", "position": { "character": 0, "line": 2 } },
+        {
+          "target": "match-next-case",
+          "position": { "character": 2, "line": 4 }
+        }
+      ]
+    }
+    |}]
 ;;
 
 let%expect_test "Get location of the next match case" =
@@ -71,11 +72,14 @@ match x with
   in
   let line = 3 in
   let character = 2 in
-  Util.test ~line ~character ~source ~target:"match-next-case" ();
+  Util.test ~line ~character ~source ();
   [%expect
     {|
     {
       "jumps": [
+        { "target": "fun", "position": { "character": 0, "line": 1 } },
+        { "target": "let", "position": { "character": 0, "line": 1 } },
+        { "target": "match", "position": { "character": 0, "line": 2 } },
         {
           "target": "match-next-case",
           "position": { "character": 2, "line": 4 }
@@ -134,6 +138,6 @@ let find_vowel x = ()
   in
   let line = 1 in
   let character = 2 in
-  Util.test ~line ~character ~source ~target:"notatarget" ();
+  Util.test ~line ~character ~source ();
   [%expect {| { "jumps": [] } |}]
 ;;