chp-1.2.0: An implementation of concurrency ideas from Communicating Sequential ProcessesSource codeContentsIndex
Control.Concurrent.CHP.Monad
Contents
CHP Monad
LoopWhileT Monad
Primitive actions
Description
This module contains all the central monads in the CHP library.
Synopsis
data CHP a
class MonadIO m => MonadCHP m where
liftCHP :: CHP a -> m a
runCHP :: CHP a -> IO (Maybe a)
runCHP_ :: CHP a -> IO ()
onPoisonTrap :: CHP a -> CHP a -> CHP a
onPoisonRethrow :: CHP a -> CHP () -> CHP a
throwPoison :: CHP a
class Poisonable c where
poison :: MonadCHP m => c -> m ()
checkForPoison :: MonadCHP m => c -> m ()
poisonAll :: (Poisonable c, MonadCHP m) => [c] -> m ()
data Monad m => LoopWhileT m a
loop :: Monad m => LoopWhileT m a -> m ()
while :: Monad m => Bool -> LoopWhileT m ()
skip :: CHP ()
stop :: CHP ()
waitFor :: Int -> CHP ()
CHP Monad
data CHP a Source
The central monad of the library. You can use Control.Concurrent.CHP.Monad.runCHP and Control.Concurrent.CHP.Monad.runCHP_ to execute programs in this monad.
show/hide Instances
class MonadIO m => MonadCHP m whereSource
A monad transformer class that is very similar to MonadIO. This can be useful if you want to add monad transformers (such as StateT, ReaderT) on top of the CHP monad.
Methods
liftCHP :: CHP a -> m aSource
show/hide Instances
runCHP :: CHP a -> IO (Maybe a)Source
Runs a CHP program. You should use this once, at the top-level of your program. Do not ever use this function twice in parallel and attempt to communicate between those processes using channels. Instead, run this function once and use it to spawn off the parallel processes that you need.
runCHP_ :: CHP a -> IO ()Source
Runs a CHP program. Like runCHP but discards the output.
onPoisonTrap :: CHP a -> CHP a -> CHP aSource

Allows you to provide a handler for sections with poison. It is usually used in an infix form as follows:

 (readChannel c >>= writeChannel d) `onPoisonTrap` (poison c >> poison d)

It handles the poison and does not rethrow it (unless your handler does so). If you want to rethrow (and actually, you'll find you usually do), use onPoisonRethrow

onPoisonRethrow :: CHP a -> CHP () -> CHP aSource

Like onPoisonTrap, this function allows you to provide a handler for poison. The difference with this function is that even if the poison handler does not throw, the poison exception will always be re-thrown after the handler anyway. That is, the following lines of code all have identical behaviour:

 foo
 foo `onPoisonRethrow` throwPoison
 foo `onPoisonRethrow` return ()
throwPoison :: CHP aSource
Throws a poison exception.
class Poisonable c whereSource
A class indicating that something is poisonable.
Methods
poison :: MonadCHP m => c -> m ()Source
Poisons the given item.
checkForPoison :: MonadCHP m => c -> m ()Source

Checks if the given item is poisoned. If it is, a poison exception will be thrown.

Added in version 1.0.2.

show/hide Instances
poisonAll :: (Poisonable c, MonadCHP m) => [c] -> m ()Source
Poisons all the given items. A handy shortcut for mapM_ poison.
LoopWhileT Monad
data Monad m => LoopWhileT m a Source
A monad transformer for easier looping. This is independent of the CHP aspects, but has all the right type-classes defined for it to make it easy to use with the CHP library.
show/hide Instances
loop :: Monad m => LoopWhileT m a -> m ()Source
Runs the given action in a loop, executing it repeatedly until a while statement inside it has a False condition. If you use loop without while, the effect is the same as forever.
while :: Monad m => Bool -> LoopWhileT m ()Source
Continues executing the loop if the given value is True. If the value is False, the loop is broken immediately, and control jumps back to the next action after the outer loop statement. Thus you can build pre-condition, post-condition, and "mid-condition" loops, placing the condition wherever you like.
Primitive actions
skip :: CHP ()Source

The classic skip process/guard. Does nothing, and is always ready.

Suitable for use in an Control.Concurrent.CHP.Alt.alt.

stop :: CHP ()Source
The stop guard. Its main use is that it is never ready in a choice, so can be used to mask out guards. If you actually execute stop, that process will do nothing more. Any parent process waiting for it to complete will wait forever.
waitFor :: Int -> CHP ()Source

Waits for the specified number of microseconds (millionths of a second). There is no guaranteed precision, but the wait will never complete in less time than the parameter given.

Suitable for use in an Control.Concurrent.CHP.Alt.alt, but note that waitFor 0 is not the same as skip. waitFor 0 Control.Concurrent.CHP.Alt.</> x will not always select the first guard, depending on x. Included in this is the lack of guarantee that waitFor 0 Control.Concurrent.CHP.Alt.</> waitFor n will select the first guard for any value of n (including 0). It is not useful to use two waitFor guards in a single Control.Concurrent.CHP.Alt.alt anyway.

NOTE: If you wish to use this as part of a choice, you must use -threaded as a GHC compilation option (at least under 6.8.2).

Produced by Haddock version 2.4.2