[khatus.git] / x3 / src / exe / khatus_cache_dumper.ml

open Khatus

let main ~stream ~interval ~dir =
  let dumped = Time.init in
  ignore (Msg_stream.fold stream ~init:dumped ~f:(
    fun dumped ~state:(State.({node; modul; time = now; cache;})) ~msg:_ ->
      let elapsed = Time.diff dumped now in
      if (Time.Span.is_gt_or_eq elapsed interval)
      then begin
        Cache.dump_to_dir cache ~time:now ~node ~modul ~dir;
        now
      end else
        dumped
  ))

let () =
  let modul          = __MODULE__ in
  let node           = Sys.argv.(1) in
  let dump_interval  = Sys.argv.(2) |> Time.Span.of_string in
  let dump_directory = Sys.argv.(3) in
  main
    ~stream:   (Msg_stream.init ~node ~modul)
    ~interval: dump_interval
    ~dir:      dump_directory
Commit	Line	Data
c6a7396e SK	1	open Khatus
c6a7396e SK	2
6f35286a SK	3	let main ~stream ~interval ~dir =
	4	let dumped = Time.init in
	5	ignore (Msg_stream.fold stream ~init:dumped ~f:(
	6	fun dumped ~state:(State.({node; modul; time = now; cache;})) ~msg:_ ->
	7	let elapsed = Time.diff dumped now in
	8	if (Time.Span.is_gt_or_eq elapsed interval)
	9	then begin
	10	Cache.dump_to_dir cache ~time:now ~node ~modul ~dir;
	11	now
	12	end else
	13	dumped
	14	))
c6a7396e SK	15
c6a7396e SK	16	let () =
6f35286a SK	17	let modul = __MODULE__ in
	18	let node = Sys.argv.(1) in
	19	let dump_interval = Sys.argv.(2) \|> Time.Span.of_string in
	20	let dump_directory = Sys.argv.(3) in
c6a7396e	21	main
6f35286a SK	22	~stream: (Msg_stream.init ~node ~modul)
	23	~interval: dump_interval
	24	~dir: dump_directory