From ba7b1471982b45ecb50f0b5dc623f0cbed45152a Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 18 Apr 2024 07:50:06 +0000 Subject: [PATCH] cleanup --- CHANGES.md | 3 +- ocaml-lsp-server/docs/ocamllsp/config.md | 7 - ocaml-lsp-server/src/config_data.ml | 131 +----------------- ocaml-lsp-server/src/configuration.ml | 5 - ocaml-lsp-server/src/configuration.mli | 2 - ocaml-lsp-server/src/merlin_config.ml | 2 +- ocaml-lsp-server/src/merlin_config.mli | 2 +- ocaml-lsp-server/src/ocaml_lsp_server.ml | 7 +- ocaml-lsp-server/src/state.ml | 7 - ocaml-lsp-server/src/state.mli | 5 - ocaml-lsp-server/test/e2e-new/dune | 1 - ocaml-lsp-server/test/e2e-new/dune_context.ml | 88 ------------ 12 files changed, 6 insertions(+), 254 deletions(-) delete mode 100644 ocaml-lsp-server/test/e2e-new/dune_context.ml diff --git a/CHANGES.md b/CHANGES.md index 92c886b90..5e1ffeccc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,8 +8,7 @@ - Support folding of `ifthenelse` expressions (#1031) -- Add `getDuneContexts` method and spawn a new `ocaml-merlin` process per - Dune context (#1238) +- Add `getDuneContexts` method and `--context` flag (#1238) ## Fixes diff --git a/ocaml-lsp-server/docs/ocamllsp/config.md b/ocaml-lsp-server/docs/ocamllsp/config.md index 5ec4ba40c..900d9ad86 100644 --- a/ocaml-lsp-server/docs/ocamllsp/config.md +++ b/ocaml-lsp-server/docs/ocamllsp/config.md @@ -35,12 +35,5 @@ interface config { * @since 1.18 */ inlayHints: { enable : boolean } - - /** - * Set the current Dune context for Merlin - * @default "default" - * @since 1.18 - */ - duneContext: { value : string } } ``` diff --git a/ocaml-lsp-server/src/config_data.ml b/ocaml-lsp-server/src/config_data.ml index ed5835a85..1098fc679 100644 --- a/ocaml-lsp-server/src/config_data.ml +++ b/ocaml-lsp-server/src/config_data.ml @@ -315,101 +315,6 @@ module DuneDiagnostics = struct [@@@end] end -module DuneContext = struct - type selected = - | Default - | Custom of string - - type t = { value : selected [@default Default] } - [@@deriving_inline yojson] [@@yojson.allow_extra_fields] - - let to_string = function - | Default -> "default" - | Custom str -> str - - let of_string = function - | "default" -> Default - | str -> Custom str - - let to_dyn t = Dyn.string (to_string t) - - let equal a b = - match (a, b) with - | Default, Default -> true - | Custom str1, Custom str2 when String.equal str1 str2 -> true - | Default, Custom _ | Custom _, Default | Custom _, Custom _ -> false - - let t_of_yojson = - (let _tp_loc = "ocaml-lsp-server/src/config_data.ml.DuneContext.t" in - function - | `Assoc field_yojsons as yojson -> ( - let value_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 - | "value" -> ( - match Ppx_yojson_conv_lib.( ! ) value_field with - | Ppx_yojson_conv_lib.Option.None -> - let fvalue = string_of_yojson _field_yojson in - value_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 value_value = Ppx_yojson_conv_lib.( ! ) value_field in - { value = - (match value_value with - | Ppx_yojson_conv_lib.Option.None - | Ppx_yojson_conv_lib.Option.Some "default" -> Default - | Ppx_yojson_conv_lib.Option.Some v -> Custom 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 - | { value = v_value } -> - let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in - let bnds = - let arg = - match v_value with - | Default -> "default" - | Custom ctxt -> ctxt - in - ("value", yojson_of_string 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 ( = )] @@ -419,8 +324,6 @@ type t = [@key "inlayHints"] [@default None] [@yojson_drop_default ( = )] ; dune_diagnostics : DuneDiagnostics.t Json.Nullable_option.t [@key "duneDiagnostics"] [@default None] [@yojson_drop_default ( = )] - ; dune_context : DuneContext.t Json.Nullable_option.t - [@key "duneContext"] [@default None] [@yojson_drop_default ( = )] } [@@deriving_inline yojson] [@@yojson.allow_extra_fields] @@ -434,7 +337,6 @@ let t_of_yojson = and extended_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 dune_context_field = ref Ppx_yojson_conv_lib.Option.None and duplicates = ref [] and extra = ref [] in let rec iter = function @@ -482,17 +384,6 @@ 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) - | "duneContext" -> ( - match Ppx_yojson_conv_lib.( ! ) dune_context_field with - | Ppx_yojson_conv_lib.Option.None -> - let fvalue = - Json.Nullable_option.t_of_yojson - DuneContext.t_of_yojson - _field_yojson - in - dune_context_field := Ppx_yojson_conv_lib.Option.Some fvalue - | Ppx_yojson_conv_lib.Option.Some _ -> - duplicates := field_name :: Ppx_yojson_conv_lib.( ! ) duplicates) | _ -> ()); iter tail | [] -> () @@ -515,13 +406,11 @@ let t_of_yojson = let ( codelens_value , extended_hover_value , inlay_hints_value - , dune_diagnostics_value - , dune_context_value ) = + , dune_diagnostics_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.( ! ) dune_context_field ) + , Ppx_yojson_conv_lib.( ! ) dune_diagnostics_field ) in { codelens = (match codelens_value with @@ -539,10 +428,6 @@ let t_of_yojson = (match dune_diagnostics_value with | Ppx_yojson_conv_lib.Option.None -> None | Ppx_yojson_conv_lib.Option.Some v -> v) - ; dune_context = - (match dune_context_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 @@ -558,7 +443,6 @@ let yojson_of_t = ; extended_hover = v_extended_hover ; inlay_hints = v_inlay_hints ; dune_diagnostics = v_dune_diagnostics - ; dune_context = v_dune_context } -> let bnds : (string * Ppx_yojson_conv_lib.Yojson.Safe.t) list = [] in let bnds = @@ -600,16 +484,6 @@ let yojson_of_t = let bnd = ("codelens", arg) in bnd :: bnds in - let bnds = - if None = v_dune_context then bnds - else - let arg = - (Json.Nullable_option.yojson_of_t DuneContext.yojson_of_t) - v_dune_context - in - let bnd = ("duneContext", arg) in - bnd :: bnds - in `Assoc bnds : t -> Ppx_yojson_conv_lib.Yojson.Safe.t) @@ -623,5 +497,4 @@ let default = ; inlay_hints = Some { hint_pattern_variables = false; hint_let_bindings = false } ; dune_diagnostics = Some { enable = true } - ; dune_context = Some { value = Default } } diff --git a/ocaml-lsp-server/src/configuration.ml b/ocaml-lsp-server/src/configuration.ml index 3cca01396..41020b923 100644 --- a/ocaml-lsp-server/src/configuration.ml +++ b/ocaml-lsp-server/src/configuration.ml @@ -52,8 +52,3 @@ let report_dune_diagnostics t = match t.data.dune_diagnostics with | Some { enable = true } | None -> true | Some { enable = false } -> false - -let dune_context t = - match t.data.dune_context with - | Some { value = v } -> v - | None -> Default diff --git a/ocaml-lsp-server/src/configuration.mli b/ocaml-lsp-server/src/configuration.mli index ac1bdfd4c..fb6d8e4e5 100644 --- a/ocaml-lsp-server/src/configuration.mli +++ b/ocaml-lsp-server/src/configuration.mli @@ -12,5 +12,3 @@ val wheel : t -> Lev_fiber.Timer.Wheel.t val update : t -> DidChangeConfigurationParams.t -> t Fiber.t val report_dune_diagnostics : t -> bool - -val dune_context : t -> Config_data.DuneContext.selected diff --git a/ocaml-lsp-server/src/merlin_config.ml b/ocaml-lsp-server/src/merlin_config.ml index 0e30ea054..549fdaa48 100644 --- a/ocaml-lsp-server/src/merlin_config.ml +++ b/ocaml-lsp-server/src/merlin_config.ml @@ -202,7 +202,7 @@ module Process = struct ; "ocaml-merlin" ; "--no-print-directory" ; "--context" - ; Config_data.DuneContext.to_string dune_context + ; dune_context ] in Pid.of_int diff --git a/ocaml-lsp-server/src/merlin_config.mli b/ocaml-lsp-server/src/merlin_config.mli index 57dabe49c..aacfae998 100644 --- a/ocaml-lsp-server/src/merlin_config.mli +++ b/ocaml-lsp-server/src/merlin_config.mli @@ -6,7 +6,7 @@ type t val should_read_dot_merlin : bool ref -val dune_context : Config_data.DuneContext.selected option ref +val dune_context : string option ref val config : t -> Mconfig.t Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index f0e1e630d..943033f71 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -723,10 +723,6 @@ let on_notification server (notification : Client_notification.t) : ~report_dune_diagnostics (State.diagnostics state) in - let state = - let dune_context = Configuration.dune_context configuration in - State.set_dune_context state ~dune_context - in { state with configuration } | DidSaveTextDocument { textDocument = { uri }; _ } -> ( let state = Server.state server in @@ -944,8 +940,7 @@ let run channel ~dune_context ~read_dot_merlin () = Merlin_utils.Lib_config.set_program_name "ocamllsp"; Merlin_utils.Lib_config.System.set_run_in_directory (run_in_directory ()); Merlin_config.should_read_dot_merlin := read_dot_merlin; - Merlin_config.dune_context := - Option.map dune_context ~f:Config_data.DuneContext.of_string; + Merlin_config.dune_context := Option.map dune_context ~f:Fun.id; Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ())); Lev_fiber.run ~sigpipe:`Ignore (fun () -> let* input, output = stream_of_channel channel in diff --git a/ocaml-lsp-server/src/state.ml b/ocaml-lsp-server/src/state.ml index 7980003e1..c6a9bd253 100644 --- a/ocaml-lsp-server/src/state.ml +++ b/ocaml-lsp-server/src/state.ml @@ -25,7 +25,6 @@ type t = ; symbols_thread : Lev_fiber.Thread.t Lazy_fiber.t ; wheel : Lev_fiber.Timer.Wheel.t ; hover_extended : hover_extended - ; selected_context : Config_data.DuneContext.selected } let create ~store ~merlin ~detached ~configuration ~ocamlformat_rpc @@ -41,11 +40,8 @@ let create ~store ~merlin ~detached ~configuration ~ocamlformat_rpc ; symbols_thread ; wheel ; hover_extended = { history = None } - ; selected_context = Default } -let dune_context t = t.selected_context - let wheel t = t.wheel let initialize_params (state : t) = @@ -107,9 +103,6 @@ let modify_workspaces t ~f = in { t with init } -let set_dune_context (t : t) ~dune_context = - { t with selected_context = dune_context } - let client_capabilities t = (initialize_params t).capabilities let experimental_client_capabilities t = diff --git a/ocaml-lsp-server/src/state.mli b/ocaml-lsp-server/src/state.mli index f0e96bc07..49ef2af71 100644 --- a/ocaml-lsp-server/src/state.mli +++ b/ocaml-lsp-server/src/state.mli @@ -31,7 +31,6 @@ type t = ; symbols_thread : Lev_fiber.Thread.t Lazy_fiber.t ; wheel : Lev_fiber.Timer.Wheel.t ; hover_extended : hover_extended - ; selected_context : Config_data.DuneContext.selected } val create : @@ -67,10 +66,6 @@ val dune : t -> Dune.t val modify_workspaces : t -> f:(Workspaces.t -> Workspaces.t) -> t -val dune_context : t -> Config_data.DuneContext.selected - -val set_dune_context : t -> dune_context:Config_data.DuneContext.selected -> t - (** @return client capabilities passed from the client in [InitializeParams]; use [exp_client_caps] to get {i experimental} client capabilities. diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 4f6a87413..4ce8ca390 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -50,7 +50,6 @@ completion doc_to_md document_flow - dune_context for_ppx hover_extended inlay_hints diff --git a/ocaml-lsp-server/test/e2e-new/dune_context.ml b/ocaml-lsp-server/test/e2e-new/dune_context.ml deleted file mode 100644 index 89f4cb439..000000000 --- a/ocaml-lsp-server/test/e2e-new/dune_context.ml +++ /dev/null @@ -1,88 +0,0 @@ -open Test.Import - -let client_capabilities = ClientCapabilities.create () - -let uri = DocumentUri.of_path "test.ml" - -let test ?extra_env text req = - let handler = - Client.Handler.make - ~on_notification:(fun client _notification -> - Client.state client; - Fiber.return ()) - () - in - Test.run ~handler ?extra_env (fun client -> - let run_client () = - Client.start - client - (InitializeParams.create ~capabilities:client_capabilities ()) - in - let run () = - let* (_ : InitializeResult.t) = Client.initialized client in - let textDocument = - TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text - in - let* () = - Client.notification - client - (TextDocumentDidOpen - (DidOpenTextDocumentParams.create ~textDocument)) - in - let* () = req client in - let* () = Client.request client Shutdown in - Client.stop client - in - Fiber.fork_and_join_unit run_client run) - -let print_hover hover = - match hover with - | None -> print_endline "no hover response" - | Some hover -> - hover |> Hover.yojson_of_t - |> Yojson.Safe.pretty_to_string ~std:false - |> print_endline - -let change_config client params = - Client.notification client (ChangeConfiguration params) - -let hover client position = - Client.request - client - (TextDocumentHover - { HoverParams.position - ; textDocument = TextDocumentIdentifier.create ~uri - ; workDoneToken = None - }) - -let%expect_test "supports changing Dune context configuration" = - let source = - {ocaml| -type foo = int option - -let foo_value : foo = Some 1 -|ocaml} - in - let position = Position.create ~line:3 ~character:4 in - let req client = - let* () = - change_config - client - (DidChangeConfigurationParams.create - ~settings: - (`Assoc [ ("duneContext", `Assoc [ ("value", `String "alt") ]) ])) - in - let* resp = hover client position in - let () = print_hover resp in - Fiber.return () - in - test source req; - [%expect - {| - { - "contents": { "kind": "plaintext", "value": "foo" }, - "range": { - "end": { "character": 13, "line": 3 }, - "start": { "character": 4, "line": 3 } - } - } |}]