Support --context flag of dune ocaml-merlin

CHANGES.md

@@ -8,6 +8,8 @@
 
 - Support folding of `ifthenelse` expressions (#1031)
 
+- Add `--context` flag (#1238)
+
 ## Fixes
 
 - Detect document kind by looking at merlin's `suffixes` config.

ocaml-lsp-server/bin/main.ml

@@ -5,13 +5,17 @@ let () =
   Printexc.record_backtrace true;
   let version = ref false in
   let read_dot_merlin = ref false in
+  let dune_context = ref None in
   let arg = Lsp.Cli.Arg.create () in
   let spec =
     [ ("--version", Arg.Set version, "print version")
     ; ( "--fallback-read-dot-merlin"
       , Arg.Set read_dot_merlin
       , "read Merlin config from .merlin files. The `dot-merlin-reader` \
          package must be installed" )
+    ; ( "--context"
+      , Arg.String (fun p -> dune_context := Some p)
+      , "set Dune context" )
     ]
     @ Cli.Arg.spec arg
   in
@@ -39,7 +43,10 @@ let () =
     let module Exn_with_backtrace = Stdune.Exn_with_backtrace in
     match
       Exn_with_backtrace.try_with
-        (Ocaml_lsp_server.run channel ~read_dot_merlin:!read_dot_merlin)
+        (Ocaml_lsp_server.run
+           channel
+           ~dune_context:!dune_context
+           ~read_dot_merlin:!read_dot_merlin)
     with
     | Ok () -> ()
     | Error exn ->

ocaml-lsp-server/src/merlin_config.ml

@@ -30,6 +30,8 @@ open Fiber.O
 module Std = Merlin_utils.Std
 module Misc = Merlin_utils.Misc
 
+let dune_context = ref None
+
 module List = struct
   include List
 
@@ -192,7 +194,12 @@ module Process = struct
       let stdout_r, stdout_w = Unix.pipe () in
       Unix.set_close_on_exec stdin_w;
       let pid =
-        let argv = [ prog; "ocaml-merlin"; "--no-print-directory" ] in
+        let argv =
+          let shared = [ prog; "ocaml-merlin"; "--no-print-directory" ] in
+          match !dune_context with
+          | None -> shared
+          | Some dune_context -> shared @ [ "--context"; dune_context ]
+        in
         Pid.of_int
           (Spawn.spawn
              ~cwd:(Path dir)

ocaml-lsp-server/src/merlin_config.mli

@@ -6,6 +6,8 @@ type t
 
 val should_read_dot_merlin : bool ref
 
+val dune_context : string option ref
+
 val config : t -> Mconfig.t Fiber.t
 
 val destroy : t -> unit Fiber.t

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -931,10 +931,11 @@ let run_in_directory =
   let for_windows = !Merlin_utils.Std.System.run_in_directory in
   fun () -> if Sys.win32 then for_windows else run_in_directory
 
-let run channel ~read_dot_merlin () =
+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 := dune_context;
   Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ()));
   Lev_fiber.run ~sigpipe:`Ignore (fun () ->
       let* input, output = stream_of_channel channel in

ocaml-lsp-server/src/ocaml_lsp_server.mli

@@ -1,4 +1,9 @@
-val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit
+val run :
+     Lsp.Cli.Channel.t
+  -> dune_context:string option
+  -> read_dot_merlin:bool
+  -> unit
+  -> unit
 
 module Diagnostics = Diagnostics
 module Version = Version