module Data.Machine.Tee
(
Tee, TeeT
, T(..)
, tee
, addL, addR
, capL, capR
) where
import Data.Machine.Is
import Data.Machine.Process
import Data.Machine.Type
import Data.Machine.Source
import Prelude hiding ((.),id)
data T a b c where
L :: T a b a
R :: T a b b
type Tee a b c = Machine (T a b) c
type TeeT m a b c = MachineT m (T a b) c
tee :: Monad m => ProcessT m a a' -> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ma mb m = MachineT $ runMachineT m >>= \v -> case v of
Stop -> return Stop
Yield o k -> return $ Yield o $ tee ma mb k
Await f L ff -> runMachineT ma >>= \u -> case u of
Stop -> runMachineT $ tee stopped mb ff
Yield a k -> runMachineT $ tee k mb $ f a
Await g Refl fg ->
return $ Await (\a -> tee (g a) mb $ encased v) L $ tee fg mb $ encased v
Await f R ff -> runMachineT mb >>= \u -> case u of
Stop -> runMachineT $ tee ma stopped ff
Yield b k -> runMachineT $ tee ma k $ f b
Await g Refl fg ->
return $ Await (\b -> tee ma (g b) $ encased v) R $ tee ma fg $ encased v
addL :: Monad m => ProcessT m a b -> TeeT m b c d -> TeeT m a c d
addL p = tee p echo
addR :: Monad m => ProcessT m b c -> TeeT m a c d -> TeeT m a b d
addR = tee echo
capL :: Monad m => SourceT m a -> TeeT m a b c -> ProcessT m b c
capL s t = fit cappedT $ addL s t
capR :: Monad m => SourceT m b -> TeeT m a b c -> ProcessT m a c
capR s t = fit cappedT $ addR s t
cappedT :: T a a b -> Is a b
cappedT R = Refl
cappedT L = Refl