{- 
    Copyright 2009-2012 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/>.
-}

-- | This module defines class 'Coercible' and its instances.

{-# LANGUAGE Rank2Types, ScopedTypeVariables, MultiParamTypeClasses, 
             FlexibleContexts, FlexibleInstances, IncoherentInstances #-}
{-# OPTIONS_HADDOCK hide #-}

module Control.Concurrent.SCC.Coercions
   (
   -- * Coercible class
      Coercible(..),
   -- * Splitter isomorphism
      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


-- | Two streams of 'Coercible' types can be unambigously converted one to another.
class Coercible x y where
   -- | A 'Transducer' that converts a stream of one type to another.
   coerce :: Monad m => Transducer m x y
   adaptConsumer :: (Monad m, Monoid x, Monoid y) => Consumer m y r -> Consumer m x r
   adaptConsumer Consumer m y r
consumer = (forall (d :: * -> *).
 Functor d =>
 Source m d x -> Coroutine d m r)
-> Consumer m x r
forall (m :: * -> *) x r.
(Monad m, Monoid x) =>
(forall (d :: * -> *).
 Functor d =>
 Source m d x -> Coroutine d m r)
-> Consumer m x r
isolateConsumer ((forall (d :: * -> *).
  Functor d =>
  Source m d x -> Coroutine d m r)
 -> Consumer m x r)
-> (forall (d :: * -> *).
    Functor d =>
    Source m d x -> Coroutine d m r)
-> Consumer m x r
forall a b. (a -> b) -> a -> b
$ \Source m d x
source-> (((), r) -> r) -> Coroutine d m ((), r) -> Coroutine d m r
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((), r) -> r
forall a b. (a, b) -> b
snd (Coroutine d m ((), r) -> Coroutine d m r)
-> Coroutine d m ((), r) -> Coroutine d m r
forall a b. (a -> b) -> a -> b
$ (Sink m (SinkFunctor d y) y -> Coroutine (SinkFunctor d y) m ())
-> (Source m (SourceFunctor d y) y
    -> Coroutine (SourceFunctor d y) m r)
-> Coroutine d m ((), r)
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe (Transducer m x y
-> Source m d x
-> Sink m (SinkFunctor d y) y
-> Coroutine (SinkFunctor d y) m ()
forall (m :: * -> *) x y.
Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
transduce Transducer m x y
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce Source m d x
source) (Consumer m y r
-> forall (a :: * -> *) (d :: * -> *).
   (AncestorFunctor a d, Monoid y) =>
   Source m a y -> Coroutine d m r
forall (m :: * -> *) x r.
Consumer m x r
-> forall (a :: * -> *) (d :: * -> *).
   (AncestorFunctor a d, Monoid x) =>
   Source m a x -> Coroutine d m r
consume Consumer m y r
consumer)
   adaptProducer :: (Monad m, Monoid x, Monoid y) => Producer m x r -> Producer m y r
   adaptProducer Producer m x r
producer = (forall (d :: * -> *). Functor d => Sink m d y -> Coroutine d m r)
-> Producer m y r
forall (m :: * -> *) x r.
(Monad m, Monoid x) =>
(forall (d :: * -> *). Functor d => Sink m d x -> Coroutine d m r)
-> Producer m x r
isolateProducer ((forall (d :: * -> *). Functor d => Sink m d y -> Coroutine d m r)
 -> Producer m y r)
-> (forall (d :: * -> *).
    Functor d =>
    Sink m d y -> Coroutine d m r)
-> Producer m y r
forall a b. (a -> b) -> a -> b
$ \Sink m d y
sink-> ((r, ()) -> r) -> Coroutine d m (r, ()) -> Coroutine d m r
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (r, ()) -> r
forall a b. (a, b) -> a
fst (Coroutine d m (r, ()) -> Coroutine d m r)
-> Coroutine d m (r, ()) -> Coroutine d m r
forall a b. (a -> b) -> a -> b
$ (Sink m (SinkFunctor d x) x -> Coroutine (SinkFunctor d x) m r)
-> (Source m (SourceFunctor d x) x
    -> Coroutine (SourceFunctor d x) m ())
-> Coroutine d m (r, ())
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe (Producer m x r
-> forall (a :: * -> *) (d :: * -> *).
   (AncestorFunctor a d, Monoid x) =>
   Sink m a x -> Coroutine d m r
forall (m :: * -> *) x r.
Producer m x r
-> forall (a :: * -> *) (d :: * -> *).
   (AncestorFunctor a d, Monoid x) =>
   Sink m a x -> Coroutine d m r
produce Producer m x r
producer) ((Source m (SourceFunctor d x) x
 -> Sink m d y -> Coroutine (SourceFunctor d x) m ())
-> Sink m d y
-> Source m (SourceFunctor d x) x
-> Coroutine (SourceFunctor d x) m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
forall (m :: * -> *) x y.
Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
transduce Transducer m x y
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce) Sink m d y
sink)

instance Coercible x x where
   coerce :: Transducer m x x
coerce = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 OpenTransducer m a1 a2 d x x ())
-> Transducer m x x
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
 Source m a1 x -> Sink m a2 y -> Coroutine d m ())
