module Control.Concurrent.SCC.Types (
Performer(..),
OpenConsumer, Consumer(..), OpenProducer, Producer(..),
OpenTransducer, Transducer(..), OpenSplitter, Splitter(..),
Boundary(..), Markup(..), Parser,
Branching (combineBranches),
isolateConsumer, isolateProducer, isolateTransducer, isolateSplitter,
oneToOneTransducer, statelessTransducer, statefulTransducer,
statelessSplitter, statefulSplitter,
)
where
import Control.Category (Category(..))
import qualified Control.Category as Category
import Control.Monad.Coroutine
import Control.Concurrent.SCC.Streams
type OpenConsumer m a d x r = AncestorFunctor a d => Source m a x -> Coroutine d m r
type OpenProducer m a d x r = AncestorFunctor a d => Sink m a x -> Coroutine d m r
type OpenTransducer m a1 a2 d x y r =
(AncestorFunctor a1 d, AncestorFunctor a2 d) => Source m a1 x -> Sink m a2 y -> Coroutine d m r
type OpenSplitter m a1 a2 a3 a4 d x b r =
(AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d, AncestorFunctor a4 d) =>
Source m a1 x -> Sink m a2 x -> Sink m a3 x -> Sink m a4 b -> Coroutine d m r
newtype Performer m r = Performer {perform :: m r}
newtype Consumer m x r = Consumer {consume :: forall a d. OpenConsumer m a d x r}
newtype Producer m x r = Producer {produce :: forall a d. OpenProducer m a d x r}
newtype Transducer m x y = Transducer {transduce :: forall a1 a2 d. OpenTransducer m a1 a2 d x y ()}
newtype Splitter m x b = Splitter {split :: forall a1 a2 a3 a4 d. OpenSplitter m a1 a2 a3 a4 d x b ()}
data Boundary y = Start y | End y | Point y deriving (Eq, Show)
data Markup y x = Content x | Markup (Boundary y) deriving (Eq)
type Parser m x b = Transducer m x (Markup b x)
instance Functor Boundary where
fmap f (Start b) = Start (f b)
fmap f (End b) = End (f b)
fmap f (Point b) = Point (f b)
instance Functor (Markup y) where
fmap f (Content x) = Content (f x)
fmap _ (Markup b) = Markup b
instance (Show x , Show y) => Show (Markup y x) where
showsPrec _ (Content x) s = shows x s
showsPrec _ (Markup b) s = '[' : shows b (']' : s)
instance Monad m => Category (Transducer m) where
id = Transducer pour
t1 . t2 = isolateTransducer $ \source sink->
pipe (transduce t2 source) (\source'-> transduce t1 source' sink)
>> return ()
isolateConsumer :: forall m x r. Monad m => (forall d. Functor d => Source m d x -> Coroutine d m r) -> Consumer m x r
isolateConsumer c = Consumer consume'
where consume' :: forall a d. OpenConsumer m a d x r
consume' source = let source' :: Source m d x
source' = liftSource source
in c source'
isolateProducer :: forall m x r. Monad m => (forall d. Functor d => Sink m d x -> Coroutine d m r) -> Producer m x r
isolateProducer p = Producer produce'
where produce' :: forall a d. OpenProducer m a d x r
produce' sink = let sink' :: Sink m d x
sink' = liftSink sink
in p sink'
isolateTransducer :: forall m x y. Monad m =>
(forall d. Functor d => Source m d x -> Sink m d y -> Coroutine d m ()) -> Transducer m x y
isolateTransducer t = Transducer transduce'
where transduce' :: forall a1 a2 d. OpenTransducer m a1 a2 d x y ()
transduce' source sink = let source' :: Source m d x
source' = liftSource source
sink' :: Sink m d y
sink' = liftSink sink
in t source' sink'
isolateSplitter :: forall m x b. Monad m =>
(forall d. Functor d =>
Source m d x -> Sink m d x -> Sink m d x -> Sink m d b -> Coroutine d m ())
-> Splitter m x b
isolateSplitter s = Splitter split'
where split' :: forall a1 a2 a3 a4 d. OpenSplitter m a1 a2 a3 a4 d x b ()
split' source true false edge = let source' :: Source m d x
source' = liftSource source
true' :: Sink m d x
true' = liftSink true
false' :: Sink m d x
false' = liftSink false
edge' :: Sink m d b
edge' = liftSink edge
in s source' true' false' edge'
class Branching c (m :: * -> *) x r | c -> m x where
combineBranches :: (forall d. (PairBinder m ->
(forall a d'. AncestorFunctor d d' => OpenConsumer m a d' x r) ->
(forall a d'. AncestorFunctor d d' => OpenConsumer m a d' x r) ->
(forall a. OpenConsumer m a d x r))) ->
PairBinder m -> c -> c -> c
instance forall m x r. Monad m => Branching (Consumer m x r) m x r where
combineBranches combinator binder c1 c2 = Consumer $ combinator binder (consume c1) (consume c2)
instance forall m x y. Monad m => Branching (Transducer m x y) m x () where
combineBranches combinator binder t1 t2
= let transduce' :: forall a1 a2 d. OpenTransducer m a1 a2 d x y ()
transduce' source sink = combinator binder
(\source'-> transduce t1 source' sink')
(\source'-> transduce t2 source' sink')
source
where sink' :: Sink m d y
sink' = liftSink sink
in Transducer transduce'
instance forall m x b. Monad m => Branching (Splitter m x b) m x () where
combineBranches combinator binder s1 s2
= let split' :: forall a1 a2 a3 a4 d. OpenSplitter m a1 a2 a3 a4 d x b ()
split' source true false edge = combinator binder
(\source'-> split s1 source' true' false' edge')
(\source'-> split s2 source' true' false' edge')
source
where true' :: Sink m d x
true' = liftSink true
false' :: Sink m d x
false' = liftSink false
edge' :: Sink m d b
edge' = liftSink edge
in Splitter split'
oneToOneTransducer :: Monad m => (x -> y) -> Transducer m x y
oneToOneTransducer f = Transducer (mapStream f)
statelessTransducer :: Monad m => (x -> [y]) -> Transducer m x y
statelessTransducer f = Transducer (concatMapStream f)
statefulTransducer :: Monad m => (state -> x -> (state, [y])) -> state -> Transducer m x y
statefulTransducer f s0 =
Transducer (\source sink-> foldMStream_ (\ s x -> let (s', ys) = f s x in putList ys sink >> return s') s0 source)
statelessSplitter :: Monad m => (x -> Bool) -> Splitter m x b
statelessSplitter f = Splitter (\source true false _edge-> partitionStream f source true false)
statefulSplitter :: Monad m => (state -> x -> (state, Bool)) -> state -> Splitter m x ()
statefulSplitter f s0 =
Splitter (\source true false _edge->
foldMStream_
(\ s x -> let (s', truth) = f s x in (if truth then put true x else put false x) >> return s')
s0 source)