Control.Concurrent.CHP.Connect
Description
A module of operators for connecting processes together.
This whole module was added in version 1.7.0.
- class Connectable l r where
- (<=>) :: Connectable l r => (a -> l -> CHP ()) -> (r -> b -> CHP ()) -> a -> b -> CHP ()
- (|<=>) :: Connectable l r => (l -> CHP ()) -> (r -> b -> CHP ()) -> b -> CHP ()
- (<=>|) :: Connectable l r => (a -> l -> CHP ()) -> (r -> CHP ()) -> a -> CHP ()
- (|<=>|) :: Connectable l r => (l -> CHP ()) -> (r -> CHP ()) -> CHP ()
- pipelineConnect :: Connectable l r => [r -> l -> CHP ()] -> r -> l -> CHP ()
- pipelineConnectComplete :: Connectable l r => (l -> CHP ()) -> [r -> l -> CHP ()] -> (r -> CHP ()) -> CHP ()
- pipelineConnectCompleteT :: Connectable l r => ([a] -> CHP b) -> (l -> a) -> [r -> l -> a] -> (r -> a) -> CHP b
- cycleConnect :: Connectable l r => [r -> l -> CHP ()] -> CHP ()
- connectList :: Connectable l r => Int -> ([(l, r)] -> CHP a) -> CHP a
- connectList_ :: Connectable l r => Int -> ([(l, r)] -> CHP a) -> CHP ()
- data ChannelPair l r
- class ConnectableExtra l r where
- type ConnectableParam l
- connectExtra :: ConnectableParam l -> ((l, r) -> CHP ()) -> CHP ()
- connectWith :: ConnectableExtra l r => ConnectableParam l -> (a -> l -> CHP ()) -> (r -> b -> CHP ()) -> a -> b -> CHP ()
Documentation
class Connectable l r whereSource
Indicates that its two parameters can be joined together automatically.
Rather than use connect
directly, you will want to use the operators such
as '(=)'. There are different forms of this operator for in the middle of
a pipeline (where you still need further parameters to each process), and at
the ends. See also pipelineConnect
and pipelineConnectComplete
.
Methods
connect :: ((l, r) -> CHP a) -> CHP aSource
Runs the given code with the two items connected.
The type of this function was generalised in CHP 1.8.0
from ((l, r) -> CHP ()) -> CHP ()
to ((l, r) -> CHP a) -> CHP a
Instances
Connectable (Chanout a) (Chanin a) | |
Connectable (Chanin a) (Chanout a) | |
(Connectable al ar, Connectable bl br) => Connectable (al, bl) (ar, br) | |
Connectable (Enrolled PhasedBarrier ()) (Enrolled PhasedBarrier ()) | |
Connectable l r => Connectable (ChannelPair l r) (ChannelPair l r) | |
(Connectable al ar, Connectable bl br, Connectable cl cr) => Connectable (al, bl, cl) (ar, br, cr) | |
(Connectable al ar, Connectable bl br, Connectable cl cr, Connectable dl dr) => Connectable (al, bl, cl, dl) (ar, br, cr, dr) | |
(Connectable al ar, Connectable bl br, Connectable cl cr, Connectable dl dr, Connectable el er) => Connectable (al, bl, cl, dl, el) (ar, br, cr, dr, er) |
(<=>) :: Connectable l r => (a -> l -> CHP ()) -> (r -> b -> CHP ()) -> a -> b -> CHP ()Source
Joins together the given two processes and runs them in parallel.
(|<=>) :: Connectable l r => (l -> CHP ()) -> (r -> b -> CHP ()) -> b -> CHP ()Source
Joins together the given two processes and runs them in parallel.
(<=>|) :: Connectable l r => (a -> l -> CHP ()) -> (r -> CHP ()) -> a -> CHP ()Source
Joins together the given two processes and runs them in parallel.
(|<=>|) :: Connectable l r => (l -> CHP ()) -> (r -> CHP ()) -> CHP ()Source
Joins together the given two processes and runs them in parallel.
pipelineConnect :: Connectable l r => [r -> l -> CHP ()] -> r -> l -> CHP ()Source
Like foldl1 (=)
; connects a pipeline of processes together. If the list
is empty, it returns a process that ignores both its arguments and returns instantly.
pipelineConnectComplete :: Connectable l r => (l -> CHP ()) -> [r -> l -> CHP ()] -> (r -> CHP ()) -> CHP ()Source
Connects the given beginning process, the list of middle processes, and the end process into a pipeline and runs them all in parallel. If the list is empty, it connects the beginning directly to the end.
pipelineConnectCompleteT :: Connectable l r => ([a] -> CHP b) -> (l -> a) -> [r -> l -> a] -> (r -> a) -> CHP bSource
Like pipelineConnectComplete
but allows a customised function to run all
the processes in parallel. So pipelineConnectCompleteT runParallel
is the
same as pipelineConnectComplete
. The list of items given to the first function
will be in the order: begin process, middle processes, end process, as you would
expect.
This function was added in version 1.8.0.
cycleConnect :: Connectable l r => [r -> l -> CHP ()] -> CHP ()Source
Like pipelineConnect
but also connects the last process into the first.
If the list is empty, it returns immediately.
connectList :: Connectable l r => Int -> ([(l, r)] -> CHP a) -> CHP aSource
Like connect
, but provides the process a list of items of the specified size,
and runs it.
This function was added in version 1.8.0.
connectList_ :: Connectable l r => Int -> ([(l, r)] -> CHP a) -> CHP ()Source
Like connectList
but ignores the results.
This function was added in version 1.8.0.
data ChannelPair l r Source
A pair of channels. The main use of this type is with the Connectable class,
as it allows you to wire together two processes that take the exact same channel
pair, e.g. both are of type ChannelPair (Chanin Int) (Chanout Int) -> CHP ()
. With the
normal Connectable pair instances, one would need to be of type (Chanin Int,
Chanout Int) -> CHP ()
, and the other of type (Chanout Int, Chanin Int) ->
CHP ()
.
Instances
(Eq l, Eq r) => Eq (ChannelPair l r) | |
(Show l, Show r) => Show (ChannelPair l r) | |
Connectable l r => Connectable (ChannelPair l r) (ChannelPair l r) |
class ConnectableExtra l r whereSource
Like Connectable
, but allows an extra parameter.
The API (and name) for this is still in flux, so do not rely on it just yet.
Associated Types
type ConnectableParam l Source
Methods
connectExtra :: ConnectableParam l -> ((l, r) -> CHP ()) -> CHP ()Source
Runs the given code with the two items connected.
Instances
ConnectableExtra (Chanout a) (Chanin a) | |
ConnectableExtra (Chanin a) (Chanout a) | |
(ConnectableExtra al ar, ConnectableExtra bl br) => ConnectableExtra (al, bl) (ar, br) | |
ConnectableExtra (Enrolled PhasedBarrier ph) (Enrolled PhasedBarrier ph) | |
(ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr) => ConnectableExtra (al, bl, cl) (ar, br, cr) | |
(ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr, ConnectableExtra dl dr) => ConnectableExtra (al, bl, cl, dl) (ar, br, cr, dr) | |
(ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr, ConnectableExtra dl dr, ConnectableExtra el er) => ConnectableExtra (al, bl, cl, dl, el) (ar, br, cr, dr, er) |
connectWith :: ConnectableExtra l r => ConnectableParam l -> (a -> l -> CHP ()) -> (r -> b -> CHP ()) -> a -> b -> CHP ()Source
Like '(=)' but with ConnectableExtra