diff --git a/ocaml-lsp-server/src/document.ml b/ocaml-lsp-server/src/document.ml index fd45fdb7f..5e3e36f69 100644 --- a/ocaml-lsp-server/src/document.ml +++ b/ocaml-lsp-server/src/document.ml @@ -259,6 +259,8 @@ module Merlin = struct let with_pipeline (t : t) f = Single_pipeline.use t.pipeline ~doc:t.tdoc ~config:t.merlin_config ~f + let mconfig (t : t) = Merlin_config.config t.merlin_config + let with_pipeline_exn doc f = let+ res = with_pipeline doc f in match res with diff --git a/ocaml-lsp-server/src/document.mli b/ocaml-lsp-server/src/document.mli index 4e793f265..0b1728a70 100644 --- a/ocaml-lsp-server/src/document.mli +++ b/ocaml-lsp-server/src/document.mli @@ -78,6 +78,8 @@ module Merlin : sig val kind : t -> Kind.t val to_doc : t -> doc + + val mconfig : t -> Mconfig.t Fiber.t end val kind : t -> [ `Merlin of Merlin.t | `Other ] diff --git a/ocaml-lsp-server/src/document_store.ml b/ocaml-lsp-server/src/document_store.ml index e5b8508c9..a87c1ba5a 100644 --- a/ocaml-lsp-server/src/document_store.ml +++ b/ocaml-lsp-server/src/document_store.ml @@ -204,6 +204,12 @@ let change_all t ~f = in Table.set t.db uri doc) +let fold t ~init ~f = + Table.fold t.db ~init ~f:(fun doc acc -> + match doc.document with + | None -> acc + | Some x -> f x acc) + let close_all t = Fiber.of_thunk (fun () -> let docs = Table.fold t.db ~init:[] ~f:(fun doc acc -> doc :: acc) in diff --git a/ocaml-lsp-server/src/document_store.mli b/ocaml-lsp-server/src/document_store.mli index 90a1c03d2..abfe9804a 100644 --- a/ocaml-lsp-server/src/document_store.mli +++ b/ocaml-lsp-server/src/document_store.mli @@ -28,6 +28,8 @@ val get_semantic_tokens_cache : t -> Uri.t -> semantic_tokens_cache option val close_document : t -> Uri.t -> unit Fiber.t +val fold : t -> init:'acc -> f:(Document.t -> 'acc -> 'acc) -> 'acc + val change_all : t -> f:(Document.t -> Document.t Fiber.t) -> unit Fiber.t val close_all : t -> unit Fiber.t diff --git a/ocaml-lsp-server/src/merlin_config_command.ml b/ocaml-lsp-server/src/merlin_config_command.ml new file mode 100644 index 000000000..b89a57ab6 --- /dev/null +++ b/ocaml-lsp-server/src/merlin_config_command.ml @@ -0,0 +1,35 @@ +open Import +open Fiber.O + +let command_name = "ocamllsp/show-merlin-config" + +let command_run server store = + let* json = + let+ docs = + Document_store.fold store ~init:[] ~f:(fun doc acc -> + match Document.kind doc with + | `Other -> acc + | `Merlin m -> m :: acc) + |> Fiber.parallel_map ~f:(fun doc -> + let+ config = Document.Merlin.mconfig doc in + let config : Json.t = (Mconfig.dump config :> Json.t) in + let uri = Document.uri (Document.Merlin.to_doc doc) in + (Uri.to_string uri, config)) + in + let json = `Assoc docs in + Format.asprintf "%a@.%!" Json.pp json + in + let uri, chan = + Filename.open_temp_file + (sprintf "merlin-config.%d" (Unix.getpid ())) + ".json" + in + output_string chan json; + close_out_noerr chan; + let req = + let uri = Uri.of_path uri in + Server_request.ShowDocumentRequest + (ShowDocumentParams.create ~uri ~takeFocus:true ()) + in + let+ { ShowDocumentResult.success = _ } = Server.request server req in + () diff --git a/ocaml-lsp-server/src/merlin_config_command.mli b/ocaml-lsp-server/src/merlin_config_command.mli new file mode 100644 index 000000000..0619ec7d7 --- /dev/null +++ b/ocaml-lsp-server/src/merlin_config_command.mli @@ -0,0 +1,5 @@ +open Import + +val command_name : string + +val command_run : _ Server.t -> Document_store.t -> unit Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index a857955a3..45ed32dfb 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -102,7 +102,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : window.showDocument) then view_metrics_command_name :: Action_open_related.command_name - :: Dune.commands + :: Merlin_config_command.command_name :: Dune.commands else Dune.commands in ExecuteCommandOptions.create ~commands () @@ -817,7 +817,14 @@ let on_request : later (fun state () -> workspace_symbol server state req) () | CodeActionResolve ca -> now ca | ExecuteCommand command -> - if String.equal command.command view_metrics_command_name then + if String.equal command.command Merlin_config_command.command_name then + later + (fun state server -> + let store = state.store in + let+ () = Merlin_config_command.command_run server store in + `Null) + server + else if String.equal command.command view_metrics_command_name then later (fun _state server -> view_metrics server) server else if String.equal command.command Action_open_related.command_name then later diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index c25875542..da27ca37e 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -64,7 +64,7 @@ let%expect_test "start/stop" = "executeCommandProvider": { "commands": [ "ocamllsp/view-metrics", "ocamllsp/open-related-source", - "dune/promote" + "ocamllsp/show-merlin-config", "dune/promote" ] }, "experimental": {