-> Transducer m x y
Transducer forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
OpenTransducer m a1 a2 d x x ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pour_
   adaptConsumer :: Consumer m x r -> Consumer m x r
adaptConsumer = Consumer m x r -> Consumer m x r
forall a. a -> a
id
   adaptProducer :: Producer m x r -> Producer m x r
adaptProducer = Producer m x r -> Producer m x r
forall a. a -> a
id

instance Monoid x => Coercible [x] x where
   coerce :: Transducer m [x] x
coerce = (x -> x) -> Transducer m [x] x
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer x -> x
forall a. a -> a
id

instance Coercible [Char] [Text] where
   coerce :: Transducer m [Char] [Text]
coerce = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 OpenTransducer m a1 a2 d [Char] [Text] ())
-> Transducer m [Char] [Text]
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
 Source m a1 x -> Sink m a2 y -> Coroutine d m ())
-> Transducer m x y
Transducer (([Char] -> [Text])
-> Source m a1 [Char] -> Sink m a2 [Text] -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x
       y.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
(x -> y) -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
mapStreamChunks ((Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> ([Char] -> Text) -> [Char] -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> Text
pack))

instance Coercible String Text where
   coerce :: Transducer m [Char] Text
coerce = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 OpenTransducer m a1 a2 d [Char] Text ())
-> Transducer m [Char] Text
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
 Source m a1 x -> Sink m a2 y -> Coroutine d m ())
