module Control.Concurrent.SCC.ComponentTypes
(
Splitter(..), Transducer(..),
lift121Transducer, liftStatelessTransducer, liftFoldTransducer, liftStatefulTransducer,
liftSimpleSplitter, liftSectionSplitter, liftStatelessSplitter)
where
import Control.Concurrent.SCC.Foundation
import Control.Monad (liftM, when)
import Data.Maybe (maybe)
import Data.Typeable (Typeable, cast)
newtype Monad m => Transducer m x y = Transducer {transduce :: forall c1 c2 context. Source c1 x -> Sink c2 y -> Pipe context m [x]}
data Monad m => Splitter m x = Splitter {split :: forall c1 c2 c3 context.
Source c1 x -> Sink c2 x -> Sink c3 x -> Pipe context m [x],
splitSections :: forall c1 c2 c3 context.
Source c1 x -> Sink c2 (Maybe x) -> Sink c3 (Maybe x)
-> Pipe context m [x]}
lift121Transducer :: (Monad m, Typeable x, Typeable y) => (x -> y) -> Transducer m x y
lift121Transducer f = Transducer (\source sink-> let t = canPut sink
>>= flip when (getSuccess source (\x-> put sink (f x) >> t))
in t >> return [])
liftStatelessTransducer :: (Monad m, Typeable x, Typeable y) => (x -> [y]) -> Transducer m x y
liftStatelessTransducer f = Transducer (\source sink-> let t = canPut sink
>>= flip when (getSuccess source (\x-> putList (f x) sink >> t))
in t >> return [])
liftFoldTransducer :: (Monad m, Typeable x, Typeable y) => (y -> x -> y) -> y -> Transducer m x y
liftFoldTransducer f y0 = Transducer (\source sink-> let t y = canPut sink
>>= flip when (get source
>>= maybe (put sink y >> return ()) (t . f y))
in t y0 >> return [])
liftStatefulTransducer :: (Monad m, Typeable x, Typeable y) => (state -> x -> (state, [y])) -> state -> Transducer m x y
liftStatefulTransducer f s0 = Transducer (\source sink-> let t s = canPut sink
>>= flip when (getSuccess source (\x-> let (s', ys) = f s x
in putList ys sink
>> t s'))
in t s0 >> return [])
liftStatelessSplitter :: (Monad m, Typeable x) => (x -> Bool) -> Splitter m x
liftStatelessSplitter f = liftSimpleSplitter (\source true false-> let s = get source
>>= maybe
(return [])
(\x-> (if f x
then put true x
else put false x)
>>= cond s (return [x]))
in s)
liftSimpleSplitter :: (Monad m, Typeable x) =>
(forall c1 c2 c3 context. Source c1 x -> Sink c2 x -> Sink c3 x -> Pipe context m [x]) -> Splitter m x
liftSimpleSplitter split = Splitter split splitSections
where splitSections source true false
= liftM (fst . fst) $
pipeD "liftSimpleSplitter true"
(\true'-> pipeD "liftSimpleSplitter false"
(\false'-> split source true' false')
(decorate false))
(decorate true)
decorate sink source = transduce (lift121Transducer Just) source sink
liftSectionSplitter :: (Monad m, Typeable x) =>
(forall c1 c2 c3 context. Source c1 x -> Sink c2 (Maybe x) -> Sink c3 (Maybe x) -> Pipe context m [x])
-> Splitter m x
liftSectionSplitter splitSections = Splitter splitValues splitSections
where splitValues source true false
= liftM (fst . fst) $
pipeD "liftSectionSplitter true"
(\true'-> pipeD "liftSectionSplitter false" (\false'-> splitSections source true' false') (strip false))
(strip true)
strip sink source = canPut sink
>>= flip when (getSuccess source (\x-> maybe (return False) (put sink) x >> strip sink source))