diff --git a/CHANGES.md b/CHANGES.md index 26796fe8b..8855c5fa6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,6 +13,8 @@ - Add support for OCaml 5.2 (#1233) +- Add a code-action for syntactic and semantic movement shortcuts based on Merlin's Jump command (#1364) + ## Fixes - Kill unnecessary ocamlformat processes with sigterm rather than sigint or diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index 36d8dd5a2..cd69d7569 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -118,13 +118,22 @@ let compute server (params : CodeActionParams.t) = in Action_open_related.for_uri capabilities doc in + let* merlin_jumps = + let capabilities = + let open Option.O in + let* window = (State.client_capabilities state).window in + window.showDocument + in + Action_jump.code_actions doc params capabilities + in (match Document.syntax doc with | Ocamllex | Menhir | Cram | Dune -> Fiber.return (Reply.now (actions (dune_actions @ open_related)), state) | Ocaml | Reason -> let reply () = let+ code_action_results = compute_ocaml_code_actions params state doc in - List.concat [ code_action_results; dune_actions; open_related ] |> actions + List.concat [ code_action_results; dune_actions; open_related; merlin_jumps ] + |> actions in let later f = Fiber.return diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml new file mode 100644 index 000000000..456df1605 --- /dev/null +++ b/ocaml-lsp-server/src/code_actions/action_jump.ml @@ -0,0 +1,83 @@ +open Import +open Fiber.O +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 available (capabilities : ShowDocumentClientCapabilities.t option) = + match capabilities with + | Some { support } -> support + | None -> false +;; + +let error message = + Jsonrpc.Response.Error.raise + @@ Jsonrpc.Response.Error.make + ~code:Jsonrpc.Response.Error.Code.InvalidParams + ~message + () +;; + +let command_run server (params : ExecuteCommandParams.t) = + let uri, range = + match params.arguments with + | Some [ json_uri; json_range ] -> + let uri = DocumentUri.t_of_yojson json_uri in + let range = Range.t_of_yojson json_range in + uri, range + | None | Some _ -> error "takes a URI and a range as input" + in + let+ { ShowDocumentResult.success } = + let req = ShowDocumentParams.create ~uri ~selection:range ~takeFocus:true () in + Server.request server (Server_request.ShowDocumentRequest req) + in + if not success + then ( + let uri = Uri.to_string uri in + Format.eprintf "failed to open %s@." uri); + `Null +;; + +(* 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 code_actions + (doc : Document.t) + (params : CodeActionParams.t) + (capabilities : ShowDocumentClientCapabilities.t option) + = + 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 "Jump to %s" 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 "merlin-jump") ~command ()) + in + List.filter_opt actions + | _ -> Fiber.return [] +;; diff --git a/ocaml-lsp-server/src/code_actions/action_jump.mli b/ocaml-lsp-server/src/code_actions/action_jump.mli new file mode 100644 index 000000000..cc8352779 --- /dev/null +++ b/ocaml-lsp-server/src/code_actions/action_jump.mli @@ -0,0 +1,11 @@ +open Import + +val command_name : string +val available : ShowDocumentClientCapabilities.t option -> bool +val command_run : 'a Server.t -> ExecuteCommandParams.t -> Json.t Fiber.t + +val code_actions + : Document.t + -> CodeActionParams.t + -> ShowDocumentClientCapabilities.t option + -> CodeAction.t list Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 3a1fc02e0..c3de088f8 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -107,6 +107,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes then view_metrics_command_name :: Action_open_related.command_name + :: Action_jump.command_name :: Document_text_command.command_name :: Merlin_config_command.command_name :: Dune.commands @@ -592,6 +593,8 @@ let on_request else if String.equal command.command Action_open_related.command_name then later (fun _state server -> Action_open_related.command_run server command) server + else if String.equal command.command Action_jump.command_name + then later (fun _state server -> Action_jump.command_run server command) server else later (fun state () -> diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 24cefa4cb..7d43164d5 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -1272,6 +1272,105 @@ module M : sig type t = I of int | B of bool end |}] ;; +let%expect_test "can jump to target" = + let source = + {ocaml| +type t = Foo of int | Bar of bool +let square x = x * x +let f (x : t) (d : bool) = + match x with + |Bar x -> x + |Foo _ -> d +|ocaml} + in + let range = + let start = Position.create ~line:5 ~character:5 in + let end_ = Position.create ~line:5 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions source range ~filter:(find_action "merlin-jump"); + [%expect + {| + Code actions: + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 0, "line": 3 }, + "start": { "character": 0, "line": 3 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Jump to fun" + }, + "kind": "merlin-jump", + "title": "Jump to fun" + } + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 2, "line": 4 }, + "start": { "character": 2, "line": 4 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Jump to match" + }, + "kind": "merlin-jump", + "title": "Jump to match" + } + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 0, "line": 3 }, + "start": { "character": 0, "line": 3 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Jump to let" + }, + "kind": "merlin-jump", + "title": "Jump to let" + } + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 3, "line": 6 }, + "start": { "character": 3, "line": 6 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Jump to match-next-case" + }, + "kind": "merlin-jump", + "title": "Jump to match-next-case" + } + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 3, "line": 5 }, + "start": { "character": 3, "line": 5 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Jump to match-prev-case" + }, + "kind": "merlin-jump", + "title": "Jump to match-prev-case" + } + + |}] +;; + let position_of_offset src x = assert (0 <= x && x < String.length src); let cnum = ref 0 diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index 4216a64ea..c308f2f31 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -77,8 +77,8 @@ let%expect_test "start/stop" = "executeCommandProvider": { "commands": [ "ocamllsp/view-metrics", "ocamllsp/open-related-source", - "ocamllsp/show-document-text", "ocamllsp/show-merlin-config", - "dune/promote" + "ocamllsp/merlin-jump-to-target", "ocamllsp/show-document-text", + "ocamllsp/show-merlin-config", "dune/promote" ] }, "experimental": {