Allows client to request a specific target. If not, all possible targets locations are returned.

Author: voodoos

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

@@ -19,42 +19,39 @@ module JumpParams = struct
   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 } =
+  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
-      ]
+      (("textDocument", TextDocumentIdentifier.yojson_of_t textDocument)
+       :: ("position", Position.yojson_of_t position)
+       :: target)
   ;;
 end
 
 module Jump = struct
   type t = (string * Position.t) list
 
-  let yojson_of_t (lst : t) : Yojson.Safe.t option =
-    if List.is_empty lst
-    then None
-    else
-      Some
-        (`Assoc
-          [ ( "jumps"
-            , `List
-                (List.map
-                   ~f:(fun (target, position) ->
-                     `Assoc
-                       [ "target", `String target
-                       ; "position", Position.yojson_of_t position
-                       ])
-                   lst) )
-          ])
+  let yojson_of_t (lst : t) : Yojson.Safe.t =
+    let jumps =
+      List.map
+        ~f:(fun (target, position) ->
+          `Assoc [ "target", `String target; "position", Position.yojson_of_t position ])
+        lst
+    in
+    `Assoc [ "jumps", `List jumps ]
   ;;
 end
 
@@ -65,8 +62,8 @@ module Request_params = struct
 
   let yojson_of_t t = JumpParams.yojson_of_t t
 
-  let create ~uri ~position =
-    { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position }
+  let create ~uri ~position ~target =
+    { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position; target }
   ;;
 end
 
@@ -78,27 +75,30 @@ let dispatch ~merlin ~position ~target =
 ;;
 
 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 uri = params.textDocument.uri in
     let position = params.position in
     let doc = Document_store.get state.State.store uri in
-    let targets = JumpParams.targets in
     match Document.kind doc with
     | `Other -> Fiber.return `Null
     | `Merlin merlin ->
-      Fiber.map
-        (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)))))
-        ~f:(fun results ->
-          match List.filter_map results ~f:Fun.id with
-          | [] -> `Null
-          | lst -> Jump.yojson_of_t lst |> Option.value ~default:`Null))
+      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))
 ;;

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 -> t
+  val create : uri:DocumentUri.t -> position:Position.t -> target:string option -> 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 client =
+  let call_jump position ?target client =
     let uri = DocumentUri.of_path "test.ml" in
     let params =
-      Req.Request_params.create ~uri ~position
+      Req.Request_params.create ~uri ~position ~target
       |> Req.Request_params.yojson_of_t
       |> Jsonrpc.Structured.t_of_yojson
       |> Option.some
@@ -14,18 +14,18 @@ module Util = struct
     Client.request client req
   ;;
 
-  let test ~line ~character ~source =
+  let test ~line ~character ~source ?target () =
     let position = Position.create ~character ~line in
     let request client =
       let open Fiber.O in
-      let+ response = call_jump position client in
+      let+ response = call_jump position client ?target in
       Test.print_result response
     in
     Helpers.test source request
   ;;
 end
 
-let%expect_test "Get location of the next match case" =
+let%expect_test "Get all jumps including the next match case" =
   let source =
     {|
 let find_vowel x =
@@ -40,7 +40,7 @@ match x with
   in
   let line = 3 in
   let character = 2 in
-  Util.test ~line ~character ~source;
+  Util.test ~line ~character ~source ();
   [%expect
     {|
   {
@@ -56,6 +56,35 @@ match x with
   } |}]
 ;;
 
+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
+  Util.test ~line ~character ~source ~target:"match-next-case" ();
+  [%expect
+    {|
+    {
+      "jumps": [
+        {
+          "target": "match-next-case",
+          "position": { "character": 2, "line": 4 }
+        }
+      ]
+    }
+    |}]
+;;
+
 let%expect_test "Get location of a the module" =
   let source =
     {|type a = Foo | Bar
@@ -79,8 +108,9 @@ end|}
   in
   let line = 10 in
   let character = 3 in
-  Util.test ~line ~character ~source;
-  [%expect {|
+  Util.test ~line ~character ~source ();
+  [%expect
+    {|
   {
     "jumps": [
       { "target": "module", "position": { "character": 2, "line": 7 } }
@@ -92,6 +122,17 @@ let%expect_test "Same line should output no locations" =
   let source = {|let x = 5 |} in
   let line = 1 in
   let character = 5 in
-  Util.test ~line ~character ~source;
-  [%expect {| null |}]
+  Util.test ~line ~character ~source ();
+  [%expect {| { "jumps": [] } |}]
+;;
+
+let%expect_test "Ask for a non-existing target" =
+  let source = {|
+let find_vowel x = ()
+|} in
+  let line = 1 in
+  let character = 2 in
+  Util.test ~line ~character ~source ~target:"notatarget" ();
+  [%expect
+    {| { "jumps": [] } |}]
 ;;