From 4734290f9ff3f936458a3c54433faeea75dfb77e Mon Sep 17 00:00:00 2001 From: PixieDust <111846546+PizieDust@users.noreply.github.com> Date: Fri, 29 Nov 2024 12:24:49 +0100 Subject: [PATCH] Jump Custom Request Client Implementation (#1654) * add jump to treeview commands * Jump custom request implementation * add changelog * query returns list, jump moves editor * Focus window after jumping to target. * Update CHANGELOG.md Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> * Update package.json Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> * Update src/custom_requests.mli Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> * move to unreleased * review corrections * change command icon * wait for the promise to return * use let+ * Update src/extension_commands.ml Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> --------- Co-authored-by: Ulysse <5031221+voodoos@users.noreply.github.com> --- CHANGELOG.md | 2 + package.json | 13 +++++ src/custom_requests.ml | 32 ++++++++++++ src/custom_requests.mli | 10 ++++ src/extension_commands.ml | 102 ++++++++++++++++++++++++++++++++++++++ src/extension_consts.ml | 2 + src/ocaml_lsp.ml | 6 +++ src/ocaml_lsp.mli | 2 + src/treeview_commands.ml | 16 +++++- 9 files changed, 184 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index af6d249b1..8f89cb7f2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ # Unreleased +- Add `ocaml.jump` to jump to a specific target. (#1654) + ## 1.22.0 - Fix formatting of cwd path on windows (#1650) diff --git a/package.json b/package.json index c41e6d863..98cf4ffb3 100644 --- a/package.json +++ b/package.json @@ -257,6 +257,11 @@ "command": "ocaml.construct", "category": "OCaml", "title": "List values that can fill the selected typed-hole" + }, + { + "command": "ocaml.jump", + "category": "OCaml", + "title": "List possible parent targets for jumping" } ], "configuration": { @@ -726,6 +731,14 @@ }, "when": "editorLangId == ocaml || editorLangId == reason" }, + { + "command": "ocaml.jump", + "key": "Alt+J", + "args": { + "kind": "jump" + }, + "when": "editorLangId == ocaml || editorLangId == ocaml.interface || editorLangId == reason" + }, { "command": "editor.action.codeAction", "key": "Alt+P", diff --git a/src/custom_requests.ml b/src/custom_requests.ml index 2f82586a9..7dc47d74f 100644 --- a/src/custom_requests.ml +++ b/src/custom_requests.ml @@ -120,3 +120,35 @@ module Construct = struct let request = { meth = ocamllsp_prefixed "construct"; encode_params; decode_response } end + +module Merlin_jump = struct + type params = + { uri : Uri.t + ; position : Position.t + } + + type response = (string * Position.t) list + + let encode_params { uri; position } = + let open Jsonoo.Encode in + let uri = + ("textDocument", object_ [ ("uri", string @@ Uri.toString uri ()) ]) + in + let position = ("position", Position.json_of_t position) in + object_ [ uri; position ] + + let decode_response (response : Jsonoo.t) : response = + let open Jsonoo.Decode in + field + "jumps" + (list (fun item -> + let target = field "target" string item in + let position = field "position" Position.t_of_json item in + (target, position))) + response + + let make ~uri ~position = { uri; position } + + let request = + { meth = ocamllsp_prefixed "jump"; encode_params; decode_response } +end diff --git a/src/custom_requests.mli b/src/custom_requests.mli index d16a24494..46bff0b15 100644 --- a/src/custom_requests.mli +++ b/src/custom_requests.mli @@ -58,3 +58,13 @@ module Construct : sig val request : (params, response) custom_request end + +module Merlin_jump : sig + type params + + type response = (string * Position.t) list + + val make : uri:Uri.t -> position:Position.t -> params + + val request : (params, response) custom_request +end diff --git a/src/extension_commands.ml b/src/extension_commands.ml index 35175ec8d..ee342d30e 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -664,6 +664,108 @@ module Construct = struct command Extension_consts.Commands.construct handler end +module MerlinJump = struct + let extension_name = "MerlinJump" + + let is_valid_text_doc textdoc = + match TextDocument.languageId textdoc with + | "ocaml" | "ocaml.interface" | "reason" | "ocaml.ocamllex" -> true + | _ -> false + + let ocaml_lsp_doesnt_support_merlin_jump ocaml_lsp = + not (Ocaml_lsp.can_handle_merlin_jump ocaml_lsp) + + let request_possible_targets position text_editor client = + let doc = TextEditor.document text_editor in + let uri = TextDocument.uri doc in + Custom_requests.( + send_request client Merlin_jump.request (Merlin_jump.make ~uri ~position)) + + let display_results (results : Custom_requests.Merlin_jump.response) = + let quickPickItems = + match results with + | [] -> + show_message `Info "No available targets to jump to."; + [] + | results -> + List.map results ~f:(fun (target, pos) -> + ( (QuickPickItem.create ~label:("Jump to nearest " ^ target)) () + , (target, pos) )) + in + let quickPickOptions = + QuickPickOptions.create ~title:"Available Jump Targets" () + in + Window.showQuickPickItems + ~choices:quickPickItems + ~options:quickPickOptions + () + + let jump_to_position text_editor position = + let open Promise.Syntax in + let+ _ = + Window.showTextDocument + ~document:(TextEditor.document text_editor) + ~preserveFocus:true + () + in + TextEditor.set_selection + text_editor + (Selection.makePositions ~anchor:position ~active:position); + TextEditor.revealRange + text_editor + ~range:(Range.makePositions ~start:position ~end_:position) + ~revealType:TextEditorRevealType.InCenterIfOutsideViewport + () + + let process_jump position text_editor client = + let open Promise.Syntax in + let* successful_targets = + request_possible_targets position text_editor client + in + let* selected_target = display_results successful_targets in + match selected_target with + | Some (_res, position) -> jump_to_position text_editor position + | None -> Promise.return () + + let _jump = + let handler (instance : Extension_instance.t) ~args:_ = + let jump () = + match Window.activeTextEditor () with + | None -> + Extension_consts.Command_errors.text_editor_must_be_active + extension_name + ~expl: + "The cursor position is used to determine the correct \ + environment for the jump." + |> show_message `Error "%s" + | Some text_editor + when not (is_valid_text_doc (TextEditor.document text_editor)) -> + show_message + `Error + "Invalid file type. This command only works in ocaml files, ocaml \ + interface files or reason files.." + | Some text_editor -> ( + match Extension_instance.lsp_client instance with + | None -> show_message `Warn "ocamllsp is not running" + | Some (_client, ocaml_lsp) + when ocaml_lsp_doesnt_support_merlin_jump ocaml_lsp -> + show_message + `Warn + "The installed version of `ocamllsp` does not support Merlin \ + jump custom requests" + | Some (client, _) -> + let position = + TextEditor.selection text_editor |> Selection.active + in + let _ = process_jump position text_editor client in + ()) + in + let (_ : unit) = jump () in + () + in + command Extension_consts.Commands.merlin_jump handler +end + let register extension instance = function | Command { id; handler } -> let callback = handler instance in diff --git a/src/extension_consts.ml b/src/extension_consts.ml index c733e0d57..b49751873 100644 --- a/src/extension_consts.ml +++ b/src/extension_consts.ml @@ -70,6 +70,8 @@ module Commands = struct let copy_type_under_cursor = ocaml_prefixed "copy-type-under-cursor" let construct = ocaml_prefixed "construct" + + let merlin_jump = ocaml_prefixed "jump" end module Command_errors = struct diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index 2df48621c..38ebc5766 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -45,6 +45,7 @@ module Experimental_capabilities = struct ; handleTypedHoles : bool ; handleTypeEnclosing : bool ; handleConstruct : bool + ; handleJump : bool } let default = @@ -53,6 +54,7 @@ module Experimental_capabilities = struct ; handleTypedHoles = false ; handleTypeEnclosing = false ; handleConstruct = false + ; handleJump = false } (** Creates [t] given a JSON of form [{ 'handleSwitchImplIntf' : true, .... }] *) @@ -68,11 +70,13 @@ module Experimental_capabilities = struct let handleTypedHoles = has_capability "handleTypedHoles" in let handleTypeEnclosing = has_capability "handleTypeEnclosing" in let handleConstruct = has_capability "handleConstruct" in + let handleJump = has_capability "handleJump" in { handleSwitchImplIntf ; handleInferIntf ; handleTypedHoles ; handleTypeEnclosing ; handleConstruct + ; handleJump } with Jsonoo.Decode_error err -> show_message @@ -242,3 +246,5 @@ let can_handle_type_enclosing t = t.experimental_capabilities.handleTypeEnclosing let can_handle_construct t = t.experimental_capabilities.handleConstruct + +let can_handle_merlin_jump t = t.experimental_capabilities.handleJump diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index 6f59c721d..b385ab9c7 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -17,6 +17,8 @@ val can_handle_type_enclosing : t -> bool val can_handle_construct : t -> bool +val can_handle_merlin_jump : t -> bool + module OcamllspSettingEnable : sig include Ojs.T diff --git a/src/treeview_commands.ml b/src/treeview_commands.ml index 77b9b73be..a1f827c8b 100644 --- a/src/treeview_commands.ml +++ b/src/treeview_commands.ml @@ -59,7 +59,21 @@ let construct_item = Vscode.TreeItem.set_command item command; item -let items = [ select_sandbox_item; terminal_item; construct_item ] +let jump_item = + let icon = `ThemeIcon (Vscode.ThemeIcon.make ~id:"fold-up" ()) in + let label = + `TreeItemLabel + (Vscode.TreeItemLabel.create ~label:"Jump to a specific target" ()) + in + let item = Vscode.TreeItem.make_label ~label () in + let command = + Vscode.Command.create ~title:"MerlinJump" ~command:"ocaml.jump" () + in + Vscode.TreeItem.set_iconPath item icon; + Vscode.TreeItem.set_command item command; + item + +let items = [ select_sandbox_item; terminal_item; construct_item; jump_item ] let getTreeItem ~element = `Value element