Lwt_util.idle_check

raphael-proust · rr0gi · commit 6faa0c5e3e3b · 2025-04-04T10:26:12.000-04:00
diff --git a/dune b/dune
@@ -68,7 +68,7 @@
 
 (executable
   (name test)
-  (libraries devkit extlib extunix libevent ocamlnet_lite ounit2 unix yojson)
+  (libraries lwt lwt.unix devkit extlib extunix libevent ocamlnet_lite ounit2 unix yojson)
   (modules test test_httpev))
 
 ; uses 8GB+ RAM, so do not run as part of test suite
diff --git a/lwt_util.ml b/lwt_util.ml
@@ -60,3 +60,17 @@ let action name f x =
 let action_do name f = action name f ()
 
 let async f = Lwt.async Daemon.(fun () -> try%lwt unless_exit (f ()) with ShouldExit -> Lwt.return_unit)
+
+let idle_check ~interval =
+  let timestamp = ref (Time.now ()) in
+  let stamp () = timestamp := Time.now () in
+  let rec wait () =
+    let idle = Time.ago !timestamp in
+    if idle > interval then
+      Lwt.return_unit
+    else begin
+      let%lwt () = Lwt_unix.sleep (interval -. idle) in
+      wait ()
+    end
+  in
+  (stamp, wait ())
diff --git a/lwt_util.mli b/lwt_util.mli
@@ -22,3 +22,13 @@ val action_do : string -> (unit -> 'a Lwt.t) -> 'a Lwt.t
 
 (** same as [Lwt.async] but also cancels task on {!Daemon.ShouldExit} *)
 val async : (unit -> unit Lwt.t) -> unit
+
+(** [idle_check ~interval] is a pair [(stamp,wait)] where you use
+    [stamp: unit -> unit] to indicate activity, and [wait : unit Lwt.t] is a
+    promise that resolves if there's been no calls to [stamp] during an
+    [interval].
+
+    This is typically used to manage a background task (e.g., periodically
+    fetching data from a remote source) based on whether there is ongoing
+    activity (e.g., whether the data is being used in the UI). *)
+val idle_check : interval:Time.duration -> ((unit -> unit) * unit Lwt.t)
diff --git a/test.ml b/test.ml
@@ -544,6 +544,35 @@ let () = test "Web.urlencode" @@ fun () ->
   assert_equal (Web.urlencode "Hello Günter") "Hello+G%C3%BCnter";
   ()
 
+let () =
+  let open Lwt.Syntax in
+  let rec pings f = function
+    | [] -> Lwt.return_unit
+    | t :: ts ->
+        let* () = Lwt_unix.sleep t in
+        f ();
+        pings f ts
+  in
+  test "Lwt_util.idle_check" @@ fun () ->
+  let accumulator = ref 0 in
+  let (s, w) = Lwt_util.idle_check ~interval:0.01 in
+  Lwt_main.run (
+    Lwt.pick [
+      pings (fun () -> incr accumulator; s ()) [0.001; 0.001; 0.001; 1.];
+      w
+    ]
+  );
+  assert_equal !accumulator 3;
+  let (s, w) = Lwt_util.idle_check ~interval:0.01 in
+  Lwt_main.run (
+    Lwt.pick [
+      pings (fun () -> incr accumulator; s ()) [0.001; 1.];
+      w
+    ]
+  );
+  assert_equal !accumulator 4;
+  ()
+
 let tests () =
   let (_:test_results) = run_test_tt_main ("devkit" >::: List.rev !tests) in
   ()
