module Control.Concurrent.SCC.Coercions
(
Coercible(..),
adaptSplitter
)
where
import Prelude hiding ((.))
import Control.Category ((.))
import Control.Monad (liftM)
import Data.Monoid (Monoid(mempty))
import Data.Text (Text, pack, unpack)
import Control.Monad.Coroutine (sequentialBinder)
import Control.Concurrent.SCC.Streams
import Control.Concurrent.SCC.Types
class Coercible x y where
coerce :: Monad m => Transducer m x y
adaptConsumer :: (Monad m, Monoid x, Monoid y) => Consumer m y r -> Consumer m x r
adaptConsumer consumer = isolateConsumer $ \source-> liftM snd $ pipe (transduce coerce source) (consume consumer)
adaptProducer :: (Monad m, Monoid x, Monoid y) => Producer m x r -> Producer m y r
adaptProducer producer = isolateProducer $ \sink-> liftM fst $ pipe (produce producer) (flip (transduce coerce) sink)
instance Coercible x x where
coerce = Transducer pour_
adaptConsumer = id
adaptProducer = id
instance Monoid x => Coercible [x] x where
coerce = statelessTransducer id
instance Coercible [Char] [Text] where
coerce = Transducer (mapStreamChunks ((:[]) . pack))
instance Coercible String Text where
coerce = Transducer (mapStreamChunks pack)
instance Coercible [Text] [Char] where
coerce = statelessTransducer unpack
instance Coercible Text String where
coerce = statelessChunkTransducer unpack
instance Coercible [x] [y] => Coercible [[x]] [y] where
coerce = compose sequentialBinder (statelessTransducer id) coerce
instance Coercible [x] [y] => Coercible [Markup b x] [y] where
coerce = compose sequentialBinder (statelessTransducer unmark) coerce
where unmark (Content x) = [x]
unmark (Markup _) = []
instance (Monoid x, Monoid y, Coercible x y) => Coercible [Markup b x] y where
coerce = compose sequentialBinder (statelessTransducer unmark) coerce
where unmark (Content x) = x
unmark (Markup _) = mempty
adaptSplitter :: forall m x y b. (Monad m, Monoid x, Monoid y, Coercible x y, Coercible y x) =>
Splitter m x -> Splitter m y
adaptSplitter sx =
isolateSplitter $ \source true false->
pipe
(transduce coerce source)
(\source'->
pipe
(\true'->
pipe
(\false'-> split sx source' true' false')
(flip (transduce coerce) false))
(flip (transduce coerce) true))
>> return ()