scc-0.2: Streaming component combinatorsSource codeContentsIndex
Control.Concurrent.SCC.ComponentTypes
Contents
Classes
Types
Lifting functions
Utility functions
Synopsis
class Component c where
name :: c -> String
subComponents :: c -> [AnyComponent]
maxUsableThreads :: c -> Int
usingThreads :: Int -> c -> c
usedThreads :: c -> Int
cost :: c -> Int
class BranchComponent cc m x r | cc -> m x where
combineBranches :: String -> Int -> (forall c. Bool -> (Source c x -> Pipe c m r) -> (Source c x -> Pipe c m r) -> Source c x -> Pipe c m r) -> cc -> cc -> cc
data AnyComponent = forall a . Component a => AnyComponent a
data Performer m r = Performer {
performerName :: String
performerMaxThreads :: Int
performerConfiguration :: ComponentConfiguration
performerUsingThreads :: Int -> (ComponentConfiguration, forall c. Pipe c m r)
perform :: forall c. Pipe c m r
}
data Consumer m x r = Consumer {
consumerName :: String
consumerMaxThreads :: Int
consumerConfiguration :: ComponentConfiguration
consumerUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Pipe c m r)
consume :: forall c. Source c x -> Pipe c m r
}
data Producer m x r = Producer {
producerName :: String
producerMaxThreads :: Int
producerConfiguration :: ComponentConfiguration
producerUsingThreads :: Int -> (ComponentConfiguration, forall c. Sink c x -> Pipe c m r)
produce :: forall c. Sink c x -> Pipe c m r
}
data Splitter m x = Splitter {
splitterName :: String
splitterMaxThreads :: Int
splitterConfiguration :: ComponentConfiguration
splitterUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x], forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x])
split :: forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x]
splitSections :: forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x]
}
data Transducer m x y = Transducer {
transducerName :: String
transducerMaxThreads :: Int
transducerConfiguration :: ComponentConfiguration
transducerUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Sink c y -> Pipe c m [x])
transduce :: forall c. Source c x -> Sink c y -> Pipe c m [x]
}
data ComponentConfiguration = ComponentConfiguration {
componentChildren :: [AnyComponent]
componentThreads :: Int
componentCost :: Int
}
liftPerformer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Pipe c m r)) -> Performer m r
liftConsumer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Pipe c m r)) -> Consumer m x r
liftAtomicConsumer :: String -> Int -> (forall c. Source c x -> Pipe c m r) -> Consumer m x r
liftProducer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Sink c x -> Pipe c m r)) -> Producer m x r
liftAtomicProducer :: String -> Int -> (forall c. Sink c x -> Pipe c m r) -> Producer m x r
liftTransducer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c y -> Pipe c m [x])) -> Transducer m x y
liftAtomicTransducer :: String -> Int -> (forall c. Source c x -> Sink c y -> Pipe c m [x]) -> Transducer m x y
lift121Transducer :: (Monad m, Typeable x, Typeable y) => String -> (x -> y) -> Transducer m x y
liftStatelessTransducer :: (Monad m, Typeable x, Typeable y) => String -> (x -> [y]) -> Transducer m x y
liftFoldTransducer :: (Monad m, Typeable x, Typeable y) => String -> (s -> x -> s) -> s -> (s -> y) -> Transducer m x y
liftStatefulTransducer :: (Monad m, Typeable x, Typeable y) => String -> (state -> x -> (state, [y])) -> state -> Transducer m x y
liftSimpleSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x])) -> Splitter m x
liftSectionSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x])) -> Splitter m x
liftAtomicSimpleSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x]) -> Splitter m x
liftAtomicSectionSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x]) -> Splitter m x
liftStatelessSplitter :: (ParallelizableMonad m, Typeable x) => String -> (x -> Bool) -> Splitter m x
showComponentTree :: forall c. Component c => c -> String
optimalTwoParallelConfigurations :: (Component c1, Component c2) => Int -> c1 -> c2 -> (ComponentConfiguration, c1, c2, Bool)
optimalTwoSequentialConfigurations :: (Component c1, Component c2) => Int -> c1 -> c2 -> (ComponentConfiguration, c1, c2)
optimalThreeParallelConfigurations :: (Component c1, Component c2, Component c3) => Int -> c1 -> c2 -> c3 -> (ComponentConfiguration, (c1, Bool), (c2, Bool), (c3, Bool))
Classes
class Component c whereSource
The types of Component class carry metadata and can be configured to use a specific number of threads.
Methods
name :: c -> StringSource
subComponents :: c -> [AnyComponent]Source
Returns the list of all children components.
maxUsableThreads :: c -> IntSource
Returns the maximum number of threads that can be used by the component.
usingThreads :: Int -> c -> cSource
Configures the component to use the specified number of threads. This function affects usedThreads, cost, and subComponents methods of the result, while name and maxUsableThreads remain the same.
usedThreads :: c -> IntSource
The number of threads that the component is configured to use. By default the number is usually 1.
cost :: c -> IntSource
The cost of using the component as configured.
show/hide Instances
class BranchComponent cc m x r | cc -> m x whereSource
BranchComponent is a type class representing all components that can act as consumers, namely Consumer, Transducer, and Splitter.
Methods
combineBranches :: String -> Int -> (forall c. Bool -> (Source c x -> Pipe c m r) -> (Source c x -> Pipe c m r) -> Source c x -> Pipe c m r) -> cc -> cc -> ccSource
combineBranches is used to combine two components in BranchComponent class into one, using the given Consumer binary combinator.
show/hide Instances
(ParallelizableMonad m, Typeable x) => BranchComponent (Splitter m x) m x ([] x)
(ParallelizableMonad m, Typeable x) => BranchComponent (Splitter m x) m x ([] x)
Monad m => BranchComponent (Consumer m x r) m x r
BranchComponent (Transducer m x y) m x ([] x)
BranchComponent (Transducer m x y) m x ([] x)
Monad m => BranchComponent (Consumer m x ()) m x ([] x)
Monad m => BranchComponent (Consumer m x ()) m x ([] x)
Types
data AnyComponent Source
AnyComponent is an existential type wrapper around a Component.
Constructors
forall a . Component a => AnyComponent a
show/hide Instances
data Performer m r Source
A component that performs a computation with no inputs nor outputs is a Performer.
Constructors
Performer
performerName :: String
performerMaxThreads :: Int
performerConfiguration :: ComponentConfiguration
performerUsingThreads :: Int -> (ComponentConfiguration, forall c. Pipe c m r)
perform :: forall c. Pipe c m r
show/hide Instances
(ParallelizableMonad m, Typeable x) => PipeableComponentPair m x (Producer m x ()) (Consumer m x ()) (Performer m ())
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (PerformerType r) TransducerType m ([] x) ([] y) (Transducer m x y) (Performer m r) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (PerformerType r) TransducerType TransducerType m ([] x) ([] y) (Performer m r) (Transducer m x y) (Transducer m x y)
ParallelizableMonad m => JoinableComponentPair (PerformerType r1) (PerformerType r2) (PerformerType r2) m () () (Performer m r1) (Performer m r2) (Performer m r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (PerformerType r1) (ProducerType r2) (ProducerType r2) m () ([] x) (Performer m r1) (Producer m x r2) (Producer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (ProducerType r1) (PerformerType r2) (ProducerType r2) m () ([] x) (Producer m x r1) (Performer m r2) (Producer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (PerformerType r1) (ConsumerType r2) (ConsumerType r2) m ([] x) () (Performer m r1) (Consumer m x r2) (Consumer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (ConsumerType r1) (PerformerType r2) (ConsumerType r2) m ([] x) () (Consumer m x r1) (Performer m r2) (Consumer m x r2)
Component (Performer m r)
(AnyListOrUnit x, AnyListOrUnit y) => CompatibleSignature (Performer m r) (PerformerType r) m x y
data Consumer m x r Source
A component that consumes values from a Source is called Consumer. data Consumer m x r = Consumer {consumerData :: ComponentData (forall c. Source c x -> Pipe c m r), consume :: forall c. Source c x -> Pipe c m r}
Constructors
Consumer
consumerName :: String
consumerMaxThreads :: Int
consumerConfiguration :: ComponentConfiguration
consumerUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Pipe c m r)
consume :: forall c. Source c x -> Pipe c m r
show/hide Instances
(ParallelizableMonad m, Typeable x) => PipeableComponentPair m x (Producer m x ()) (Consumer m x ()) (Performer m ())
(ParallelizableMonad m, Typeable x, Typeable y) => PipeableComponentPair m y (Transducer m x y) (Consumer m y r) (Consumer m x r)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (ConsumerType ()) TransducerType m ([] x) ([] y) (Transducer m x y) (Consumer m x ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ConsumerType ()) TransducerType TransducerType m ([] x) ([] y) (Consumer m x ()) (Transducer m x y) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ProducerType ()) (ConsumerType ()) TransducerType m ([] x) ([] y) (Producer m y ()) (Consumer m x ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ConsumerType ()) (ProducerType ()) TransducerType m ([] x) ([] y) (Consumer m x ()) (Producer m y ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (PerformerType r1) (ConsumerType r2) (ConsumerType r2) m ([] x) () (Performer m r1) (Consumer m x r2) (Consumer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (ConsumerType r1) (PerformerType r2) (ConsumerType r2) m ([] x) () (Consumer m x r1) (Performer m r2) (Consumer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (ConsumerType ()) (ConsumerType ()) (ConsumerType ()) m ([] x) () (Consumer m x ()) (Consumer m x ()) (Consumer m x ())
Component (Consumer m x r)
Monad m => BranchComponent (Consumer m x r) m x r
Monad m => BranchComponent (Consumer m x ()) m x ([] x)
AnyListOrUnit y => CompatibleSignature (Consumer m x r) (ConsumerType r) m ([] x) y
data Producer m x r Source
A component that produces values and puts them into a Sink is called Producer.
Constructors
Producer
producerName :: String
producerMaxThreads :: Int
producerConfiguration :: ComponentConfiguration
producerUsingThreads :: Int -> (ComponentConfiguration, forall c. Sink c x -> Pipe c m r)
produce :: forall c. Sink c x -> Pipe c m r
show/hide Instances
(ParallelizableMonad m, Typeable x) => PipeableComponentPair m x (Producer m x ()) (Consumer m x ()) (Performer m ())
(ParallelizableMonad m, Typeable x, Typeable y) => PipeableComponentPair m x (Producer m x r) (Transducer m x y) (Producer m y r)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (ProducerType ()) TransducerType m ([] x) ([] y) (Transducer m x y) (Producer m y ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ProducerType ()) TransducerType TransducerType m ([] x) ([] y) (Producer m y ()) (Transducer m x y) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ProducerType ()) (ConsumerType ()) TransducerType m ([] x) ([] y) (Producer m y ()) (Consumer m x ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ConsumerType ()) (ProducerType ()) TransducerType m ([] x) ([] y) (Consumer m x ()) (Producer m y ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (PerformerType r1) (ProducerType r2) (ProducerType r2) m () ([] x) (Performer m r1) (Producer m x r2) (Producer m x r2)
(ParallelizableMonad m, Typeable x) => JoinableComponentPair (ProducerType r1) (PerformerType r2) (ProducerType r2) m () ([] x) (Producer m x r1) (Performer m r2) (Producer m x r2)
(Monad m, Typeable x) => JoinableComponentPair (ProducerType r1) (ProducerType r2) (ProducerType r2) m () ([] x) (Producer m x r1) (Producer m x r2) (Producer m x r2)
Component (Producer m x r)
AnyListOrUnit y => CompatibleSignature (Producer m x r) (ProducerType r) m y ([] x)
data Splitter m x Source
The Splitter type represents computations that distribute data acording to some criteria. A splitter should distribute only the original input data, and feed it into the sinks in the same order it has been read from the source. If the two sink arguments of a splitter are the same, the splitter must act as an identity transform.
Constructors
Splitter
splitterName :: String
splitterMaxThreads :: Int
splitterConfiguration :: ComponentConfiguration
splitterUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x], forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x])
split :: forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x]
splitSections :: forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x]
show/hide Instances
data Transducer m x y Source
The Transducer type represents computations that transform data and return no result. A transducer must continue consuming the given source and feeding the sink while there is data.
Constructors
Transducer
transducerName :: String
transducerMaxThreads :: Int
transducerConfiguration :: ComponentConfiguration
transducerUsingThreads :: Int -> (ComponentConfiguration, forall c. Source c x -> Sink c y -> Pipe c m [x])
transduce :: forall c. Source c x -> Sink c y -> Pipe c m [x]
show/hide Instances
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType TransducerType TransducerType m ([] x) ([] y) (Transducer m x y) (Transducer m x y) (Transducer m x y)
ParallelizableMonad m => PipeableComponentPair m y (Transducer m x y) (Transducer m y z) (Transducer m x z)
(ParallelizableMonad m, Typeable x, Typeable y) => PipeableComponentPair m x (Producer m x r) (Transducer m x y) (Producer m y r)
(ParallelizableMonad m, Typeable x, Typeable y) => PipeableComponentPair m y (Transducer m x y) (Consumer m y r) (Consumer m x r)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (PerformerType r) TransducerType m ([] x) ([] y) (Transducer m x y) (Performer m r) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (ProducerType ()) TransducerType m ([] x) ([] y) (Transducer m x y) (Producer m y ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair TransducerType (ConsumerType ()) TransducerType m ([] x) ([] y) (Transducer m x y) (Consumer m x ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (PerformerType r) TransducerType TransducerType m ([] x) ([] y) (Performer m r) (Transducer m x y) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ProducerType ()) TransducerType TransducerType m ([] x) ([] y) (Producer m y ()) (Transducer m x y) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ConsumerType ()) TransducerType TransducerType m ([] x) ([] y) (Consumer m x ()) (Transducer m x y) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ProducerType ()) (ConsumerType ()) TransducerType m ([] x) ([] y) (Producer m y ()) (Consumer m x ()) (Transducer m x y)
(ParallelizableMonad m, Typeable x, Typeable y) => JoinableComponentPair (ConsumerType ()) (ProducerType ()) TransducerType m ([] x) ([] y) (Consumer m x ()) (Producer m y ()) (Transducer m x y)
Component (Transducer m x y)
BranchComponent (Transducer m x y) m x ([] x)
CompatibleSignature (Transducer m x y) TransducerType m ([] x) ([] y)
data ComponentConfiguration Source
Constructors
ComponentConfiguration
componentChildren :: [AnyComponent]
componentThreads :: Int
componentCost :: Int
Lifting functions
liftPerformer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Pipe c m r)) -> Performer m rSource
Function liftPerformer takes a component name, maximum number of threads it can use, and its usingThreads method, and returns a Performer component.
liftConsumer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Pipe c m r)) -> Consumer m x rSource
Function liftConsumer takes a component name, maximum number of threads it can use, and its usingThreads method, and returns a Consumer component.
liftAtomicConsumer :: String -> Int -> (forall c. Source c x -> Pipe c m r) -> Consumer m x rSource
Function liftAtomicConsumer lifts a single-threaded consume function into a Consumer component.
liftProducer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Sink c x -> Pipe c m r)) -> Producer m x rSource
Function liftProducer takes a component name, maximum number of threads it can use, and its usingThreads method, and returns a Producer component.
liftAtomicProducer :: String -> Int -> (forall c. Sink c x -> Pipe c m r) -> Producer m x rSource
Function liftAtomicProducer lifts a single-threaded produce function into a Producer component.
liftTransducer :: String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c y -> Pipe c m [x])) -> Transducer m x ySource
Function liftTransducer takes a component name, maximum number of threads it can use, and its usingThreads method, and returns a Transducer component.
liftAtomicTransducer :: String -> Int -> (forall c. Source c x -> Sink c y -> Pipe c m [x]) -> Transducer m x ySource
Function liftAtomicTransducer lifts a single-threaded transduce function into a Transducer component.
lift121Transducer :: (Monad m, Typeable x, Typeable y) => String -> (x -> y) -> Transducer m x ySource
Function lift121Transducer takes a function that maps one input value to one output value each, and lifts it into a Transducer.
liftStatelessTransducer :: (Monad m, Typeable x, Typeable y) => String -> (x -> [y]) -> Transducer m x ySource
Function liftStatelessTransducer takes a function that maps one input value into a list of output values, and lifts it into a Transducer.
liftFoldTransducer :: (Monad m, Typeable x, Typeable y) => String -> (s -> x -> s) -> s -> (s -> y) -> Transducer m x ySource
Function liftFoldTransducer creates a stateful transducer that produces only one output value after consuming the entire input. Similar to Data.List.foldl
liftStatefulTransducer :: (Monad m, Typeable x, Typeable y) => String -> (state -> x -> (state, [y])) -> state -> Transducer m x ySource
Function liftStatefulTransducer constructs a Transducer from a state-transition function and the initial state. The transition function may produce arbitrary output at any transition step.
liftSimpleSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x])) -> Splitter m xSource
Function liftSimpleSplitter lifts a simple, non-sectioning splitter function into a full Splitter.
liftSectionSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (Int -> (ComponentConfiguration, forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x])) -> Splitter m xSource
Function liftSectionSplitter lifts a sectioning splitter function into a full Splitter
liftAtomicSimpleSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (forall c. Source c x -> Sink c x -> Sink c x -> Pipe c m [x]) -> Splitter m xSource
Function liftAtomicSimpleSplitter lifts a single-threaded split function into a Splitter component.
liftAtomicSectionSplitter :: forall m x. (ParallelizableMonad m, Typeable x) => String -> Int -> (forall c. Source c x -> Sink c (Maybe x) -> Sink c (Maybe x) -> Pipe c m [x]) -> Splitter m xSource
Function liftAtomicSectionSplitter lifts a single-threaded splitSections function into a full Splitter component.
liftStatelessSplitter :: (ParallelizableMonad m, Typeable x) => String -> (x -> Bool) -> Splitter m xSource
Function liftStatelessSplitter takes a function that assigns a Boolean value to each input item and lifts it into a Splitter.
Utility functions
showComponentTree :: forall c. Component c => c -> StringSource
Show details of the given component's configuration.
optimalTwoParallelConfigurations :: (Component c1, Component c2) => Int -> c1 -> c2 -> (ComponentConfiguration, c1, c2, Bool)Source
Function optimalTwoParallelConfigurations configures two components assuming they can be run in parallel, splitting the given thread count between them, and returns the configured components, a ComponentConfiguration that can be used to build a new component from them, and a flag that indicates if they should be run in parallel or sequentially for optimal resource usage.
optimalTwoSequentialConfigurations :: (Component c1, Component c2) => Int -> c1 -> c2 -> (ComponentConfiguration, c1, c2)Source
Function optimalTwoParallelConfigurations configures two components, both of them with the full thread count, and returns the components and a ComponentConfiguration that can be used to build a new component from them.
optimalThreeParallelConfigurations :: (Component c1, Component c2, Component c3) => Int -> c1 -> c2 -> c3 -> (ComponentConfiguration, (c1, Bool), (c2, Bool), (c3, Bool))Source
Function optimalThreeParallelConfigurations configures three components assuming they can be run in parallel, splitting the given thread count between them, and returns the components, a ComponentConfiguration that can be used to build a new component from them, and a flag per component that indicates if it should be run in parallel or sequentially for optimal resource usage.
Produced by Haddock version 2.3.0