1. Yaron Minsky
  2. screentime-monitor

Source

screentime-monitor / timelog.ml

open Core.Std
open Async.Std

type t = { dir: string }

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

let fname t username date =
  let date_str = Date.to_string date in
  t.dir ^/ Username.to_string username ^/ date_str

let load t username date =
  Common.load_file Daylog.t_of_sexp ~default:(fun () -> Daylog.empty)
    (fname t username date)

let set t username date daylog =
  let fname = fname t username date in
  Common.ensure_dirname_exists ~fname
  >>= fun () ->
  Writer.save_sexp fname (Daylog.sexp_of_t daylog)

let get t username date =
  load t username date

let update t username date k =
  load t username date
  >>= fun daylog ->
  set t username date (k daylog)

let update_today t username k =
  update t username (Date.today ()) k

let users t =
  Sys.ls_dir t.dir
  >>= fun subs ->
  Deferred.List.filter subs ~f:Sys.is_directory_exn
  >>= fun subdirs ->
  return (List.map ~f:Username.of_string subdirs)

let load_as_closed t user now =
  Sys.ls_dir (t.dir ^/ Username.to_string user)
  >>= fun dates ->
  (List.map ~f:Date.of_string dates
   |> Deferred.List.map ~f:(fun date ->
     load t user date
     >>| fun daylog ->
     (date, Daylog.close daylog date ~now)))
  >>| fun list ->
  Date.Map.of_alist_exn list

let report t user now =
  load_as_closed t user now
  >>| fun daylogs ->
  Map.map daylogs ~f:Daylog.Closed.span_map

let full_report t user now =
  load_as_closed t user now
  >>| fun daylogs ->
  Map.map daylogs ~f:Daylog.Closed.sessions