Move remaining code out of bin
[khatus.git] / src / ocaml / lib / khatus_cache.ml
... / ...
CommitLineData
1module Hashtbl = MoreLabels.Hashtbl
2
3module Msg = Khatus_msg
4module Time = Khatus_time
5
6type t =
7 { values : ((string * string * string list), string) Hashtbl.t
8 ; mtimes : ((string * string * string list), Time.t) Hashtbl.t
9 }
10
11let create () =
12 { values = Hashtbl.create 256
13 ; mtimes = Hashtbl.create 256
14 }
15
16let update {values; mtimes} ~node ~modul ~key ~value:data ~time =
17 let key = (node, modul, key) in
18 Hashtbl.replace values ~key ~data;
19 Hashtbl.replace mtimes ~key ~data:time
20
21let update_if_data t ~msg ~time =
22 match msg with
23 | Msg.({content = Data {key; value}; node; modul}) ->
24 update t ~node ~modul ~key ~value ~time
25 | {Msg.content = Msg.Alert _; _}
26 | {Msg.content = Msg.Cache _; _}
27 | {Msg.content = Msg.Error _; _}
28 | {Msg.content = Msg.Log _; _}
29 | {Msg.content = Msg.Status_bar _; _}
30 ->
31 ()
32
33let dump {values; mtimes} ~node ~modul ~oc =
34 Hashtbl.iter values ~f:(fun ~key ~data:value ->
35 let mtime =
36 match Hashtbl.find_opt mtimes key with
37 | Some mtime -> mtime
38 | None -> assert false (* Implies update was incorrect *)
39 in
40 let (node', modul', key) = key in
41 let msg =
42 Msg.(to_string
43 { node
44 ; modul
45 ; content = Cache {mtime; node = node'; modul = modul'; key; value}
46 }
47 )
48 in
49 output_string
50 oc
51 (msg ^ "\n")
52 )
This page took 0.029434 seconds and 4 git commands to generate.