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 $ do
    mayB <- tryReadTMVar mv
    case mayB of
        -- if stopped/stopping, do nothing
        Just True -> return ()
        -- if idle or working, block, such that the Runner has a chance to see that
        -- it should fire before stopping
        _ -> 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