From fd12c5ccc9ffa0a8ab09e96e79c4237efff22fb3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 5 Dec 2024 16:55:16 +0100 Subject: [PATCH] Add a new option to mute the hover response. --- ocaml-lsp-server/src/config_data.ml | 146 +++++++++++++++++++---- ocaml-lsp-server/src/ocaml_lsp_server.ml | 15 ++- 2 files changed, 133 insertions(+), 28 deletions(-) diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index e6184b726..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,15 +582,13 @@ 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) - | "syntaxDocumentation" -> - (match Ppx_yojson_conv_lib.( ! ) syntax_documentation_field with + | "standardHover" -> + (match Ppx_yojson_conv_lib.( ! ) standard_hover_field with | Ppx_yojson_conv_lib.Option.None -> let fvalue = - Json.Nullable_option.t_of_yojson - SyntaxDocumentation.t_of_yojson - _field_yojson + Json.Nullable_option.t_of_yojson StandardHover.t_of_yojson _field_yojson in - syntax_documentation_field := Ppx_yojson_conv_lib.Option.Some fvalue + 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" -> @@ -538,6 +611,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) + | "syntaxDocumentation" -> + (match Ppx_yojson_conv_lib.( ! ) syntax_documentation_field with + | Ppx_yojson_conv_lib.Option.None -> + let fvalue = + Json.Nullable_option.t_of_yojson + SyntaxDocumentation.t_of_yojson + _field_yojson + in + syntax_documentation_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 -> @@ -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,12 +708,35 @@ 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 ; merlin_jump_code_actions = v_merlin_jump_code_actions } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] 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 + let bnds = + if None = v_syntax_documentation + then bnds + else ( + let arg = + (Json.Nullable_option.yojson_of_t SyntaxDocumentation.yojson_of_t) + v_syntax_documentation + in + let bnd = "syntaxDocumentation", arg in + bnd :: bnds) + in let bnds = if None = v_dune_diagnostics then bnds @@ -646,14 +759,13 @@ let yojson_of_t = bnd :: bnds) in let bnds = - if None = v_syntax_documentation + if None = v_standard_hover then bnds else ( let arg = - (Json.Nullable_option.yojson_of_t SyntaxDocumentation.yojson_of_t) - v_syntax_documentation + (Json.Nullable_option.yojson_of_t StandardHover.yojson_of_t) v_standard_hover in - let bnd = "syntaxDocumentation", arg in + let bnd = "standardHover", arg in bnd :: bnds) in let bnds = @@ -674,17 +786,6 @@ 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) ;; @@ -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..4ce1b28cd 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 ->