module Control.Concurrent.STM.CTMVar
(
CTMVar
, newCTMVar
, newEmptyCTMVar
, takeCTMVar
, putCTMVar
, readCTMVar
, tryTakeCTMVar
, tryPutCTMVar
, tryReadCTMVar
, isEmptyCTMVar
, swapCTMVar
) where
import Control.Monad (liftM, when, unless)
import Control.Monad.STM.Class
import Data.Maybe (isJust, isNothing)
newtype CTMVar m a = CTMVar (CTVar m (Maybe a))
newCTMVar :: MonadSTM m => a -> m (CTMVar m a)
newCTMVar a = do
ctvar <- newCTVar $ Just a
return $ CTMVar ctvar
newEmptyCTMVar :: MonadSTM m => m (CTMVar m a)
newEmptyCTMVar = do
ctvar <- newCTVar Nothing
return $ CTMVar ctvar
takeCTMVar :: MonadSTM m => CTMVar m a -> m a
takeCTMVar ctmvar = do
taken <- tryTakeCTMVar ctmvar
maybe retry return taken
putCTMVar :: MonadSTM m => CTMVar m a -> a -> m ()
putCTMVar ctmvar a = do
putted <- tryPutCTMVar ctmvar a
unless putted retry
readCTMVar :: MonadSTM m => CTMVar m a -> m a
readCTMVar ctmvar = do
readed <- tryReadCTMVar ctmvar
maybe retry return readed
tryTakeCTMVar :: MonadSTM m => CTMVar m a -> m (Maybe a)
tryTakeCTMVar (CTMVar ctvar) = do
val <- readCTVar ctvar
when (isJust val) $ writeCTVar ctvar Nothing
return val
tryPutCTMVar :: MonadSTM m => CTMVar m a -> a -> m Bool
tryPutCTMVar (CTMVar ctvar) a = do
val <- readCTVar ctvar
when (isNothing val) $ writeCTVar ctvar (Just a)
return $ isNothing val
tryReadCTMVar :: MonadSTM m => CTMVar m a -> m (Maybe a)
tryReadCTMVar (CTMVar ctvar) = readCTVar ctvar
isEmptyCTMVar :: MonadSTM m => CTMVar m a -> m Bool
isEmptyCTMVar ctmvar = isNothing `liftM` tryReadCTMVar ctmvar
swapCTMVar :: MonadSTM m => CTMVar m a -> a -> m a
swapCTMVar ctmvar a = do
val <- takeCTMVar ctmvar
putCTMVar ctmvar a
return val