{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.Tee
-- Copyright   :  (C) 2012 Edward Kmett, Rúnar Bjarnason, Paul Chiusano
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  Rank-2 Types, GADTs
--
----------------------------------------------------------------------------
module Data.Machine.Tee
  ( -- * Tees
    Tee, TeeT
  , T(..)
  , tee, teeT
  , addL, addR
  , capL, capR, capT
  , zipWithT
  , zipWith
  , zipping
  ) where

import Data.Machine.Is
import Data.Machine.Plan
import Data.Machine.Process
import Data.Machine.Type
import Data.Machine.Source
import Prelude hiding ((.), id, zipWith)

-- $setup
-- >>> import Data.Machine

-------------------------------------------------------------------------------
-- Tees
-------------------------------------------------------------------------------

-- | The input descriptor for a 'Tee' or 'TeeT'
data T a b c where
  L :: T a b a
  R :: T a b b

-- | A 'Machine' that can read from two input stream in a deterministic manner.
type Tee a b c = Machine (T a b) c

-- | A 'Machine' that can read from two input stream in a deterministic manner with monadic side-effects.
type TeeT m a b c = MachineT m (T a b) c

-- | Compose a pair of pipes onto the front of a Tee.
--
-- Examples:
--
-- >>> import Data.Machine.Source
-- >>> run $ tee (source [1..]) (source ['a'..'c']) zipping
-- [(1,'a'),(2,'b'),(3,'c')]
--
tee :: Monad m => ProcessT m a a' -> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee :: ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma ProcessT m b b'
mb TeeT m a' b' c
m = m (Step (T a b) c (TeeT m a b c)) -> TeeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (T a b) c (TeeT m a b c)) -> TeeT m a b c)
-> m (Step (T a b) c (TeeT m a b c)) -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ TeeT m a' b' c -> m (Step (T a' b') c (TeeT m a' b' c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT TeeT m a' b' c
m m (Step (T a' b') c (TeeT m a' b' c))
-> (Step (T a' b') c (TeeT m a' b' c)
    -> m (Step (T a b) c (TeeT m a b c)))
-> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (T a' b') c (TeeT m a' b' c)
v -> case Step (T a' b') c (TeeT m a' b' c)
v of
  Step (T a' b') c (TeeT m a' b' c)
Stop         -> Step (T a b) c (TeeT m a b c) -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (T a b) c (TeeT m a b c)
forall (k :: * -> *) o r. Step k o r
Stop
  Yield c
o TeeT m a' b' c
k    -> Step (T a b) c (TeeT m a b c) -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (T a b) c (TeeT m a b c)
 -> m (Step (T a b) c (TeeT m a b c)))
-> Step (T a b) c (TeeT m a b c)
-> m (Step (T a b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ c -> TeeT m a b c -> Step (T a b) c (TeeT m a b c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (TeeT m a b c -> Step (T a b) c (TeeT m a b c))
-> TeeT m a b c -> Step (T a b) c (TeeT m a b c)
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma ProcessT m b b'
mb TeeT m a' b' c
k
  Await t -> TeeT m a' b' c
f T a' b' t
L TeeT m a' b' c
ff -> ProcessT m a a' -> m (Step (Is a) a' (ProcessT m a a'))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT ProcessT m a a'
ma m (Step (Is a) a' (ProcessT m a a'))
-> (Step (Is a) a' (ProcessT m a a')
    -> m (Step (T a b) c (TeeT m a b c)))
-> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Is a) a' (ProcessT m a a')
u -> case Step (Is a) a' (ProcessT m a a')
u of
    Step (Is a) a' (ProcessT m a a')
Stop            -> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (TeeT m a b c -> m (Step (T a b) c (TeeT m a b c)))
-> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
forall (k :: * -> *) b. Machine k b
stopped ProcessT m b b'
mb TeeT m a' b' c
ff
    Yield a'
