diff --git a/CHANGES.md b/CHANGES.md index efb704fe2..ba2e04beb 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,11 @@ +# Unreleased + +## Features + +- Add a new server option `standardHover`, that can be used by clients to + disable the default hover provider. When `standardHover = false` + `textDocument/hover` requests always returns with empty result. + # 1.20.1 ## Fixes diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index ab4caba3a..b561b4a92 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -241,6 +241,78 @@ module ExtendedHover = struct [@@@end] end +module StandardHover = struct + type t = { enable : bool [@default true] } + [@@deriving_inline yojson] [@@yojson.allow_extra_fields] + + let _ = fun (_ : t) -> () + + let t_of_yojson = + (let _tp_loc = "ocaml-lsp-server/src/config_data.ml.StandardHover.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 -> true + | 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 + module DuneDiagnostics = struct type t = { enable : bool [@default true] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -461,6 +533,8 @@ type t = { codelens : Lens.t Json.Nullable_option.t [@default None] [@yojson_drop_default ( = )] ; extended_hover : ExtendedHover.t Json.Nullable_option.t [@key "extendedHover"] [@default None] [@yojson_drop_default ( = )] + ; standard_hover : StandardHover.t Json.Nullable_option.t + [@key "standardHover"] [@default None] [@yojson_drop_default ( = )] ; inlay_hints : InlayHints.t Json.Nullable_option.t [@key "inlayHints"] [@default None] [@yojson_drop_default ( = )] ; dune_diagnostics : DuneDiagnostics.t Json.Nullable_option.t @@ -480,6 +554,7 @@ let t_of_yojson = | `Assoc field_yojsons as yojson -> let codelens_field = ref Ppx_yojson_conv_lib.Option.None and extended_hover_field = ref Ppx_yojson_conv_lib.Option.None + and standard_hover_field = ref Ppx_yojson_conv_lib.Option.None 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 @@ -507,6 +582,15 @@ let t_of_yojson = extended_hover_field := Ppx_yojson_conv_lib.Option.Some fvalue | Ppx_yojson_conv_lib.Option.Some _ -> duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) + | "standardHover" -> + (match Ppx_yojson_conv_lib.( ! ) standard_hover_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = + Json.Nullable_option.t_of_yojson StandardHover.t_of_yojson _field_yojson + in + standard_hover_field := Ppx_yojson_conv_lib.Option.Some fvalue + | Ppx_yojson_conv_lib.Option.Some _ -> + duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | "inlayHints" -> (match Ppx_yojson_conv_lib.( ! ) inlay_hints_field with | Ppx_yojson_conv_lib.Option.None -> @@ -570,6 +654,7 @@ let t_of_yojson = | [] -> let ( codelens_value , extended_hover_value + , standard_hover_value , inlay_hints_value , dune_diagnostics_value , syntax_documentation_value @@ -577,6 +662,7 @@ let t_of_yojson = = ( Ppx_yojson_conv_lib.( ! ) codelens_field , Ppx_yojson_conv_lib.( ! ) extended_hover_field + , Ppx_yojson_conv_lib.( ! ) standard_hover_field , Ppx_yojson_conv_lib.( ! ) inlay_hints_field , Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field , Ppx_yojson_conv_lib.( ! ) syntax_documentation_field @@ -590,6 +676,10 @@ let t_of_yojson = (match extended_hover_value with | Ppx_yojson_conv_lib.Option.None -> None | Ppx_yojson_conv_lib.Option.Some v -> v) + ; standard_hover = + (match standard_hover_value with + | Ppx_yojson_conv_lib.Option.None -> None + | Ppx_yojson_conv_lib.Option.Some v -> v) ; inlay_hints = (match inlay_hints_value with | Ppx_yojson_conv_lib.Option.None -> None @@ -618,6 +708,7 @@ let yojson_of_t = (function | { codelens = v_codelens ; extended_hover = v_extended_hover + ; standard_hover = v_standard_hover ; inlay_hints = v_inlay_hints ; dune_diagnostics = v_dune_diagnostics ; syntax_documentation = v_syntax_documentation @@ -667,6 +758,16 @@ let yojson_of_t = let bnd = "inlayHints", arg in bnd :: bnds) in + let bnds = + if None = v_standard_hover + then bnds + else ( + let arg = + (Json.Nullable_option.yojson_of_t StandardHover.yojson_of_t) v_standard_hover + in + let bnd = "standardHover", arg in + bnd :: bnds) + in let bnds = if None = v_extended_hover then bnds @@ -696,9 +797,10 @@ let _ = yojson_of_t let default = { codelens = Some { enable = false } ; extended_hover = Some { enable = false } + ; standard_hover = Some { enable = true } ; 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 } + ; merlin_jump_code_actions = Some { enable = false } } ;; diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index c2f54d1be..1fca2b6fe 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -628,12 +628,15 @@ let on_request | TextDocumentColor _ -> now [] | TextDocumentColorPresentation _ -> now [] | TextDocumentHover req -> - let mode = - match state.configuration.data.extended_hover with - | Some { enable = true } -> Hover_req.Extended_variable - | Some _ | None -> Hover_req.Default - in - later (fun (_ : State.t) () -> Hover_req.handle rpc req mode) () + (match state.configuration.data.standard_hover with + | Some { enable = false } -> now None + | Some { enable = true } | None -> + let mode = + match state.configuration.data.extended_hover with + | Some { enable = true } -> Hover_req.Extended_variable + | Some _ | None -> Hover_req.Default + in + later (fun (_ : State.t) () -> Hover_req.handle rpc req mode) ()) | TextDocumentReferences req -> later (references rpc) req | TextDocumentCodeLensResolve codeLens -> now codeLens | TextDocumentCodeLens req -> diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 8e28ecb89..10c99da3b 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -1272,6 +1272,14 @@ module M : sig type t = I of int | B of bool end |}] ;; +let activate_jump client = + let config = + DidChangeConfigurationParams.create + ~settings:(`Assoc [ "merlinJumpCodeActions", `Assoc [ "enable", `Bool true ] ]) + in + change_config ~client config +;; + let%expect_test "can jump to match target" = let source = {ocaml| @@ -1288,7 +1296,11 @@ 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-match"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-match"); [%expect {| Code actions: @@ -1327,7 +1339,11 @@ 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-next-case"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-next-case"); [%expect {| Code actions: @@ -1364,7 +1380,11 @@ 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-prev-case"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-prev-case"); [%expect {| Code actions: @@ -1401,7 +1421,11 @@ 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-let"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-let"); [%expect {| Code actions: @@ -1438,7 +1462,11 @@ 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-fun"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-fun"); [%expect {| Code actions: @@ -1476,7 +1504,11 @@ let f (x : t) (d : bool) = 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"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-module"); [%expect {| Code actions: @@ -1517,7 +1549,11 @@ let%expect_test "can jump to module-type target" = 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"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-module-type"); [%expect {| Code actions: @@ -1553,7 +1589,11 @@ let%expect_test "shouldn't find the jump target on the same line" = 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"); + print_code_actions + ~prep:activate_jump + source + range + ~filter:(find_action "merlin-jump-fun"); [%expect {| No code actions |}] ;; diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml index 7d513ffef..06b930e97 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml @@ -1,5 +1,7 @@ open Test.Import +let change_config ~client params = Client.notification client (ChangeConfiguration params) + let open_document ~client ~uri ~source = let textDocument = TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text:source diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli index c77e3e738..8d80cc74b 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli @@ -1,5 +1,8 @@ open Test.Import +(** Send the given configuration to the language server *) +val change_config : client:'a Client.t -> DidChangeConfigurationParams.t -> unit Fiber.t + (** Opens a document with the language server. This must be done before trying to access it *) val open_document diff --git a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml index daf110be2..dbb86a928 100644 --- a/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml +++ b/ocaml-lsp-server/test/e2e-new/syntax_doc_tests.ml @@ -1,6 +1,6 @@ open! Test.Import +open Lsp_helpers -let change_config client params = Client.notification client (ChangeConfiguration params) let uri = DocumentUri.of_path "test.ml" let create_postion line character = Position.create ~line ~character @@ -67,7 +67,7 @@ type color = Red|Blue |ocaml} in let position = create_postion 1 9 in let req client = - let* () = change_config client activate_syntax_doc in + let* () = change_config ~client activate_syntax_doc in let* resp = hover_req client position in let () = print_hover resp in Fiber.return () @@ -94,7 +94,7 @@ type color = Red|Blue |ocaml} in let position = create_postion 1 9 in let req client = - let* () = change_config client deactivate_syntax_doc in + let* () = change_config ~client deactivate_syntax_doc in let* resp = hover_req client position in let () = print_hover resp in Fiber.return () @@ -117,7 +117,7 @@ type t = .. |ocaml} in let position = create_postion 1 5 in let req client = - let* () = change_config client activate_syntax_doc in + let* () = change_config ~client activate_syntax_doc in let* resp = hover_req client position in let () = print_hover resp in Fiber.return () @@ -143,7 +143,7 @@ let%expect_test "should receive no hover response" = |ocaml} in let position = create_postion 1 5 in let req client = - let* () = change_config client activate_syntax_doc in + let* () = change_config ~client activate_syntax_doc in let* resp = hover_req client position in let () = print_hover resp in Fiber.return ()