module Control.Concurrent.CVar
(
CVar
, newEmptyCVar
, newCVar
, takeCVar
, putCVar
, readCVar
, swapCVar
, tryTakeCVar
, tryPutCVar
, isEmptyCVar
, withCVar
, withCVarMasked
, modifyCVar_
, modifyCVar
, modifyCVarMasked_
, modifyCVarMasked
, lock
, unlock
) where
import Control.Monad (liftM)
import Control.Monad.Catch (mask_, onException)
import Control.Monad.Conc.Class
newCVar :: MonadConc m => a -> m (CVar m a)
newCVar a = do
cvar <- newEmptyCVar
putCVar cvar a
return cvar
swapCVar :: MonadConc m => CVar m a -> a -> m a
swapCVar cvar a = mask_ $ do
old <- takeCVar cvar
putCVar cvar a
return old
isEmptyCVar :: MonadConc m => CVar m a -> m Bool
isEmptyCVar cvar = do
val <- tryTakeCVar cvar
case val of
Just val' -> putCVar cvar val' >> return True
Nothing -> return False
withCVar :: MonadConc m => CVar m a -> (a -> m b) -> m b
withCVar cvar f = mask $ \restore -> do
val <- takeCVar cvar
out <- restore (f val) `onException` putCVar cvar val
putCVar cvar val
return out
withCVarMasked :: MonadConc m => CVar m a -> (a -> m b) -> m b
withCVarMasked cvar f = mask_ $ do
val <- takeCVar cvar
out <- f val `onException` putCVar cvar val
putCVar cvar val
return out
modifyCVar_ :: MonadConc m => CVar m a -> (a -> m a) -> m ()
modifyCVar_ cvar f = modifyCVar cvar $ liftM (\a -> (a,())) . f
modifyCVar :: MonadConc m => CVar m a -> (a -> m (a, b)) -> m b
modifyCVar cvar f = mask $ \restore -> do
val <- takeCVar cvar
(val', out) <- restore (f val) `onException` putCVar cvar val
putCVar cvar val'
return out
modifyCVarMasked_ :: MonadConc m => CVar m a -> (a -> m a) -> m ()
modifyCVarMasked_ cvar f = modifyCVarMasked cvar $ liftM (\a -> (a,())) . f
modifyCVarMasked :: MonadConc m => CVar m a -> (a -> m (a, b)) -> m b
modifyCVarMasked cvar f = mask_ $ do
val <- takeCVar cvar
(val', out) <- f val `onException` putCVar cvar val
putCVar cvar val'
return out
lock :: MonadConc m => CVar m () -> m ()
lock = flip putCVar ()
unlock :: MonadConc m => CVar m () -> m ()
unlock = takeCVar