From 004625727bc909487152c6b00f0bd39606314a80 Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 04:58:29 +0100 Subject: [PATCH 1/7] get all targets at once --- .../src/code_actions/action_jump.ml | 62 +++++++++---------- 1 file changed, 28 insertions(+), 34 deletions(-) diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml index 19e4cdf29..73beb1988 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,10 @@ 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 typedtree = Mpipeline.typer_result pipeline |> Mtyper.get_typedtree in + Merlin_analysis.Jump.get_all typedtree position) ;; let code_actions @@ -68,26 +58,30 @@ 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 - ()) + let uri = Document.uri doc in + let { Position.line; character } = params.range.start in + let position = + { Lexing.pos_fname = DocumentUri.to_string uri + ; pos_lnum = line + ; pos_cnum = character + ; pos_bol = 0 + } in - List.filter_opt actions + 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 [] ;; From 4042c447a8408b598a43c0170294c4efd9b83b43 Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 05:48:38 +0100 Subject: [PATCH 2/7] refactor --- ocaml-lsp-server/src/code_actions/action_jump.ml | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml index 73beb1988..7005e05ac 100644 --- a/ocaml-lsp-server/src/code_actions/action_jump.ml +++ b/ocaml-lsp-server/src/code_actions/action_jump.ml @@ -47,6 +47,7 @@ let command_run server (params : ExecuteCommandParams.t) = (* Dispatch the jump request to Merlin and get the result *) 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) ;; @@ -58,15 +59,7 @@ let code_actions = match Document.kind doc with | `Merlin merlin when available capabilities -> - let uri = Document.uri doc in - let { Position.line; character } = params.range.start in - let position = - { Lexing.pos_fname = DocumentUri.to_string uri - ; pos_lnum = line - ; pos_cnum = character - ; pos_bol = 0 - } - in + 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 From 0b4561667d82763b0d0e0e7ef99819b0ad94bc3f Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 06:13:21 +0100 Subject: [PATCH 3/7] refactor to use get_all to fetch all targets --- .../src/custom_requests/req_merlin_jump.ml | 60 ++++++------------- .../src/custom_requests/req_merlin_jump.mli | 2 +- 2 files changed, 18 insertions(+), 44 deletions(-) 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..e7f28fc52 100644 --- a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml +++ b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml @@ -5,39 +5,23 @@ 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 + let yojson_of_t { textDocument; position } = `Assoc - (("textDocument", TextDocumentIdentifier.yojson_of_t textDocument) - :: ("position", Position.yojson_of_t position) - :: target) + [ "textDocument", TextDocumentIdentifier.yojson_of_t textDocument + ; "position", Position.yojson_of_t position + ] ;; end @@ -62,16 +46,16 @@ module Request_params = struct let yojson_of_t t = JumpParams.yojson_of_t t - let create ~uri ~position ~target = - { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position; target } + let create ~uri ~position = + { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position } ;; 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 = @@ -80,25 +64,15 @@ let on_request ~params state = 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 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) -> + match Position.of_lexical_position position with + | Some pos -> Some (target, pos) + | None -> None))) ;; 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 From e5522a0d9e830d5fef9b676187e3d51236eaef69 Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 06:13:53 +0100 Subject: [PATCH 4/7] update merlin_jump custom request test --- ocaml-lsp-server/test/e2e-new/merlin_jump.ml | 38 +++++++++++--------- 1 file changed, 21 insertions(+), 17 deletions(-) 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": [] } |}] ;; From a1c320a552051881c7897196e35c2e7df3449008 Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 06:19:16 +0100 Subject: [PATCH 5/7] refactor merlin_jump CR --- .../src/custom_requests/req_merlin_jump.ml | 31 ++++--------------- 1 file changed, 6 insertions(+), 25 deletions(-) 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 e7f28fc52..188fd0974 100644 --- a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml +++ b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml @@ -4,27 +4,6 @@ module TextDocumentPositionParams = Lsp.Types.TextDocumentPositionParams let meth = "ocamllsp/jump" let capability = "handleJump", `Bool true -module JumpParams = struct - type t = - { textDocument : TextDocumentIdentifier.t - ; position : Position.t - } - - 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 - } - ;; - - let yojson_of_t { textDocument; position } = - `Assoc - [ "textDocument", TextDocumentIdentifier.yojson_of_t textDocument - ; "position", Position.yojson_of_t position - ] - ;; -end - module Jump = struct type t = (string * Position.t) list @@ -42,12 +21,14 @@ 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 = - { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; position } + TextDocumentPositionParams.create + ~position + ~textDocument:(TextDocumentIdentifier.create ~uri) ;; end @@ -62,7 +43,7 @@ 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 = Position.logical params.position in let doc = Document_store.get state.State.store uri in From 5ead989bbc2f107140fdee91af0db5c6c5966258 Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Fri, 31 Jan 2025 06:19:28 +0100 Subject: [PATCH 6/7] update documentation --- .../docs/ocamllsp/merlinJump-spec.md | 17 ++--------------- 1 file changed, 2 insertions(+), 15 deletions(-) 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 From 2fa73559648fc4ec2e8a01411e5e4134e5e498ce Mon Sep 17 00:00:00 2001 From: Pizie Dust Date: Mon, 3 Feb 2025 18:03:11 +0100 Subject: [PATCH 7/7] refactorings --- ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) 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 188fd0974..ea79329b8 100644 --- a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml +++ b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml @@ -53,7 +53,5 @@ let on_request ~params state = let+ res = dispatch ~merlin ~position in Jump.yojson_of_t (List.filter_map res ~f:(fun (target, position) -> - match Position.of_lexical_position position with - | Some pos -> Some (target, pos) - | None -> None))) + Option.map ~f:(fun pos -> target, pos) (Position.of_lexical_position position)))) ;;