monadIO-0.11.1.0: Overloading of concurrency variables

Copyright(c) 2010 Galois Inc.
LicenseBSD-style (see the file libraries/base/LICENSE)
MaintainerJohn Launchbury, john@galois.com
Stabilityexperimental
Portabilityconcurrency
Safe HaskellSafe
LanguageHaskell98

Control.Concurrent.MonadIO

Description

Overloads the standard operations on MVars, Chans, and threads, as defined in Control.Concurrent. This module is name-for-name swappable with Control.Concurrent unless ghc-specific operations like mergeIO or threadWaitRead are used.

The standard operations on MVar and Chan (such as newEmptyMVar, or putChan) are overloaded over the MonadIO class. A monad m is declared an instance of MonadIO by defining a function

liftIO :: IO a -> m a

The explicit concurrency operations over threads are available if a monad m is declared an instance of the HasFork class, by defining a function

fork :: m () -> m ThreadId
  • Example use.

Suppose you define a new monad (EIO say) which is like IO except that it provides an environment too. You will need to declare EIO and instance of the Monad class. In addition, you can declare it in the MonadIO class. For example:

  newtype EIO a = EIO {useEnv :: Env -> IO a}
	
  instance MonadIO EIO where
    liftIO m = EIO $ (\_ -> m)

Now the standard operations on MVar and Chan (such as newEmptyMVar, or putChan are immediately available as EIO operations. To enable EIO to fork explicit threads, and to access operations such as killThread and threadDelay, use the declaration

 instance HasFork EIO where
   fork em = EIO $ \e -> forkIO (em `useEnv` e)
  • Notes.

The MVar operations do not include: withMVar, modifyMVar, or addMVarFinalizer. Consider using TMVars for these instead. In particular, modifyMVar seems to promise atomicity, but it is NOT atomic. In contrast TMVars can be used just like MVars, and they will behave the way you expect (module Control.Concurrent.STM.MonadIO).

Synopsis

Documentation

class Monad m => MonadIO (m :: * -> *) where #

Monads in which IO computations may be embedded. Any monad built by applying a sequence of monad transformers to the IO monad will be an instance of this class.

Instances should satisfy the following laws, which state that liftIO is a transformer of monads:

Minimal complete definition

liftIO

Methods

liftIO :: IO a -> m a #

Lift a computation from the IO monad.

Instances
MonadIO IO

Since: base-4.9.0.0

Instance details

Defined in Control.Monad.IO.Class

Methods

liftIO :: IO a -> IO a #

data MVar a #

An MVar (pronounced "em-var") is a synchronising variable, used for communication between concurrent threads. It can be thought of as a a box, which may be empty or full.

Instances
Eq (MVar a)

Since: base-4.1.0.0

Instance details

Defined in GHC.MVar

Methods

(==) :: MVar a -> MVar a -> Bool #

(/=) :: MVar a -> MVar a -> Bool #

newEmptyMVar :: MonadIO io => io (MVar a) Source #

newMVar :: MonadIO io => a -> io (MVar a) Source #

takeMVar :: MonadIO io => MVar a -> io a Source #

putMVar :: MonadIO io => MVar a -> a -> io () Source #

readMVar :: MonadIO io => MVar a -> io a Source #

swapMVar :: MonadIO io => MVar a -> a -> io a Source #

tryTakeMVar :: MonadIO io => MVar a -> io (Maybe a) Source #

tryPutMVar :: MonadIO io => MVar a -> a -> io Bool Source #

isEmptyMVar :: MonadIO io => MVar a -> io Bool Source #

data Chan a #

Chan is an abstract type representing an unbounded FIFO channel.

Instances
Eq (Chan a) 
Instance details

Defined in Control.Concurrent.Chan

Methods

(==) :: Chan a -> Chan a -> Bool #

(/=) :: Chan a -> Chan a -> Bool #

newChan :: MonadIO io => io (Chan a) Source #

writeChan :: MonadIO io => Chan a -> a -> io () Source #

readChan :: MonadIO io => Chan a -> io a Source #

dupChan :: MonadIO io => Chan a -> io (Chan a) Source #

unGetChan :: MonadIO io => Chan a -> a -> io () Source #

getChanContents :: MonadIO io => Chan a -> io [a] Source #

writeList2Chan :: MonadIO io => Chan a -> [a] -> io () Source #

class MonadIO io => HasFork io where Source #

Minimal complete definition

fork

Methods

fork :: io () -> io ThreadId Source #

Instances
HasFork IO Source # 
Instance details

Defined in Control.Concurrent.MonadIO

Methods

fork :: IO () -> IO ThreadId Source #

data ThreadId #

A ThreadId is an abstract type representing a handle to a thread. ThreadId is an instance of Eq, Ord and Show, where the Ord instance implements an arbitrary total ordering over ThreadIds. The Show instance lets you convert an arbitrary-valued ThreadId to string form; showing a ThreadId value is occasionally useful when debugging or diagnosing the behaviour of a concurrent program.

Note: in GHC, if you have a ThreadId, you essentially have a pointer to the thread itself. This means the thread itself can't be garbage collected until you drop the ThreadId. This misfeature will hopefully be corrected at a later date.

Instances
Eq ThreadId

Since: base-4.2.0.0

Instance details

Defined in GHC.Conc.Sync

Ord ThreadId

Since: base-4.2.0.0

Instance details

Defined in GHC.Conc.Sync

Show ThreadId

Since: base-4.2.0.0

Instance details

Defined in GHC.Conc.Sync

forkIO :: IO () -> IO ThreadId Source #

Included to maintain name-for-name compatibility with Control.Concurrent

killThread :: HasFork io => ThreadId -> io () Source #

throwTo :: (Exception e, HasFork io) => ThreadId -> e -> io () Source #

yield :: HasFork io => io () Source #

threadDelay :: HasFork io => Int -> io () Source #