module Control.Concurrent.Classy.STM.TMVar
(
TMVar
, newTMVar
, newTMVarN
, newEmptyTMVar
, newEmptyTMVarN
, takeTMVar
, putTMVar
, readTMVar
, tryTakeTMVar
, tryPutTMVar
, tryReadTMVar
, isEmptyTMVar
, swapTMVar
) where
import Control.Monad (liftM, unless, when)
import Control.Monad.STM.Class
import Data.Maybe (isJust, isNothing)
newtype TMVar stm a = TMVar (TVar stm (Maybe a))
newTMVar :: MonadSTM stm => a -> stm (TMVar stm a)
newTMVar = newTMVarN ""
newTMVarN :: MonadSTM stm => String -> a -> stm (TMVar stm a)
newTMVarN n a = do
let n' = if null n then "ctmvar" else "ctmvar-" ++ n
ctvar <- newTVarN n' $ Just a
pure (TMVar ctvar)
newEmptyTMVar :: MonadSTM stm => stm (TMVar stm a)
newEmptyTMVar = newEmptyTMVarN ""
newEmptyTMVarN :: MonadSTM stm => String -> stm (TMVar stm a)
newEmptyTMVarN n = do
let n' = if null n then "ctmvar" else "ctmvar-" ++ n
ctvar <- newTVarN n' Nothing
pure (TMVar ctvar)
takeTMVar :: MonadSTM stm => TMVar stm a -> stm a
takeTMVar ctmvar = do
taken <- tryTakeTMVar ctmvar
maybe retry pure taken
putTMVar :: MonadSTM stm => TMVar stm a -> a -> stm ()
putTMVar ctmvar a = do
putted <- tryPutTMVar ctmvar a
unless putted retry
readTMVar :: MonadSTM stm => TMVar stm a -> stm a
readTMVar ctmvar = do
readed <- tryReadTMVar ctmvar
maybe retry pure readed
tryTakeTMVar :: MonadSTM stm => TMVar stm a -> stm (Maybe a)
tryTakeTMVar (TMVar ctvar) = do
val <- readTVar ctvar
when (isJust val) $ writeTVar ctvar Nothing
pure val
tryPutTMVar :: MonadSTM stm => TMVar stm a -> a -> stm Bool
tryPutTMVar (TMVar ctvar) a = do
val <- readTVar ctvar
when (isNothing val) $ writeTVar ctvar (Just a)
pure (isNothing val)
tryReadTMVar :: MonadSTM stm => TMVar stm a -> stm (Maybe a)
tryReadTMVar (TMVar ctvar) = readTVar ctvar
isEmptyTMVar :: MonadSTM stm => TMVar stm a -> stm Bool
isEmptyTMVar ctmvar = isNothing `liftM` tryReadTMVar ctmvar
swapTMVar :: MonadSTM stm => TMVar stm a -> a -> stm a
swapTMVar ctmvar a = do
val <- takeTMVar ctmvar
putTMVar ctmvar a
pure val