chp-1.5.1: An implementation of concurrency ideas from Communicating Sequential ProcessesSource codeContentsIndex
Control.Concurrent.CHP.Arrow
Description

Provides an instance of Arrow for process pipelines. As described in the original paper on arrows, they can be used to represent stream processing, so CHP seemed like a possible fit for an arrow.

Whether this is actually an instance of Arrow depends on technicalities. This can be demonstrated with the arrow law arr id >>> f = f = f >>> arr id. Whether CHP satisfies this arrow law depends on the definition of equality.

  • If equality means that given the same input value, both arrows produce the same corresponding output value, this is an arrow.
  • If equality means you give the arrows the same single input and wait for the single output, and the output is the same, this is an arrow.
  • If equality means that you can feed the arrows lots of inputs (one after the other) and the behaviour should be the same with regards to communication, this is not an arrow.

The problem lies in the buffering inherent in arrows. Imagine if f is a single function. f is effectively a buffer of one. You can feed it a single value, but no more than that until you read its output. However, if you have arr id >>> f, that can accept two inputs (one held by the arr id process and one held by f) before you must accept the output.

I am fairly confident that the arrow laws are satisfied for the definition of equality that given the same single input, they will produce the same single output. If you don't worry too much about the behavioural difference, and just take arrows as another way to wire together a certain class of process network, you should do fine.

Added in version 1.0.2.

Synopsis
data ProcessPipeline a b
runPipeline :: ProcessPipeline a b -> Chanin a -> Chanout b -> CHP ()
arrowProcess :: (Chanin a -> Chanout b -> CHP ()) -> ProcessPipeline a b
arrStrict :: NFData b => (a -> b) -> ProcessPipeline a b
data ProcessPipelineLabel a b
runPipelineLabel :: ProcessPipelineLabel a b -> Chanin a -> Chanout b -> CHP ()
arrowProcessLabel :: String -> (Chanin a -> Chanout b -> CHP ()) -> ProcessPipelineLabel a b
arrLabel :: String -> (a -> b) -> ProcessPipelineLabel a b
arrStrictLabel :: NFData b => String -> (a -> b) -> ProcessPipelineLabel a b
(*>>>*) :: Show b => ProcessPipelineLabel a b -> ProcessPipelineLabel b c -> ProcessPipelineLabel a c
(*<<<*) :: Show b => ProcessPipelineLabel b c -> ProcessPipelineLabel a b -> ProcessPipelineLabel a c
(*&&&*) :: (Show b, Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b c' -> ProcessPipelineLabel b (c, c')
(*****) :: (Show b, Show b', Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b' c' -> ProcessPipelineLabel (b, b') (c, c')
Documentation
data ProcessPipeline a b Source
The type that is an instance of Arrow for process pipelines. See runPipeline.
show/hide Instances
runPipeline :: ProcessPipeline a b -> Chanin a -> Chanout b -> CHP ()Source

Given a ProcessPipeline (formed using its Arrow instance) and the channels to plug into the ends of the pipeline, returns the process representing the pipeline.

The pipeline will run forever (until poisoned) and you must run it in parallel to whatever is feeding it the inputs and reading off the outputs. Imagine that you want a process pipeline that takes in a pair of numbers, doubles the first and adds one to the second. You could encode this in an arrow using:

 runPipeline (arr (*2) *** arr (+1))

Arrows are more useful where you already have processes written that process data and you want to easily wire them together. The arrow notation is probably easier for doing that than declaring all the channels yourself and composing everything in parallel.

arrowProcess :: (Chanin a -> Chanout b -> CHP ()) -> ProcessPipeline a bSource

Adds a wrapper that forms this process into the right data type to be part of an arrow.

Any process you apply this to should produce exactly one output per input, or else you will find odd behaviour resulting (including deadlock). So for example, don't use arrowProcess (Control.Concurrent.CHP.Common.filter ...) or arrowProcess Control.Concurrent.CHP.Common.stream inside any arrow combinators other than >>> and <<<.

Added in version 1.1.0

arrStrict :: NFData b => (a -> b) -> ProcessPipeline a bSource

Like the arr function of the ProcessPipeline arrow instance, but fully evaluates the result before sending it. If you are building process pipelines with arrows to try and get some parallel speed-up, you should try this function instead of arr itself.

Added in version 1.3.2

data ProcessPipelineLabel a b Source

ProcessPipelineLabel is a version of ProcessPipeline that allows the processes to be labelled, and thus in turn for the channels connecting the processes to be automatically labelled. ProcessPipelineLabel is not an instance of Arrow, but it does have a lot of similarly named functions for working with it. This awkwardness is due to the extra Show constraints on the connectors that allow the arrow's contents to appear in traces.

If you don't use traces, use ProcessPipeline. If you do use traces, and want to have better labels on the process and values used in your arrows, consider switching to ProcessPipelineLabel.

ProcessPipelineLabel and all the functions that use it, were added in version 1.5.0.

runPipelineLabel :: ProcessPipelineLabel a b -> Chanin a -> Chanout b -> CHP ()Source
Like runPipeline but for ProcessPipelineLabel
arrowProcessLabel :: String -> (Chanin a -> Chanout b -> CHP ()) -> ProcessPipelineLabel a bSource
Like arrowProcess, but allows the process to be labelled. The same warnings as arrowProcess apply.
arrLabel :: String -> (a -> b) -> ProcessPipelineLabel a bSource
Like arr for ProcessPipeline, but allows the process to be labelled.
arrStrictLabel :: NFData b => String -> (a -> b) -> ProcessPipelineLabel a bSource
Like arrStrict, but allows the process to be labelled.
(*>>>*) :: Show b => ProcessPipelineLabel a b -> ProcessPipelineLabel b c -> ProcessPipelineLabel a cSource
The '(>>>)' arrow combinator, for ProcessPipelineLabel.
(*<<<*) :: Show b => ProcessPipelineLabel b c -> ProcessPipelineLabel a b -> ProcessPipelineLabel a cSource
The '(<<<)' arrow combinator, for ProcessPipelineLabel.
(*&&&*) :: (Show b, Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b c' -> ProcessPipelineLabel b (c, c')Source
The '(&&&)' arrow combinator, for ProcessPipelineLabel.
(*****) :: (Show b, Show b', Show c, Show c') => ProcessPipelineLabel b c -> ProcessPipelineLabel b' c' -> ProcessPipelineLabel (b, b') (c, c')Source
The '(***)' arrow combinator, for ProcessPipelineLabel.
Produced by Haddock version 2.4.2