scc-0.1: Control/Concurrent/SCC/ComponentTypes.hs
{-
Copyright 2008 Mario Blazevic
This file is part of the Streaming Component Combinators (SCC) project.
The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
version.
SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with SCC. If not, see
<http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
module Control.Concurrent.SCC.ComponentTypes
(-- * Types
Splitter(..), Transducer(..),
-- * Lifting functions
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)
-- | 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.
newtype Monad m => Transducer m x y = Transducer {transduce :: forall c1 c2 context. Source c1 x -> Sink c2 y -> Pipe context m [x]}
-- | 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.
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]}
-- | Function 'lift121Transducer' takes a function that maps one input value to one output value each, and lifts it into
-- a 'Transducer'.
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 [])
-- | Function 'liftStatelessTransducer' takes a function that maps one input value into a list of output values, and
-- lifts it into a 'Transducer'.
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 [])
-- | Function 'liftFoldTransducer' creates a stateful transducer that produces only one output value after consuming the
-- entire input. Similar to 'Data.List.foldl'
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 [])
-- | 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.
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 [])
-- | Function 'liftStatelessSplitter' takes a function that assigns a Boolean value to each input item and lifts it into
-- a 'Splitter'
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)
-- | Function 'liftSimpleSplitter' lifts a simple, non-sectioning splitter function into a full 'Splitter'
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
-- | Function 'liftSectionSplitter' lifts a sectioning splitter function into a full 'Splitter'
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 = transduce (liftStatelessTransducer (maybe [] (:[]))) source sink
strip sink source = canPut sink
>>= flip when (getSuccess source (\x-> maybe (return False) (put sink) x >> strip sink source))