diff --git a/CHANGES.md b/CHANGES.md index 8855c5fa6..0bb05a512 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,10 +1,13 @@ # Unreleased +- Make MerlinJump code action configurable (#1376) + ## Fixes - Fix fd leak in running external processes for preprocessing (#1349) - Fix prefix parsing for completion of object methods (#1363, fixes #1358) + # 1.19.0 ## Features diff --git a/ocaml-lsp-server/docs/ocamllsp/config.md b/ocaml-lsp-server/docs/ocamllsp/config.md index 2d9bfb2a6..aea4ddfc3 100644 --- a/ocaml-lsp-server/docs/ocamllsp/config.md +++ b/ocaml-lsp-server/docs/ocamllsp/config.md @@ -42,5 +42,12 @@ interface config { * @since 1.18 */ syntaxDocumentation: { enable : boolean } + + /** + * Enable/Disable Merlin Jump code actions + * @default true + * @since 1.19 + */ + merlinJumpCodeActions: { enable : boolean } } ``` diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index cd69d7569..60fd33730 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -110,21 +110,16 @@ let compute server (params : CodeActionParams.t) = match doc with | None -> Fiber.return (Reply.now (actions dune_actions), state) | Some doc -> - let open_related = - let capabilities = - let open Option.O in - let* window = (State.client_capabilities state).window in - window.showDocument - in - Action_open_related.for_uri capabilities doc + let capabilities = + let open Option.O in + let* window = (State.client_capabilities state).window in + window.showDocument in + let open_related = 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 + match state.configuration.data.merlin_jump_code_actions with + | Some { enable = true } -> Action_jump.code_actions doc params capabilities + | _ -> Fiber.return [] in (match Document.syntax doc with | Ocamllex | Menhir | Cram | Dune -> diff --git a/ocaml-lsp-server/src/code_actions/action_jump.ml b/ocaml-lsp-server/src/code_actions/action_jump.ml index 456df1605..c33a0c451 100644 --- a/ocaml-lsp-server/src/code_actions/action_jump.ml +++ b/ocaml-lsp-server/src/code_actions/action_jump.ml @@ -8,6 +8,12 @@ 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) + else target +;; + let available (capabilities : ShowDocumentClientCapabilities.t option) = match capabilities with | Some { support } -> support @@ -71,12 +77,16 @@ let code_actions 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 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 "merlin-jump") ~command ()) + CodeAction.create + ~title + ~kind:(CodeActionKind.Other (sprintf "merlin-jump-%s" (rename_target target))) + ~command + ()) in List.filter_opt actions | _ -> Fiber.return [] diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index be4166206..e6184b726 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -385,6 +385,78 @@ module SyntaxDocumentation = struct [@@@end] end +module MerlinJumpCodeActions = struct + type t = { enable : bool [@default false] } + [@@deriving_inline yojson] [@@yojson.allow_extra_fields] + + let _ = fun (_ : t) -> () + + let t_of_yojson = + (let _tp_loc = "ocaml-lsp-server/src/config_data.ml.MerlinJumpCodeActions.t" in + function + | `Assoc field_yojsons as yojson -> + let enable_field = ref Ppx_yojson_conv_lib.Option.None + and duplicates = ref [] + and extra = ref [] in + let rec iter = function + | (field_name, _field_yojson) :: tail -> + (match field_name with + | "enable" -> + (match Ppx_yojson_conv_lib.( ! ) enable_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = bool_of_yojson _field_yojson in + enable_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | _ -> ()); + iter tail + | [] -> () + in + iter field_yojsons; + (match Ppx_yojson_conv_lib.( ! ) duplicates with + | _ :: _ -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_duplicate_fields + _tp_loc + (Ppx_yojson_conv_lib.( ! ) duplicates) + yojson + | [] -> + (match Ppx_yojson_conv_lib.( ! ) extra with + | _ :: _ -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_extra_fields + _tp_loc + (Ppx_yojson_conv_lib.( ! ) extra) + yojson + | [] -> + let enable_value = Ppx_yojson_conv_lib.( ! ) enable_field in + { enable = + (match enable_value with + | Ppx_yojson_conv_lib.Option.None -> false + | Ppx_yojson_conv_lib.Option.Some v -> v) + })) + | _ as yojson -> + Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom _tp_loc yojson + : Ppx_yojson_conv_lib.Yojson.Safe.t -> t) + ;; + + let _ = t_of_yojson + + let yojson_of_t = + (function + | { enable = v_enable } -> + let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in + let bnds = + let arg = yojson_of_bool v_enable in + ("enable", arg) :: bnds + in + `Assoc bnds + : t -> Ppx_yojson_conv_lib.Yojson.Safe.t) + ;; + + let _ = yojson_of_t + + [@@@end] +end + type t = { codelens : Lens.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; extended_hover : ExtendedHover.t Json.Nullable_option.t @@ -395,6 +467,8 @@ type t = [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )] ; syntax_documentation : SyntaxDocumentation.t Json.Nullable_option.t [@key "syntaxDocumentation"] [@default None] [@yojson_drop_default ( = )] + ; merlin_jump_code_actions : MerlinJumpCodeActions.t Json.Nullable_option.t + [@key "merlinJumpCodeActions"] [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -409,6 +483,7 @@ let t_of_yojson = and inlay_hints_field = ref Ppx_yojson_conv_lib.Option.None and dune_diagnostics_field = ref Ppx_yojson_conv_lib.Option.None and syntax_documentation_field = ref Ppx_yojson_conv_lib.Option.None + and merlin_jump_code_actions_field = ref Ppx_yojson_conv_lib.Option.None and duplicates = ref [] and extra = ref [] in let rec iter = function @@ -463,6 +538,17 @@ let t_of_yojson = dune_diagnostics_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | "merlinJumpCodeActions" -> + (match Ppx_yojson_conv_lib.( ! ) merlin_jump_code_actions_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = + Json.Nullable_option.t_of_yojson + MerlinJumpCodeActions.t_of_yojson + _field_yojson + in + merlin_jump_code_actions_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | _ -> ()); iter tail | [] -> () @@ -486,13 +572,15 @@ let t_of_yojson = , extended_hover_value , inlay_hints_value , dune_diagnostics_value - , syntax_documentation_value ) + , syntax_documentation_value + , merlin_jump_code_actions_value ) = ( Ppx_yojson_conv_lib.( ! ) codelens_field , Ppx_yojson_conv_lib.( ! ) extended_hover_field , Ppx_yojson_conv_lib.( ! ) inlay_hints_field , Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field - , Ppx_yojson_conv_lib.( ! ) syntax_documentation_field ) + , Ppx_yojson_conv_lib.( ! ) syntax_documentation_field + , Ppx_yojson_conv_lib.( ! ) merlin_jump_code_actions_field ) in { codelens = (match codelens_value with @@ -514,6 +602,10 @@ let t_of_yojson = (match syntax_documentation_value with | Ppx_yojson_conv_lib.Option.None -> None | Ppx_yojson_conv_lib.Option.Some v -> v) + ; merlin_jump_code_actions = + (match merlin_jump_code_actions_value with + | Ppx_yojson_conv_lib.Option.None -> None + | Ppx_yojson_conv_lib.Option.Some v -> v) })) | _ as yojson -> Ppx_yojson_conv_lib.Yojson_conv_error.record_list_instead_atom _tp_loc yojson @@ -529,6 +621,7 @@ let yojson_of_t = ; inlay_hints = v_inlay_hints ; dune_diagnostics = v_dune_diagnostics ; syntax_documentation = v_syntax_documentation + ; merlin_jump_code_actions = v_merlin_jump_code_actions } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in let bnds = @@ -581,6 +674,17 @@ let yojson_of_t = let bnd = "codelens", arg in bnd :: bnds) in + let bnds = + if None = v_merlin_jump_code_actions + then bnds + else ( + let arg = + (Json.Nullable_option.yojson_of_t MerlinJumpCodeActions.yojson_of_t) + v_merlin_jump_code_actions + in + let bnd = "merlinJumpCodeActions", arg in + bnd :: bnds) + in `Assoc bnds : t -> Ppx_yojson_conv_lib.Yojson.Safe.t) ;; @@ -595,5 +699,6 @@ let default = ; inlay_hints = Some { hint_pattern_variables = false; hint_let_bindings = false } ; dune_diagnostics = Some { enable = true } ; syntax_documentation = Some { enable = false } + ; merlin_jump_code_actions = Some { enable = true } } ;; diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 7d43164d5..8e28ecb89 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -1272,7 +1272,7 @@ module M : sig type t = I of int | B of bool end |}] ;; -let%expect_test "can jump to target" = +let%expect_test "can jump to match target" = let source = {ocaml| type t = Foo of int | Bar of bool @@ -1288,7 +1288,7 @@ let f (x : t) (d : bool) = let end_ = Position.create ~line:5 ~character:5 in Range.create ~start ~end_ in - print_code_actions source range ~filter:(find_action "merlin-jump"); + print_code_actions source range ~filter:(find_action "merlin-jump-match"); [%expect {| Code actions: @@ -1297,31 +1297,114 @@ let f (x : t) (d : bool) = "arguments": [ "file:///foo.ml", { - "end": { "character": 0, "line": 3 }, - "start": { "character": 0, "line": 3 } + "end": { "character": 2, "line": 4 }, + "start": { "character": 2, "line": 4 } } ], "command": "ocamllsp/merlin-jump-to-target", - "title": "Jump to fun" + "title": "Match jump" }, - "kind": "merlin-jump", - "title": "Jump to fun" + "kind": "merlin-jump-match", + "title": "Match jump" } + + |}] +;; + +let%expect_test "can jump to match-next-case 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-next-case"); + [%expect + {| + Code actions: { "command": { "arguments": [ "file:///foo.ml", { - "end": { "character": 2, "line": 4 }, - "start": { "character": 2, "line": 4 } + "end": { "character": 3, "line": 6 }, + "start": { "character": 3, "line": 6 } } ], "command": "ocamllsp/merlin-jump-to-target", - "title": "Jump to match" + "title": "Next-case jump" }, - "kind": "merlin-jump", - "title": "Jump to match" - } + "kind": "merlin-jump-next-case", + "title": "Next-case jump" + } |}] +;; + +let%expect_test "can jump to match-prev-case 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-prev-case"); + [%expect + {| + Code actions: + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 3, "line": 5 }, + "start": { "character": 3, "line": 5 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Prev-case jump" + }, + "kind": "merlin-jump-prev-case", + "title": "Prev-case jump" + } |}] +;; + +let%expect_test "can jump to let 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-let"); + [%expect + {| + Code actions: { "command": { "arguments": [ @@ -1332,43 +1415,147 @@ let f (x : t) (d : bool) = } ], "command": "ocamllsp/merlin-jump-to-target", - "title": "Jump to let" + "title": "Let jump" }, - "kind": "merlin-jump", - "title": "Jump to let" - } + "kind": "merlin-jump-let", + "title": "Let jump" + } |}] +;; + +let%expect_test "can jump to fun 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-fun"); + [%expect + {| + Code actions: { "command": { "arguments": [ "file:///foo.ml", { - "end": { "character": 3, "line": 6 }, - "start": { "character": 3, "line": 6 } + "end": { "character": 0, "line": 3 }, + "start": { "character": 0, "line": 3 } } ], "command": "ocamllsp/merlin-jump-to-target", - "title": "Jump to match-next-case" + "title": "Fun jump" }, - "kind": "merlin-jump", - "title": "Jump to match-next-case" - } + "kind": "merlin-jump-fun", + "title": "Fun jump" + } |}] +;; + +let%expect_test "can jump to module target" = + let source = + {ocaml| +module FooBar = struct + type t = Foo of int | Bar of bool +end +let f (x : t) (d : bool) = + match x with + |Bar x -> x + |Foo _ -> d +|ocaml} + in + let range = + let start = Position.create ~line:2 ~character:5 in + let end_ = Position.create ~line:2 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions source range ~filter:(find_action "merlin-jump-module"); + [%expect + {| + Code actions: { "command": { "arguments": [ "file:///foo.ml", { - "end": { "character": 3, "line": 5 }, - "start": { "character": 3, "line": 5 } + "end": { "character": 0, "line": 1 }, + "start": { "character": 0, "line": 1 } } ], "command": "ocamllsp/merlin-jump-to-target", - "title": "Jump to match-prev-case" + "title": "Module jump" }, - "kind": "merlin-jump", - "title": "Jump to match-prev-case" - } + "kind": "merlin-jump-module", + "title": "Module jump" + } |}] +;; - |}] +let%expect_test "can jump to module-type target" = + let source = + {ocaml| + module type ORDER = sig + type t + val leq : t -> t -> bool + val equal : t -> t -> bool + end + + let f (x : t) (d : bool) = + match x with + |Bar x -> x + |Foo _ -> d + |ocaml} + in + let range = + let start = Position.create ~line:4 ~character:5 in + let end_ = Position.create ~line:4 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions source range ~filter:(find_action "merlin-jump-module-type"); + [%expect + {| + Code actions: + { + "command": { + "arguments": [ + "file:///foo.ml", + { + "end": { "character": 2, "line": 1 }, + "start": { "character": 2, "line": 1 } + } + ], + "command": "ocamllsp/merlin-jump-to-target", + "title": "Module-type jump" + }, + "kind": "merlin-jump-module-type", + "title": "Module-type jump" + } |}] +;; + +let%expect_test "shouldn't find the jump target on the same line" = + let source = + {ocaml| + 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:0 ~character:5 in + let end_ = Position.create ~line:0 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions source range ~filter:(find_action "merlin-jump-fun"); + [%expect {| + No code actions |}] ;; let position_of_offset src x =