Source

screentime-monitor / rule_client.ml

open Core.Std
open Async.Std
open Client_common

let show_rules =
  Command.async_basic
    ~summary:"Retrieve the screentime rules"
    (shared_flags ())
    (fun username () -> setup_conn username (fun username conn ->
         Rpc.Rpc.dispatch_exn Protocol.get_rules conn username
         >>| fun rules ->
         printf "%s\n" (With_format.format rules)
       ))

let edit_rules =
  Command.async_basic
    ~summary:"Set the screentime rule"
    (shared_flags ())
    (fun username () -> setup_conn username (fun username conn ->
         Rpc.Rpc.dispatch_exn Protocol.get_rules conn username
         >>= fun rule ->
         let tempfile = Filename.temp_file "rule" ".scm" in
         Writer.save tempfile ~contents:(With_format.format rule)
         >>= fun () ->
         let editor =
           match Sys.getenv "EDITOR" with None -> "emacs" | Some x -> x
         in
         edit_file (module Rule.List) ~editor ~tempfile
         >>= function
         | None -> return ()
         | Some rules ->
           printf "Set the rules for %s? (y/N):" (Username.to_string username);
           Reader.read_line (Lazy.force Reader.stdin)
           >>= fun response ->
           let upload =
             match response with
             | `Eof -> false
             | `Ok s ->
               match s |> String.lowercase |> String.strip with
               | "y" | "yes" -> true
               | _ -> false
           in
           if not upload then
             (printf "Not setting rules.\n"; return ())
           else
             Rpc.Rpc.dispatch_exn Protocol.set_rules conn (username,rules)
             >>| fun () ->
             printf "Rules set\n"
       ))

let rule_violations =
  Command.async_basic
    ~summary:"Get any rule violations"
    (shared_flags ())
    (fun username () -> setup_conn username (fun username conn ->
         Rpc.Rpc.dispatch_exn Protocol.todays_violations conn username
         >>| fun violations ->
         violations
         |> <:sexp_of<(Rule.t * Time.Span.t * Rule_store.Status.t) list>>
         |> Sexp.to_string_hum
         |> printf "%s\n"
       ))

let print_violations violations =
  let module Ascii_table = Textutils.Std.Ascii_table in
  force clear_string
  >>= fun clear_string ->
  printf "%s" clear_string;
  let cols = 
    Ascii_table.(
      [ Column.create "rule"  (fun (r,_,_) -> r.Rule.name |> Rule.Name.to_string)
      ; Column.create "time"  (fun (_,s,_) -> Time.Span.to_string s)
      ; Column.create "status" (fun (_,_,(status : Rule_store.Status.t)) ->
          match status with Acked -> "Ack" | Unacked -> "-")
      ]
    )
  in
  printf "%s\n" (Ascii_table.to_string ~display:Ascii_table.Display.line cols violations);
  return ()
;;

let monitor_violations user conn ~stop =
  Clock.every' (sec 10.) ~stop (fun () ->
      Rpc.Rpc.dispatch_exn Protocol.todays_violations conn user
      >>= fun violations -> 
      print_violations violations
      >>= fun () ->
      Deferred.List.iter violations ~f:(fun (rule,exceeded_by,status) ->
          match (status : Rule_store.Status.t) with
          | Acked -> Deferred.unit
          | Unacked ->
            Notify.spawn
              ~title:"Screentime exceeded"
              ~sound:`Default
              (sprintf "\"%s\" exceeded by %s"
                          (Rule.Name.to_string rule.Rule.name)
                          (Time.Span.to_string exceeded_by))
            |> Deferred.ignore
        ))
;;

let monitor_violations =
  Command.async_basic
    ~summary:"Monitor for violations"
    (shared_flags ())
    (fun user () -> setup_conn user (fun user conn ->
         let stop = force on_term_signal in
         monitor_violations user conn ~stop;
         stop
       ))

let command =
  Command.group
    ~summary:"Tools for interacting with screentime rules"
    [ "show", show_rules
    ; "edit", edit_rules
    ; "violations", rule_violations
    ; "monitor",   monitor_violations
    ]