Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
STM helpers
Synopsis
- data STM a
- retry :: STM a
- atomically :: MonadIO m => STM a -> m a
- data TVar a
- newTVarIO :: MonadIO m => a -> m (TVar a)
- readTVarIO :: MonadIO m => TVar a -> m a
- writeTVar :: TVar a -> a -> STM ()
- writeTVarIO :: MonadIO m => TVar a -> a -> m ()
- readTVar :: TVar a -> STM a
- newTVar :: a -> STM (TVar a)
- swapTVar :: TVar a -> a -> STM a
- swapTVarIO :: MonadIO m => TVar a -> a -> m a
- modifyTVar :: TVar a -> (a -> a) -> STM ()
- modifyTVar' :: TVar a -> (a -> a) -> STM ()
- data TMVar a
- newTMVarIO :: MonadIO m => a -> m (TMVar a)
- isEmptyTMVar :: TMVar a -> STM Bool
- newEmptyTMVar :: STM (TMVar a)
- newEmptyTMVarIO :: IO (TMVar a)
- readTMVar :: TMVar a -> STM a
- takeTMVar :: TMVar a -> STM a
- putTMVar :: TMVar a -> a -> STM ()
- swapTMVar :: TMVar a -> a -> STM a
- tryReadTMVar :: TMVar a -> STM (Maybe a)
- tryPutTMVar :: TMVar a -> a -> STM Bool
- tryTakeTMVar :: TMVar a -> STM (Maybe a)
- data TChan a
- newBroadcastTChanIO :: MonadIO m => m (TChan a)
- newBroadcastTChan :: STM (TChan a)
- writeTChan :: TChan a -> a -> STM ()
- dupTChan :: TChan a -> STM (TChan a)
- cloneTChan :: TChan a -> STM (TChan a)
- readTChan :: TChan a -> STM a
Documentation
A monad supporting atomic memory transactions.
Instances
Monad STM | Since: base-4.3.0.0 |
Functor STM | Since: base-4.3.0.0 |
Applicative STM | Since: base-4.8.0.0 |
Alternative STM | Since: base-4.8.0.0 |
MonadPlus STM | Since: base-4.3.0.0 |
MonadBaseControl STM STM | |
type StM STM a | |
Defined in Control.Monad.Trans.Control |
Retry execution of the current memory transaction because it has seen
values in TVar
s which mean that it should not continue (e.g. the TVar
s
represent a shared buffer that is now empty). The implementation may
block the thread until one of the TVar
s that it has read from has been
updated. (GHC only)
atomically :: MonadIO m => STM a -> m a Source #
Execute an STM transaction atomically
TVar
Shared memory locations that support atomic memory transactions.
readTVarIO :: MonadIO m => TVar a -> m a Source #
Read a TVar in an IO monad
writeTVarIO :: MonadIO m => TVar a -> a -> m () Source #
Write a TVar in an IO monad
swapTVarIO :: MonadIO m => TVar a -> a -> m a Source #
Swap a TVar in an IO monad
modifyTVar :: TVar a -> (a -> a) -> STM () #
Mutate the contents of a TVar
. N.B., this version is
non-strict.
Since: stm-2.3
modifyTVar' :: TVar a -> (a -> a) -> STM () #
Strict version of modifyTVar
.
Since: stm-2.3
TMVar
A TMVar
is a synchronising variable, used
for communication between concurrent threads. It can be thought of
as a box, which may be empty or full.
newTMVarIO :: MonadIO m => a -> m (TMVar a) Source #
Create a TMVar
newEmptyTMVar :: STM (TMVar a) #
Create a TMVar
which is initially empty.
newEmptyTMVarIO :: IO (TMVar a) #
IO
version of newEmptyTMVar
. This is useful for creating top-level
TMVar
s using unsafePerformIO
, because using
atomically
inside unsafePerformIO
isn't
possible.
tryReadTMVar :: TMVar a -> STM (Maybe a) #
A version of readTMVar
which does not retry. Instead it
returns Nothing
if no value is available.
Since: stm-2.3
tryPutTMVar :: TMVar a -> a -> STM Bool #
tryTakeTMVar :: TMVar a -> STM (Maybe a) #
A version of takeTMVar
that does not retry
. The tryTakeTMVar
function returns Nothing
if the TMVar
was empty, or
if
the Just
aTMVar
was full with contents a
. After tryTakeTMVar
, the
TMVar
is left empty.
TChan
TChan
is an abstract type representing an unbounded FIFO channel.
newBroadcastTChanIO :: MonadIO m => m (TChan a) Source #
Create a broadcast channel
newBroadcastTChan :: STM (TChan a) #
Create a write-only TChan
. More precisely, readTChan
will retry
even after items have been written to the channel. The only way to read
a broadcast channel is to duplicate it with dupTChan
.
Consider a server that broadcasts messages to clients:
serve :: TChan Message -> Client -> IO loop serve broadcastChan client = do myChan <- dupTChan broadcastChan forever $ do message <- readTChan myChan send client message
The problem with using newTChan
to create the broadcast channel is that if
it is only written to and never read, items will pile up in memory. By
using newBroadcastTChan
to create the broadcast channel, items can be
garbage collected after clients have seen them.
Since: stm-2.4
writeTChan :: TChan a -> a -> STM () #
Write a value to a TChan
.
dupTChan :: TChan a -> STM (TChan a) #
Duplicate a TChan
: the duplicate channel begins empty, but data written to
either channel from then on will be available from both. Hence this creates
a kind of broadcast channel, where data written by anyone is seen by
everyone else.