a ProcessT m a a'
k       -> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (TeeT m a b c -> m (Step (T a b) c (TeeT m a b c)))
-> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
k ProcessT m b b'
mb (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ t -> TeeT m a' b' c
f a'
t
a
    Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg ->
      Step (T t b) c (TeeT m a b c) -> m (Step (T t b) c (TeeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (T t b) c (TeeT m a b c)
 -> m (Step (T t b) c (TeeT m a b c)))
-> Step (T t b) c (TeeT m a b c)
-> m (Step (T t b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ (t -> TeeT m a b c)
-> T t b t -> TeeT m a b c -> Step (T t b) c (TeeT m a b c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
a -> ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee (t -> ProcessT m a a'
g t
a) ProcessT m b b'
mb (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (T a' b') c (TeeT m a' b' c) -> TeeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a' b') c (TeeT m a' b' c)
v) T t b t
forall a b. T a b a
L (TeeT m a b c -> Step (T t b) c (TeeT m a b c))
-> TeeT m a b c -> Step (T t b) c (TeeT m a b c)
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
fg ProcessT m b b'
mb (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (T a' b') c (TeeT m a' b' c) -> TeeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a' b') c (TeeT m a' b' c)
v
  Await t -> TeeT m a' b' c
f T a' b' t
R TeeT m a' b' c
ff -> ProcessT m b b' -> m (Step (Is b) b' (ProcessT m b b'))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT ProcessT m b b'
mb m (Step (Is b) b' (ProcessT m b b'))
-> (Step (Is b) b' (ProcessT m b b')
    -> m (Step (T a b) c (TeeT m a b c)))
-> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Is b) b' (ProcessT m b b')
u -> case Step (Is b) b' (ProcessT m b b')
u of
    Step (Is b) b' (ProcessT m b b')
Stop            -> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (TeeT m a b c -> m (Step (T a b) c (TeeT m a b c)))
-> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma ProcessT m b b'
forall (k :: * -> *) b. Machine k b
stopped TeeT m a' b' c
ff
    Yield b'
