lib/khatus_cache.ml

   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   )