Commit | Line | Data |
---|---|---|
c6a7396e SK |
1 | module Hashtbl = MoreLabels.Hashtbl |
2 | ||
3 | module Msg = Khatus_msg | |
4 | module Time = Khatus_time | |
5 | ||
6 | type t = | |
7 | { values : ((string * string * string list), string) Hashtbl.t | |
8 | ; mtimes : ((string * string * string list), Time.t) Hashtbl.t | |
9 | } | |
10 | ||
11 | let create () = | |
12 | { values = Hashtbl.create 256 | |
13 | ; mtimes = Hashtbl.create 256 | |
14 | } | |
15 | ||
16 | let 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 | ||
21 | let 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 | ||
33 | let 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 | ) |