Commits

Yaron Minsky committed e395095

finished up alert functionality

  • Participants
  • Parent commits 13b70da

Comments (0)

Files changed (4)

     ~version:1
     ~bin_query:Q.bin_t
     ~bin_response:Unit.bin_t
+
+let unacknowledge =
+  let module Q = struct
+    type t = Username.t * Rule.Name.t with bin_io
+  end in
+  Rpc.Rpc.create
+    ~name:"unacknowledge"
+    ~version:1
+    ~bin_query:Q.bin_t
+    ~bin_response:Unit.bin_t

File protocol.mli

 val get_rules : (Username.t, Rule.t list With_format.t) Rpc.Rpc.t
 val set_rules : (Username.t * Rule.t list With_format.t, unit) Rpc.Rpc.t
 val acknowledge : (Username.t * Rule.Name.t, unit) Rpc.Rpc.t
+val unacknowledge : (Username.t * Rule.Name.t, unit) Rpc.Rpc.t

File rule_client.ml

 let violation_pipe user conn =
   let (r,w) = Pipe.create () in
   let stop = Pipe.closed r in
-  Clock.every' (sec 10.) ~stop (fun () ->
+  Clock.every' (sec 1.) ~stop (fun () ->
       Rpc.Rpc.dispatch_exn Protocol.todays_violations conn user
       >>= fun violations -> 
       if Pipe.is_closed w then Deferred.unit
     r
 end
 
+let throttle limit ~if_not_run =
+  let last_time = ref Time.epoch in
+  stage (fun f ->
+      let now = Time.now () in
+      let time_since =Time.diff now !last_time in
+      if Time.Span.(time_since > limit) then (
+        last_time := now;
+        f ()
+      ) else
+        if_not_run ()
+    )
+
+
 let monitor_violations user conn ~stop =
   let r = Full_violation.get_pipe user conn in
+  let alert_throttle =
+    unstage (throttle (sec 30.) ~if_not_run:(fun () -> Deferred.unit))
+  in
   upon stop (fun () -> Pipe.close_read r);
   Pipe.iter r ~f:(fun violations ->
       clear_screen ()
         ~f:(fun {Full_violation. rule;exceeded_by;status=_;reportable} ->
             if not reportable then Deferred.unit
             else
-              Notify.spawn
-                ~title:"Screentime exceeded"
-                ~sound:`Default
-                ~execute:"true"
-                (sprintf "'%s' exceeded by %s"
-                   (Rule.Name.to_string rule.Rule.name)
-                   (Time.Span.to_string exceeded_by))
-          ))
+              alert_throttle (fun () ->
+                  printf ".\n";
+                  (* Command to execute when popup is clicked *)
+                  let execute =
+                    sprintf "%s rules ack '%s'"
+                      (Filename.realpath Sys.argv.(0))
+                      (Rule.Name.to_string rule.name)
+                  in
+                  print_endline execute;
+                  Notify.spawn
+                    ~title:"Screentime exceeded"
+                    ~sound:`Default
+                    ~execute
+                    (sprintf "'%s' exceeded by %s"
+                       (Rule.Name.to_string rule.Rule.name)
+                       (Time.Span.to_string exceeded_by))
+                )))
 
 let monitor_violations =
   Command.async_basic
          Rpc.Rpc.dispatch_exn Protocol.acknowledge conn (user,rule)
        ))
 
+let unack =
+  Command.async_basic
+    ~summary:"Unacknowledge a rule, and prevent futher warnings"
+    Command.Spec.(
+      shared_flags ()
+      +> anon ("rule" %: Arg_type.create Rule.Name.of_string)
+    )
+    (fun user rule () -> setup_conn user (fun user conn ->
+         Rpc.Rpc.dispatch_exn Protocol.unacknowledge conn (user,rule)
+       ))
+
 let command =
   Command.group
     ~summary:"Tools for interacting with screentime rules"
     ; "violations" , rule_violations
     ; "monitor"    , monitor_violations
     ; "ack"        , ack
+    ; "unack"      , unack
     ]
 let acknowledge t (user,rule) =
   Rule_store.ack t.rules user rule
 
+let unacknowledge t (user,rule) =
+  Rule_store.unack t.rules user rule
+
 let implementations =
   let module P = Protocol in
   let (++) = Rpc.Rpc.implement in
    ; P.get_rules         ++ get_rules
    ; P.set_rules         ++ set_rules
    ; P.acknowledge       ++ acknowledge
+   ; P.unacknowledge     ++ unacknowledge
   ]