Skip to content

Commit

Permalink
Configurable cache period
Browse files Browse the repository at this point in the history
  • Loading branch information
3Rafal committed Nov 9, 2023
1 parent f46ebad commit 727c450
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 1 deletion.
5 changes: 4 additions & 1 deletion src/frontend/ocamlmerlin/new/new_merlin.ml
Original file line number Diff line number Diff line change
Expand Up @@ -91,8 +91,11 @@ let run = function
(* Start processing query *)
Logger.with_log_file Mconfig.(config.merlin.log_file)
~sections:Mconfig.(config.merlin.log_sections) @@ fun () ->
let cache_period = match Lib_config.cache_period () with
| Some p -> p
| None -> Mconfig.(config.merlin.cache_period) in
Mocaml.flush_caches
~older_than:(float_of_int (60 * Mconfig.(config.merlin.cache_period))) ();
~older_than:(float_of_int (60 * cache_period)) ();
File_id.with_cache @@ fun () ->
let source = Msource.make (Misc.string_of_file stdin) in
let pipeline = Mpipeline.make config source in
Expand Down
7 changes: 7 additions & 0 deletions src/utils/lib_config.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,13 @@ let set_program_name name = program_name := name

let program_name () = !program_name


let cache_period = ref None

let set_cache_period period = cache_period := Some period

let cache_period () = !cache_period

module Json = struct
let set_pretty_to_string f =
Std.Json.pretty_to_string := f
Expand Down
6 changes: 6 additions & 0 deletions src/utils/lib_config.mli
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,12 @@ val set_program_name : string -> unit
[set_program]. Defaults to "Merlin". *)
val program_name : unit -> string

(** [set_cache_period] sets the file cache retention period. Measured in minutes. *)
val set_cache_period : int -> unit

(** [program ()] returns file cache retention period. Defaults to None. *)
val cache_period : unit -> int option

module Json : sig
(** Merlin's logger requires a Json pretty-printer for correct operation.
[set_pretty_to_string] can be used to provide one. A common pretifier
Expand Down

0 comments on commit 727c450

Please sign in to comment.