From b363a353b87c1a1aea4fe057ff1681fbe51c78ba Mon Sep 17 00:00:00 2001 From: PixieDust <111846546+PizieDust@users.noreply.github.com> Date: Thu, 28 Nov 2024 16:15:11 +0100 Subject: [PATCH] Jump Custom Request (#1374) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Ulysse Gérard --- CHANGES.md | 2 + .../docs/ocamllsp/merlinJump-spec.md | 54 +++++++ .../src/custom_requests/custom_request.ml | 1 + .../src/custom_requests/custom_request.mli | 1 + .../src/custom_requests/req_merlin_jump.ml | 104 +++++++++++++ .../src/custom_requests/req_merlin_jump.mli | 14 ++ ocaml-lsp-server/src/ocaml_lsp_server.ml | 2 + ocaml-lsp-server/test/e2e-new/dune | 1 + ocaml-lsp-server/test/e2e-new/merlin_jump.ml | 138 ++++++++++++++++++ ocaml-lsp-server/test/e2e-new/start_stop.ml | 3 +- 10 files changed, 319 insertions(+), 1 deletion(-) create mode 100644 ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md create mode 100644 ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml create mode 100644 ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli create mode 100644 ocaml-lsp-server/test/e2e-new/merlin_jump.ml diff --git a/CHANGES.md b/CHANGES.md index 1626846d3..ab22218fa 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,8 @@ - Make MerlinJump code action configurable (#1376) +- Add custom [`ocamllsp/jump`](/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md) request (#1374) + ## Fixes - Fix fd leak in running external processes for preprocessing (#1349) diff --git a/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md b/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md new file mode 100644 index 000000000..d92b30821 --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/merlinJump-spec.md @@ -0,0 +1,54 @@ +# Merlin Jump Request + +## Description + +This custom request allows Merlin-type code navigation in a source buffer. + +## Server capability + +- propert name: `handleJump` +- property type: `boolean` + +## 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; +} +``` + +## Response + +- result: `Jump` + +```js + +export interface TargetPosition { + /** + * The target's kind. + */ + target: string; + + /** + * The corresponding position in the request's document. + */ + position: Position; +} + +export interface Jump { + /** + * The list of possible targets to jump-to. + */ + jumps: TargetPosition[] +} +``` diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.ml b/ocaml-lsp-server/src/custom_requests/custom_request.ml index 4f4398aa2..3c8e3bb1d 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.ml +++ b/ocaml-lsp-server/src/custom_requests/custom_request.ml @@ -8,3 +8,4 @@ module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search +module Merlin_jump = Req_merlin_jump diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.mli b/ocaml-lsp-server/src/custom_requests/custom_request.mli index b26880242..1a3914ac2 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.mli +++ b/ocaml-lsp-server/src/custom_requests/custom_request.mli @@ -10,3 +10,4 @@ module Type_enclosing = Req_type_enclosing module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search +module Merlin_jump = Req_merlin_jump diff --git a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml new file mode 100644 index 000000000..1c84f81e7 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.ml @@ -0,0 +1,104 @@ +open Import +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 + + 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 + +type t = Jump.t + +module Request_params = struct + type t = JumpParams.t + + let yojson_of_t t = JumpParams.yojson_of_t t + + let create ~uri ~position ~target = + { JumpParams.textDocument = TextDocumentIdentifier.create ~uri; 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 = + 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 + 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)) +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli new file mode 100644 index 000000000..95a9002d3 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_merlin_jump.mli @@ -0,0 +1,14 @@ +open Import + +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 +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 diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 49cbef37f..c2f54d1be 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -97,6 +97,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes ; Req_get_documentation.capability ; Req_construct.capability ; Req_type_search.capability + ; Req_merlin_jump.capability ] ) ] in @@ -526,6 +527,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 ; Req_type_search.meth, Req_type_search.on_request ; Req_construct.meth, Req_construct.on_request diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index e17a1b200..add8bed2a 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -63,6 +63,7 @@ test type_enclosing documentation + merlin_jump type_search with_pp with_ppx diff --git a/ocaml-lsp-server/test/e2e-new/merlin_jump.ml b/ocaml-lsp-server/test/e2e-new/merlin_jump.ml new file mode 100644 index 000000000..62813af6e --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/merlin_jump.ml @@ -0,0 +1,138 @@ +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 params = + Req.Request_params.create ~uri ~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 ~source ?target () = + let position = Position.create ~character ~line in + let request client = + let open Fiber.O in + let+ response = call_jump position client ?target in + Test.print_result response + in + Helpers.test source request + ;; +end + +let%expect_test "Get all jumps including 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 (); + [%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 } + } + ] + } |}] +;; + +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 + +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 + Util.test ~line ~character ~source (); + [%expect + {| + { + "jumps": [ + { "target": "module", "position": { "character": 2, "line": 7 } } + ] + } |}] +;; + +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 {| { "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": [] } |}] +;; diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index cc549955e..faabacb8e 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -94,7 +94,8 @@ let%expect_test "start/stop" = "handleTypeEnclosing": true, "handleGetDocumentation": true, "handleConstruct": true, - "handleTypeSearch": true + "handleTypeSearch": true, + "handleJump": true } }, "foldingRangeProvider": true,