module Control.Biegunka.Execute.Watcher
(
Watcher, new, wait, register, unregister, done, waitDone
) where
import Control.Concurrent.STM (atomically, retry)
import Control.Concurrent.STM.TVar
import Control.Monad (when, unless)
import Control.Monad.Trans (MonadIO(..))
import Data.Set (Set)
import qualified Data.Set as S
import Control.Biegunka.Language (Token)
data Watcher = Watcher (TVar Int) (TVar (Set Token))
new :: IO Watcher
new = do
jobsvar <- newTVarIO 0
donevar <- newTVarIO S.empty
return (Watcher jobsvar donevar)
wait :: Watcher -> IO ()
wait (Watcher var _) = atomically $ do
jobs <- readTVar var
when (jobs > 0)
retry
register :: MonadIO m => Watcher -> m ()
register (Watcher jobsvar _) = liftIO $ atomically (modifyTVar' jobsvar succ)
unregister :: MonadIO m => Watcher -> m ()
unregister (Watcher jobsvar _) = liftIO . atomically $
modifyTVar' jobsvar pred
done :: MonadIO m => Watcher -> Token -> m ()
done (Watcher _ donevar) tok = liftIO . atomically $
modifyTVar' donevar (S.insert tok)
waitDone :: MonadIO m => Watcher -> Set Token -> m ()
waitDone (Watcher _ donevar) waits = liftIO . atomically $ do
dones <- readTVar donevar
unless (waits `S.isSubsetOf` dones)
retry