stm-io-hooks-1.1.2: Launch your IO-actions from within the STM monad

Copyright(c) Chris Kuklewicz 2006 Peter Robinson 2009
LicenseBSD3
MaintainerPeter Robinson <robinson@ecs.tuwien.ac.at>
Stabilityexperimental
Portabilitynon-portable (requires STM)
Safe HaskellNone
LanguageHaskell2010

Control.Concurrent.AdvSTM

Contents

Description

Extends Control.Concurrent.STM with IO hooks

Synopsis

Class MonadAdvSTM

class Monad m => MonadAdvSTM m where Source #

A type class for extended-STM monads. For a concrete instantiation see AdvSTM

Methods

onCommitWith Source #

Arguments

:: ([IO ()] -> IO ())

closure action

-> m () 

Takes a closure IO action and a commit IO action. The commit IO action will be executed iff the transaction commits. Commit actions are sequenced (within the same transaction), i.e.,

onCommitWith id (putStr "hello")
onCommitWith id (putStr " world")

will print "hello world".

The closure action is useful for encapsulating the commit actions, e.g., within a database transaction. The last call of onCommitWith in the transaction is applied to the sequence of commit actions, i.e.:

onCommitWith id (putStr "hello")
onCommitWith (\s -> do { putStrLn "start"; s; putStrLn "\nend"})  (putStr " world")
  • When a TVar was modified in a transaction and the transaction tries to commit, this update remains invisible to other threads until the corresponding onCommit action is dispatched.
  • If the onCommit action throws an exception, the original value of the TVars will be restored.
  • Accessing a modified TVar within the onCommit action will cause a Deadlock exception to be thrown.

As a general rule, onCommit should only be used for "real" (i.e. without atomic blocks) IO actions and is certainly not the right place to fiddle with TVars. For example, if you wanted to write a TVar value to a file on commit, you could write:

tvar <- newTVarIO "bla"
atomically $ do
   x <- readTVar tvar
   onCommit (writeFile "myfile" x)

Note: If you really need to access the TVar within an onCommit action (e.g. to recover from an IO exception), you can use writeTVarAsync.

onCommit :: IO () -> m () Source #

Works like onCommitWith without closure action: 'onCommit = onCommitWith id'

unsafeRetryWith :: IO () -> m b Source #

Retries the transaction and uses unsafeIOToSTM to fork off a thread that runs the given IO action. Since a transaction might be rerun several times by the runtime system, it is your responsibility to ensure that the IO-action is idempotent and releases all acquired locks.

orElse :: m a -> m a -> m a Source #

See orElse

retry :: m a Source #

See retry

check :: Bool -> m () Source #

See check

catchSTM :: Exception e => m a -> (e -> m a) -> m a Source #

liftAdv :: STM a -> m a Source #

Lifts STM actions to MonadAdvSTM.

readTVar :: TVar a -> m a Source #

Reads a value from a TVar. Blocks until the IO onCommit aidction(s) of the corresponding transaction are complete.is not the last function See onCommit for a more detailed description of this behaviour.

writeTVar :: TVar a -> a -> m () Source #

Writes a value to a TVar. Blocks until the onCommit IO-action(s) are complete. See onCommit for details.

readTVarAsync :: TVar a -> m a Source #

Reads a value directly from the TVar. Does not block when the onCommit actions aren't done yet. NOTE: Only use this function when you know what you're doing.

writeTVarAsync :: TVar a -> a -> m () Source #

Writes a value directly to the TVar. Does not block when onCommit actions aren't done yet. This function comes in handy for error recovery of exceptions that occur in onCommit.

newTVar :: a -> m (TVar a) Source #

Instances
MonadAdvSTM AdvSTM Source # 
Instance details

Defined in Control.Concurrent.AdvSTM

MonadAdvSTM m => MonadAdvSTM (StateT s m) Source # 
Instance details

Defined in Control.Monad.AdvSTM.Class

Methods

onCommitWith :: ([IO ()] -> IO ()) -> StateT s m () Source #

onCommit :: IO () -> StateT s m () Source #

unsafeRetryWith :: IO () -> StateT s m b Source #

orElse :: StateT s m a -> StateT s m a -> StateT s m a Source #

retry :: StateT s m a Source #

check :: Bool -> StateT s m () Source #

catchSTM :: Exception e => StateT s m a -> (e -> StateT s m a) -> StateT s m a Source #

liftAdv :: STM a -> StateT s m a Source #

readTVar :: TVar a -> StateT s m a Source #

writeTVar :: TVar a -> a -> StateT s m () Source #

readTVarAsync :: TVar a -> StateT s m a Source #

writeTVarAsync :: TVar a -> a -> StateT s m () Source #

newTVar :: a -> StateT s m (TVar a) Source #