-> Transducer m x y
Transducer (([Char] -> Text)
-> Source m a1 [Char] -> Sink m a2 Text -> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x
       y.
(Monad m, Monoid x, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
(x -> y) -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
mapStreamChunks [Char] -> Text
pack)

instance Coercible [Text] [Char] where
   coerce :: Transducer m [Text] [Char]
coerce = (Text -> [Char]) -> Transducer m [Text] [Char]
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer Text -> [Char]
unpack

instance Coercible Text String where
   coerce :: Transducer m Text [Char]
coerce = (Text -> [Char]) -> Transducer m Text [Char]
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m x y
statelessChunkTransducer Text -> [Char]
unpack

instance Coercible [x] [y] => Coercible [[x]] [y] where
   coerce :: Transducer m [[x]] [y]
coerce = PairBinder m
-> Transducer m [[x]] [x]
-> Transducer m [x] [y]
-> Transducer m [[x]] [y]
forall (m :: * -> *) w c1 c2 c3.
PipeableComponentPair m w c1 c2 c3 =>
PairBinder m -> c1 -> c2 -> c3
compose PairBinder m
forall (m :: * -> *). Monad m => PairBinder m
sequentialBinder (([x] -> [x]) -> Transducer m [[x]] [x]
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer [x] -> [x]
forall a. a -> a
id) Transducer m [x] [y]
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce

instance Coercible [x] [y] => Coercible [Markup b x] [y] where
   coerce :: Transducer m [Markup b x] [y]
coerce = PairBinder m
-> Transducer m [Markup b x] [x]
-> Transducer m [x] [y]
-> Transducer m [Markup b x] [y]
forall (m :: * -> *) w c1 c2 c3.
PipeableComponentPair m w c1 c2 c3 =>
PairBinder m -> c1 -> c2 -> c3
compose PairBinder m
forall (m :: * -> *). Monad m => PairBinder m
sequentialBinder ((Markup b x -> [x]) -> Transducer m [Markup b x] [x]
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer Markup b x -> [x]
forall y a. Markup y a -> [a]
unmark) Transducer m [x] [y]
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce
      where unmark :: Markup y a -> [a]
unmark (Content a
x) = [a
x]
            unmark (Markup Boundary y
_) = []

instance (Monoid x, Monoid y, Coercible x y) => Coercible [Markup b x] y where
   coerce :: Transducer m [Markup b x] y
coerce = PairBinder m
-> Transducer m [Markup b x] x
-> Transducer m x y
-> Transducer m [Markup b x] y
forall (m :: * -> *) w c1 c2 c3.
PipeableComponentPair m w c1 c2 c3 =>
PairBinder m -> c1 -> c2 -> c3
compose PairBinder m
forall (m :: * -> *). Monad m => PairBinder m
sequentialBinder ((Markup b x -> x) -> Transducer m [Markup b x] x
forall (m :: * -> *) x y. Monad m => (x -> y) -> Transducer m [x] y
statelessTransducer Markup b x -> x
forall p y. Monoid p => Markup y p -> p
unmark) Transducer m x y
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce
      where unmark :: Markup y p -> p
unmark (Content p
x) = p
x
            unmark (Markup Boundary y
_) = p
forall a. Monoid a => a
mempty

-- | Adjusts the argument splitter to split the stream of a data type 'Isomorphic' to the type it was meant to split.
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 :: Splitter m x -> Splitter m y
adaptSplitter Splitter m x
sx = 
   (forall (d :: * -> *).
 Functor d =>
 Source m d y -> Sink m d y -> Sink m d y -> Coroutine d m ())
-> Splitter m y
forall (m :: * -> *) x b.
(Monad m, Monoid x) =>
(forall (d :: * -> *).
 Functor d =>
 Source m d x -> Sink m d x -> Sink m d x -> Coroutine d m ())
-> Splitter m x
isolateSplitter ((forall (d :: * -> *).
  Functor d =>
  Source m d y -> Sink m d y -> Sink m d y -> Coroutine d m ())
 -> Splitter m y)
-> (forall (d :: * -> *).
    Functor d =>
    Source m d y -> Sink m d y -> Sink m d y -> Coroutine d m ())
-> Splitter m y
forall a b. (a -> b) -> a -> b
$ \Source m d y
source Sink m d y
true Sink m d y
false->
   (Sink m (SinkFunctor d x) x -> Coroutine (SinkFunctor d x) m ())
-> (Source m (SourceFunctor d x) x
    -> Coroutine (SourceFunctor d x) m (((), ()), ()))
-> Coroutine d m ((), (((), ()), ()))
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe 
      (Transducer m y x
-> Source m d y
-> Sink m (SinkFunctor d x) x
-> Coroutine (SinkFunctor d x) m ()
forall (m :: * -> *) x y.
Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
transduce Transducer m y x
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce Source m d y
source) 
      (\Source m (SourceFunctor d x) x
source'-> 
        (Sink m (SinkFunctor (SourceFunctor d x) x) x
 -> Coroutine (SinkFunctor (SourceFunctor d x) x) m ((), ()))
-> (Source m (SourceFunctor (SourceFunctor d x) x) x
    -> Coroutine (SourceFunctor (SourceFunctor d x) x) m ())
-> Coroutine (SourceFunctor d x) m (((), ()), ())
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe 
           (\Sink m (SinkFunctor (SourceFunctor d x) x) x
true'-> 
             (Sink m (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) x
 -> Coroutine
      (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) m ())
-> (Source
      m (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) x
    -> Coroutine
         (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) m ())
-> Coroutine (SinkFunctor (SourceFunctor d x) x) m ((), ())
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe
                (\Sink m (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) x
false'-> Splitter m x
-> Source m (SourceFunctor d x) x
-> Sink m (SinkFunctor (SourceFunctor d x) x) x
-> Sink m (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) x
-> Coroutine
     (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) m ()
forall (m :: * -> *) x.
Splitter m x
-> forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
          (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d,
    Monoid x) =>
   Source m a1 x -> Sink m a2 x -> Sink m a3 x -> Coroutine d m ()
split Splitter m x
sx Source m (SourceFunctor d x) x
source' Sink m (SinkFunctor (SourceFunctor d x) x) x
true' Sink m (SinkFunctor (SinkFunctor (SourceFunctor d x) x) x) x
false') 
                ((Source m (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) x
 -> Sink m d y
 -> Coroutine
      (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) m ())
-> Sink m d y
-> Source m (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) x
-> Coroutine
     (SourceFunctor (SinkFunctor (SourceFunctor d x) x) x) m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
forall (m :: * -> *) x y.
Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
transduce Transducer m x y
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce) Sink m d y
false))
           ((Source m (SourceFunctor (SourceFunctor d x) x) x
 -> Sink m d y
 -> Coroutine (SourceFunctor (SourceFunctor d x) x) m ())
-> Sink m d y
-> Source m (SourceFunctor (SourceFunctor d x) x) x
-> Coroutine (SourceFunctor (SourceFunctor d x) x) m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
forall (m :: * -> *) x y.
Transducer m x y
-> forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
   (AncestorFunctor a1 d, AncestorFunctor a2 d, Monoid x, Monoid y) =>
   Source m a1 x -> Sink m a2 y -> Coroutine d m ()
transduce Transducer m x y
forall x y (m :: * -> *).
(Coercible x y, Monad m) =>
Transducer m x y
coerce) Sink m d y
true))
      Coroutine d m ((), (((), ()), ()))
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()