b ProcessT m b b'
k       -> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (TeeT m a b c -> m (Step (T a b) c (TeeT m a b c)))
-> TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma ProcessT m b b'
k (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ t -> TeeT m a' b' c
f b'
t
b
    Await t -> ProcessT m b b'
g Is b t
Refl ProcessT m b b'
fg ->
      Step (T a t) c (TeeT m a b c) -> m (Step (T a t) c (TeeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (T a t) c (TeeT m a b c)
 -> m (Step (T a t) c (TeeT m a b c)))
-> Step (T a t) c (TeeT m a b c)
-> m (Step (T a t) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ (t -> TeeT m a b c)
-> T a t t -> TeeT m a b c -> Step (T a t) c (TeeT m a b c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
b -> ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma (t -> ProcessT m b b'
g t
b) (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (T a' b') c (TeeT m a' b' c) -> TeeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a' b') c (TeeT m a' b' c)
v) T a t t
forall a b. T a b b
R (TeeT m a b c -> Step (T a t) c (TeeT m a b c))
-> TeeT m a b c -> Step (T a t) c (TeeT m a b c)
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a'
ma ProcessT m b b'
fg (TeeT m a' b' c -> TeeT m a b c) -> TeeT m a' b' c -> TeeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (T a' b') c (TeeT m a' b' c) -> TeeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a' b') c (TeeT m a' b' c)
v

-- | `teeT mt ma mb` Use a `Tee` to interleave or combine the outputs of `ma`
--   and `mb`.
--
--   The resulting machine will draw from a single source.
--
-- Examples:
--
-- >>> import Data.Machine.Source
-- >>> run $ teeT zipping echo echo <~ source [1..5]
-- [(1,2),(3,4)]
--
teeT :: Monad m => TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT :: TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT TeeT m a b c
mt MachineT m k a
ma MachineT m k b
mb = m (Step k c (MachineT m k c)) -> MachineT m k c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k c (MachineT m k c)) -> MachineT m k c)
-> m (Step k c (MachineT m k c)) -> MachineT m k c
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> m (Step (T a b) c (TeeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT TeeT m a b c
mt m (Step (T a b) c (TeeT m a b c))
-> (Step (T a b) c (TeeT m a b c) -> m (Step k c (MachineT m k c)))
-> m (Step k c (MachineT m k c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (T a b) c (TeeT m a b c)
v -> case Step (T a b) c (TeeT m a b c)
v of
  Step (T a b) c (TeeT m a b c)
Stop         -> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k c (MachineT m k c)
forall (k :: * -> *) o r. Step k o r
Stop
  Yield c
o TeeT m a b c
k    -> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k c (MachineT m k c) -> m (Step k c (MachineT m k c)))
-> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ c -> MachineT m k c -> Step k c (MachineT m k c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (MachineT m k c -> Step k c (MachineT m k c))
-> MachineT m k c -> Step k c (MachineT m k c)
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT TeeT m a b c
k MachineT m k a
ma MachineT m k b
mb
  Await t -> TeeT m a b c
f T a b t
L TeeT m a b c
ff -> MachineT m k a -> m (Step k a (MachineT m k a))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k a
ma m (Step k a (MachineT m k a))
-> (Step k a (MachineT m k a) -> m (Step k c (MachineT m k c)))
-> m (Step k c (MachineT m k c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k a (MachineT m k a)
u -> case Step k a (MachineT m k a)
u of
    Step k a (MachineT m k a)
Stop          -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT TeeT m a b c
ff MachineT m k a
forall (k :: * -> *) b. Machine k b
stopped MachineT m k b
mb
    Yield a
a MachineT m k a
k     -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (t -> TeeT m a b c
f a
t
a) MachineT m k a
k MachineT m k b
mb
    Await t -> MachineT m k a
g k t
rq MachineT m k a
fg ->
      Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k c (MachineT m k c) -> m (Step k c (MachineT m k c)))
-> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m k c)
-> k t -> MachineT m k c -> Step k c (MachineT m k c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
r -> TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (Step (T a b) c (TeeT m a b c) -> TeeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a b) c (TeeT m a b c)
v) (t -> MachineT m k a
g t
r) MachineT m k b
mb) k t
rq (MachineT m k c -> Step k c (MachineT m k c))
-> MachineT m k c -> Step k c (MachineT m k c)
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (Step (T a b) c (TeeT m a b c) -> TeeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a b) c (TeeT m a b c)
v) MachineT m k a
fg MachineT m k b
mb
  Await t -> TeeT m a b c
f T a b t
R TeeT m a b c
ff -> MachineT m k b -> m (Step k b (MachineT m k b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k b
mb m (Step k b (MachineT m k b))
-> (Step k b (MachineT m k b) -> m (Step k c (MachineT m k c)))
-> m (Step k c (MachineT m k c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k b (MachineT m k b)
u -> case Step k b (MachineT m k b)
u of
    Step k b (MachineT m k b)
Stop          -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT TeeT m a b c
ff MachineT m k a
ma MachineT m k b
forall (k :: * -> *) b. Machine k b
stopped
    Yield b
a MachineT m k b
k     -> MachineT m k c -> m (Step k c (MachineT m k c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k c -> m (Step k c (MachineT m k c)))
-> MachineT m k c -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (t -> TeeT m a b c
f b
t
a) MachineT m k a
ma MachineT m k b
k
    Await t -> MachineT m k b
g k t
rq MachineT m k b
fg ->
      Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k c (MachineT m k c) -> m (Step k c (MachineT m k c)))
-> Step k c (MachineT m k c) -> m (Step k c (MachineT m k c))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT m k c)
-> k t -> MachineT m k c -> Step k c (MachineT m k c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
r -> TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (Step (T a b) c (TeeT m a b c) -> TeeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a b) c (TeeT m a b c)
v) MachineT m k a
ma (t -> MachineT m k b
g t
r)) k t
rq (MachineT m k c -> Step k c (MachineT m k c))
-> MachineT m k c -> Step k c (MachineT m k c)
forall a b. (a -> b) -> a -> b
$ TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
forall (m :: * -> *) a b c (k :: * -> *).
Monad m =>
TeeT m a b c -> MachineT m k a -> MachineT m k b -> MachineT m k c
teeT (Step (T a b) c (TeeT m a b c) -> TeeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (T a b) c (TeeT m a b c)
v) MachineT m k a
ma MachineT m k b
fg

-- | Precompose a pipe onto the left input of a tee.
addL :: Monad m => ProcessT m a b -> TeeT m b c d -> TeeT m a c d
addL :: ProcessT m a b -> TeeT m b c d -> TeeT m a c d
addL ProcessT m a b
p = ProcessT m a b -> ProcessT m c c -> TeeT m b c d -> TeeT m a c d
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a b
p ProcessT m c c
forall a. Process a a
echo
{-# INLINE addL #-}

-- | Precompose a pipe onto the right input of a tee.
addR :: Monad m => ProcessT m b c -> TeeT m a c d -> TeeT m a b d
addR :: ProcessT m b c -> TeeT m a c d -> TeeT m a b d
addR = ProcessT m a a -> ProcessT m b c -> TeeT m a c d -> TeeT m a b d
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m a a
forall a. Process a a
echo
{-# INLINE addR #-}

-- | Tie off one input of a tee by connecting it to a known source.
capL :: Monad m => SourceT m a -> TeeT m a b c -> ProcessT m b c
capL :: SourceT m a -> TeeT m a b c -> ProcessT m b c
capL SourceT m a
s TeeT m a b c
t = (forall a. T b b a -> Is b a)
-> MachineT m (T b b) c -> ProcessT m b c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) o.
Monad m =>
(forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. T b b a -> Is b a
forall a b. T a a b -> Is a b
cappedT (MachineT m (T b b) c -> ProcessT m b c)
-> MachineT m (T b b) c -> ProcessT m b c
forall a b. (a -> b) -> a -> b
$ ProcessT m b a -> TeeT m a b c -> MachineT m (T b b) c
forall (m :: * -> *) a b c d.
Monad m =>
ProcessT m a b -> TeeT m b c d -> TeeT m a c d
addL ProcessT m b a
SourceT m a
s TeeT m a b c
t
{-# INLINE capL #-}

-- | Tie off one input of a tee by connecting it to a known source.
capR :: Monad m => SourceT m b -> TeeT m a b c -> ProcessT m a c
capR :: SourceT m b -> TeeT m a b c -> ProcessT m a c
capR SourceT m b
s TeeT m a b c
t = (forall a. T a a a -> Is a a)
-> MachineT m (T a a) c -> ProcessT m a c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) o.
Monad m =>
(forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. T a a a -> Is a a
forall a b. T a a b -> Is a b
cappedT (MachineT m (T a a) c -> ProcessT m a c)
-> MachineT m (T a a) c -> ProcessT m a c
forall a b. (a -> b) -> a -> b
$ ProcessT m a b -> TeeT m a b c -> MachineT m (T a a) c
forall (m :: * -> *) b c a d.
Monad m =>
ProcessT m b c -> TeeT m a c d -> TeeT m a b d
addR ProcessT m a b
SourceT m b
s TeeT m a b c
t
{-# INLINE capR #-}

-- | Tie off both inputs to a tee by connecting them to known sources.
--   This is recommended over capping each side separately, as it is
--   far more efficient.
capT :: Monad m => SourceT m a -> SourceT m b -> TeeT m a b c -> SourceT m c
capT :: SourceT m a -> SourceT m b -> TeeT m a b c -> SourceT m c
capT SourceT m a
l SourceT m b
r TeeT m a b c
t = MachineT m (T Any Any) c -> SourceT m c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
MachineT m k o -> SourceT m o
plug (MachineT m (T Any Any) c -> SourceT m c)
-> MachineT m (T Any Any) c -> SourceT m c
forall a b. (a -> b) -> a -> b
$ ProcessT m Any a
-> ProcessT m Any b -> TeeT m a b c -> MachineT m (T Any Any) c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> TeeT m a' b' c -> TeeT m a b c
tee ProcessT m Any a
SourceT m a
l ProcessT m Any b
SourceT m b
r TeeT m a b c
t
{-# INLINE capT #-}

-- | Natural transformation used by 'capL' and 'capR'.
cappedT :: T a a b -> Is a b
cappedT :: T a a b -> Is a b
cappedT T a a b
R = Is a b
forall a. Is a a
Refl
cappedT T a a b
L = Is a b
forall a. Is a a
Refl
{-# INLINE cappedT #-}

-- | wait for both the left and the right sides of a T and then merge them with f.
zipWithT :: (a -> b -> c) -> PlanT (T a b) c m ()
zipWithT :: (a -> b -> c) -> PlanT (T a b) c m ()
zipWithT a -> b -> c
f = do { a
a <- T a b a -> Plan (T a b) c a
forall (k :: * -> *) i o. k i -> Plan k o i
awaits T a b a
forall a b. T a b a
L; b
b <- T a b b -> Plan (T a b) c b
forall (k :: * -> *) i o. k i -> Plan k o i
awaits T a b b
forall a b. T a b b
R; c -> Plan (T a b) c ()
forall o (k :: * -> *). o -> Plan k o ()
yield (c -> Plan (T a b) c ()) -> c -> Plan (T a b) c ()
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b }
{-# INLINE zipWithT #-}

-- | Zip together two inputs, then apply the given function,
--   halting as soon as either input is exhausted.
--   This implementation reads from the left, then the right
zipWith :: (a -> b -> c) -> Tee a b c
zipWith :: (a -> b -> c) -> Tee a b c
zipWith a -> b -> c
f = PlanT (T a b) c m () -> MachineT m (T a b) c
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT (T a b) c m () -> MachineT m (T a b) c)
-> PlanT (T a b) c m () -> MachineT m (T a b) c
forall a b. (a -> b) -> a -> b
$ do
  a
a <- T a b a -> Plan (T a b) c a
forall (k :: * -> *) i o. k i -> Plan k o i
awaits T a b a
forall a b. T a b a
L
  b
b <- T a b b -> Plan (T a b) c b
forall (k :: * -> *) i o. k i -> Plan k o i
awaits T a b b
forall a b. T a b b
R
  c -> Plan (T a b) c ()
forall o (k :: * -> *). o -> Plan k o ()
yield (a -> b -> c
f a
a b
b)
{-# INLINE zipWith #-}

-- | Zip together two inputs, halting as soon as either input is exhausted.
zipping :: Tee a b (a, b)
zipping :: MachineT m (T a b) (a, b)
zipping = (a -> b -> (a, b)) -> Tee a b (a, b)
forall a b c. (a -> b -> c) -> Tee a b c
zipWith (,)
{-# INLINE zipping #-}