Configurable Merlin cache period

Author: 3Rafal

lsp/src/cli.ml

@@ -12,6 +12,7 @@ module Arg = struct
     ; mutable stdio : bool
     ; mutable spec : (string * Arg.spec * string) list
     ; mutable clientProcessId : int option
+    ; mutable cachePeriod : int option
     }
 
   let port t ~name ~description =
@@ -30,6 +31,7 @@ module Arg = struct
       ; stdio = false
       ; spec = []
       ; clientProcessId = None
+      ; cachePeriod = None
       }
     in
     let spec =
@@ -52,7 +54,7 @@ module Arg = struct
 
   let clientProcessId t = t.clientProcessId
 
-  let channel { pipe; port; stdio; spec = _; clientProcessId = _ } :
+  let channel { pipe; port; stdio; spec = _; clientProcessId = _; cachePeriod = _ } :
       (Channel.t, string) result =
     match (pipe, port, stdio) with
     | None, None, _ -> Ok Stdio

ocaml-lsp-server/bin/main.ml

@@ -5,13 +5,16 @@ let () =
   Printexc.record_backtrace true;
   let version = ref false in
   let read_dot_merlin = ref false in
+  let cache_period = 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" )
+    ; ( "--cache-period", Arg.Int (fun period -> cache_period := Some period)
+      , "set the Merlin file cache period")
     ]
     @ Cli.Arg.spec arg
   in
@@ -39,7 +42,8 @@ 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 ~read_dot_merlin:!read_dot_merlin
+           ~cache_period:!cache_period)
     with
     | Ok () -> ()
     | Error exn ->

ocaml-lsp-server/src/merlin_config.ml

@@ -47,6 +47,8 @@ module List = struct
   let filter_dup lst = filter_dup' ~equiv:(fun x -> x) lst
 end
 
+let cache_period = ref None
+
 module Config = struct
   type t =
     { build_path : string list
@@ -60,6 +62,7 @@ module Config = struct
     ; reader : string list
     ; exclude_query_dir : bool
     ; use_ppx_cache : bool
+    ; cache_period : int option
     }
 
   let empty =
@@ -74,6 +77,7 @@ module Config = struct
     ; reader = []
     ; exclude_query_dir = false
     ; use_ppx_cache = false
+    ; cache_period = None
     }
 
   (* Parses suffixes pairs that were supplied as whitespace separated pairs
@@ -133,6 +137,7 @@ module Config = struct
       ; reader = config.reader
       ; exclude_query_dir = config.exclude_query_dir
       ; use_ppx_cache = config.use_ppx_cache
+      ; cache_period = config.cache_period
       }
 
   let merge t (merlin : Mconfig.merlin) failures config_path =
@@ -149,6 +154,7 @@ module Config = struct
     ; flags_to_apply = t.flags @ merlin.flags_to_apply
     ; failures = failures @ merlin.failures
     ; config_path = Some config_path
+    ; cache_period = Option.value !cache_period ~default:merlin.cache_period
     }
 end
 

ocaml-lsp-server/src/merlin_config.mli

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

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -917,10 +917,12 @@ 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 ~read_dot_merlin ~cache_period () =
   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.cache_period := cache_period;
+
   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,4 @@
-val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit
+val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> cache_period:int option -> unit -> unit
 
 module Diagnostics = Diagnostics
 module Version = Version