unsafeIOToSTM :: IO a -> StateT s m a Source #

(MonadAdvSTM m, Monoid w) => MonadAdvSTM (WriterT w m) Source # 
Instance details

Defined in Control.Monad.AdvSTM.Class

Methods

onCommitWith :: ([IO ()] -> IO ()) -> WriterT w m () Source #

onCommit :: IO () -> WriterT w m () Source #

unsafeRetryWith :: IO () -> WriterT w m b Source #

orElse :: WriterT w m a -> WriterT w m a -> WriterT w m a Source #

retry :: WriterT w m a Source #

check :: Bool -> WriterT w m () Source #

catchSTM :: Exception e => WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a Source #

liftAdv :: STM a -> WriterT w m a Source #

readTVar :: TVar a -> WriterT w m a Source #

writeTVar :: TVar a -> a -> WriterT w m () Source #

readTVarAsync :: TVar a -> WriterT w m a Source #

writeTVarAsync :: TVar a -> a -> WriterT w m () Source #

newTVar :: a -> WriterT w m (TVar a) Source #

unsafeIOToSTM :: IO a -> WriterT w m a Source #

MonadAdvSTM m => MonadAdvSTM (ReaderT r m) Source # 
Instance details

Defined in Control.Monad.AdvSTM.Class

Methods

onCommitWith :: ([IO ()] -> IO ()) -> ReaderT r m () Source #

onCommit :: IO () -> ReaderT r m () Source #

unsafeRetryWith :: IO () -> ReaderT r m b Source #

orElse :: ReaderT r m a -> ReaderT r m a -> ReaderT r m a Source #

retry :: ReaderT r m a Source #

check :: Bool -> ReaderT r m () Source #

catchSTM :: Exception e => ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a Source #

liftAdv :: STM a -> ReaderT r m a Source #

readTVar :: TVar a -> ReaderT r m a Source #

writeTVar :: TVar a -> a -> ReaderT r m () Source #

readTVarAsync :: TVar a -> ReaderT r m a Source #

writeTVarAsync :: TVar a -> a -> ReaderT r m () Source #

newTVar :: a -> ReaderT r m (TVar a) Source #

unsafeIOToSTM :: IO a -> ReaderT r m a Source #

Monad AdvSTM

data AdvSTM a Source #

Drop-in replacement for the STM monad

Instances
Monad AdvSTM Source # 
Instance details

Defined in Control.Monad.AdvSTM.Def

Methods

(>>=) :: AdvSTM a -> (a -> AdvSTM b) -> AdvSTM b #

(>>) :: AdvSTM a -> AdvSTM b -> AdvSTM b #

return :: a -> AdvSTM a #

fail :: String -> AdvSTM a #

Functor AdvSTM Source # 
Instance details

Defined in Control.Monad.AdvSTM.Def

Methods

fmap :: (a -> b) -> AdvSTM a -> AdvSTM b #

(<$) :: a -> AdvSTM b -> AdvSTM a #

Applicative AdvSTM Source # 
Instance details

Defined in Control.Monad.AdvSTM.Def

Methods

pure :: a -> AdvSTM a #

(<*>) :: AdvSTM (a -> b) -> AdvSTM a -> AdvSTM b #

liftA2 :: (a -> b -> c) -> AdvSTM a -> AdvSTM b -> AdvSTM c #

(*>) :: AdvSTM a -> AdvSTM b -> AdvSTM b #

(<*) :: AdvSTM a -> AdvSTM b -> AdvSTM a #

Alternative AdvSTM Source # 
Instance details

Defined in Control.Monad.AdvSTM.Def

Methods

empty :: AdvSTM a #

(<|>) :: AdvSTM a -> AdvSTM a -> AdvSTM a #

some :: AdvSTM a -> AdvSTM [a] #

many :: AdvSTM a -> AdvSTM [a] #

MonadPlus AdvSTM Source # 
Instance details

Defined in Control.Monad.AdvSTM.Def

Methods

mzero :: AdvSTM a #

mplus :: AdvSTM a -> AdvSTM a -> AdvSTM a #

MonadAdvSTM AdvSTM Source # 
Instance details

Defined in Control.Concurrent.AdvSTM

handleSTM :: (MonadAdvSTM m, Exception e) => (e -> m a) -> m a -> m a Source #

A version of catchSTM with the arguments swapped around.

debugAdvSTM :: String -> Int -> AdvSTM () Source #

Uses unsafeIOToSTM to output the Thread Id and a message and delays for a given number of time. WARNING: Can lead to deadlocks!

debugMode :: Bool -> AdvSTM () Source #

Switches the debug mode on or off. WARNING: Can lead to deadlocks!

Orphan instances

MonadAdvSTM AdvSTM Source # 
Instance details