2 files changed, 41 insertions, 0 deletions
diff --git a/src/BatchedRunner.hs b/src/BatchedRunner.hs
new file mode 100644
index 0000000..83a704c
--- /dev/null
+++ b/src/BatchedRunner.hs
@@ -0,0 +1,40 @@
+module BatchedRunner (
+    Runner,
+    makeRunner,
+    stopRunner,
+    notifyRunner,
+    withRunner
+) where
+
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Concurrent.STM.TMVar
+import Control.Exception (bracket)
+import Control.Monad.STM
+import Control.Monad (unless, void)
+import Data.Maybe (fromMaybe)
+
+newtype Runner = Runner (TMVar Bool)
+
+makeRunner :: IO a -> Int {- µs -} -> IO Runner
+makeRunner f n = do
+    mv <- newEmptyTMVarIO
+    _ <- forkIO $ runnerLoop mv
+    return $ Runner mv
+
+  where runnerLoop mv = do
+            b <- atomically $ takeTMVar mv
+            unless b $ do
+                threadDelay n
+                -- clear the TMVar; we're running f now
+                mayB <- atomically $ tryTakeTMVar mv
+                _ <- f
+                unless (fromMaybe False mayB) $ runnerLoop mv
+
+stopRunner :: Runner -> IO ()
+stopRunner (Runner mv) = atomically $ putTMVar mv True
+
+notifyRunner :: Runner -> IO ()
+notifyRunner (Runner mv) = void $ atomically $ tryPutTMVar mv False
+
+withRunner :: IO a -> Int -> (Runner -> IO b) -> IO b
+withRunner f n = bracket (makeRunner f n) stopRunner
diff --git a/src/Main.hs b/src/Main.hs
index ec4204a..049e709 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,6 +20,7 @@ import Auth
 import BangState
 import Config
 import Data.PendingBang
+import BatchedRunner
 
 data Search = Search {
     bangState :: BangState,