Source

screentime-monitor / rule_store.ml

Full commit
open Core.Std
open Async.Std

type t = { dir: string }

module Status = struct
  type t = Acked | Unacked with sexp, bin_io
end

module For_user = struct
  type t = { acked: Rule.Name.Set.t
           ; rules: Rule.t list With_format.t
           }
  with sexp, bin_io
end

let create ~dir =
  let open Deferred.Or_error.Monad_infix in
  return (Ok { dir })

let fname t user =
  t.dir ^/ Username.to_string user

let load t user =
  Common.load_file
    For_user.t_of_sexp
    ~default:(fun () ->
      { For_user.
        acked = Rule.Name.Set.empty
      ; rules = With_format.create (module Rule.List) []
      })
    (fname t user)

let save t user ruleset =
  let fname = fname t user in
  Common.ensure_dirname_exists ~fname
  >>= fun () ->
  Writer.save_sexp fname (For_user.sexp_of_t ruleset)

let ack t user rule_name =
  load t user
  >>= fun for_user ->
  save t user 
    { for_user with acked = Set.add for_user.acked rule_name }

let unack t user rule_name =
  load t user
  >>=  fun for_user ->
  save t user 
    { for_user with acked = Set.remove for_user.acked rule_name }

let set_rules t user new_rules =
  load t user
  >>= fun for_user ->
  save t user { for_user with rules = new_rules }

let get_rules t user =
  load t user
  >>| fun for_user ->
  for_user.rules

let get_rules_with_status t user =
  load t user
  >>| fun for_user ->
  List.map (With_format.get for_user.rules) ~f:(fun rule ->
    (rule, if Set.mem for_user.acked rule.name then Status.Acked else Unacked))

let clear_acks_on_other_rules t user to_keep =
  load t user
  >>= fun for_user ->
  save t user (
    let to_keep = Rule.Name.Set.of_list to_keep in
    let acked = Set.diff for_user.acked (Set.diff for_user.acked to_keep) in
    { for_user with acked }
  )