feature: dump all merlin config (#922)

Signed-off-by: Rudi Grinberg <[email protected]>

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

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 ]

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

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

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
+  ()

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

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

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": {