diff --git a/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md b/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md index d92b30821..33e5476f6 100644 --- a/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md +++ b/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 diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml index 19e4cdf29..7005e05ac 100644 --- a/ocaml-lsp-server/src/code_actions/action_jump.ml +++ b/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 [] ;; diff --git a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml index 1c84f81e7..ea79329b8 100644 --- a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml +++ b/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)))) ;; diff --git a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli index 95a9002d3..485dc2335 100644 --- a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli +++ b/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 diff --git a/ocaml-lsp-server/test/e2e-new/merlin_jump.ml b/ocaml-lsp-server/test/e2e-new/merlin_jump.ml index 809dae049..2022bacd7 100644 --- a/ocaml-lsp-server/test/e2e-new/merlin_jump.ml +++ b/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": [] } |}] ;;