| 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 | ) |