Configurable Merlin cache period

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.opam

@@ -44,6 +44,10 @@ depends: [
  "ocaml"
  "merlin-lib" {>= "4.9" & < "5.0"}
 ]
+# Temporary pin until merlin gets released
+pin-depends: [
+ "merlin-lib.4.12" "git+https://github.com/ocaml/merlin.git#master"
+]
 dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git"
 build: [
  ["dune" "subst"] {dev}

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 cache_lifespan = 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" )
+ ; ( "--merlin-cache-lifespan"
+ , Arg.Int (fun period -> cache_lifespan := Some period)
+ , "set the Merlin file cache lifespan")
  ]
  @ Cli.Arg.spec arg
  in
@@ -39,7 +43,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_lifespan:!cache_lifespan)
  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_lifespan = 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_lifespan : int option
  }
 
  let empty =
@@ -74,6 +77,7 @@ module Config = struct
  ; reader = []
  ; exclude_query_dir = false
  ; use_ppx_cache = false
+ ; cache_lifespan = 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_lifespan = config.cache_lifespan
  }
 
  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_lifespan = Option.value !cache_lifespan ~default:merlin.cache_lifespan
  }
 end
 

ocaml-lsp-server/src/merlin_config.mli

@@ -6,6 +6,8 @@ type t
 
 val should_read_dot_merlin : bool ref
 
+val cache_lifespan : 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_lifespan () =
  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_lifespan := cache_lifespan;
+
  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_lifespan:int option -> unit -> unit
 
 module Diagnostics = Diagnostics
 module Version = Version