{-# LANGUAGE FlexibleContexts, GADTs, ScopedTypeVariables #-}
-- | Support for machines with two inputs from which input may be
-- drawn deterministically. In contrast to "Data.Machine.Tee", the two
-- inputs are eagerly run concurrently in this implementation.
module Data.Machine.Concurrent.Tee where
import Control.Concurrent.Async.Lifted (wait)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Machine
import Data.Machine.Concurrent.AsyncStep

-- | Compose a pair of pipes onto the front of a Tee.
tee :: forall m a a' b b' c. MonadBaseControl IO 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
$ do Async (StM m (MachineStep m (Is a) a'))
srcL <- ProcessT m a a' -> m (Async (StM m (MachineStep m (Is a) a')))
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun ProcessT m a a'
ma
                            Async (StM m (MachineStep m (Is b) b'))
srcR <- ProcessT m b b' -> m (Async (StM m (MachineStep m (Is b) b')))
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun ProcessT m b b'
mb
                            TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go TeeT m a' b' c
m (Async (StM m (MachineStep m (Is a) a'))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
forall a. a -> Maybe a
Just Async (StM m (MachineStep m (Is a) a'))
srcL) (Async (StM m (MachineStep m (Is b) b'))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
forall a. a -> Maybe a
Just Async (StM m (MachineStep m (Is b) b'))
srcR)
  where go :: TeeT m a' b' c
           -> Maybe (AsyncStep m (Is a) a')
           -> Maybe (AsyncStep m (Is b) b')
           -> m (MachineStep m (T a b) c)
        go :: TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go TeeT m a' b' c
snk Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR = 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
snk 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)))
-> (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 b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
-> (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))
-> Step (T a b) c (TeeT m a b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
 -> m (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 a b. (a -> b) -> a -> b
$ TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go TeeT m a' b' c
k Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR
          Await t -> TeeT m a' b' c
f T a' b' t
L TeeT m a' b' c
ff -> m (MachineStep m (Is a) a')
-> (Async (StM m (MachineStep m (Is a) a'))
    -> m (MachineStep m (Is a) a'))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> m (MachineStep m (Is a) a')
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MachineStep m (Is a) a' -> m (MachineStep m (Is a) a')
forall (m :: * -> *) a. Monad m => a -> m a
return MachineStep m (Is a) a'
forall (k :: * -> *) o r. Step k o r
Stop) Async (StM m (MachineStep m (Is a) a'))
-> m (MachineStep m (Is a) a')
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m a
wait Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL m (MachineStep m (Is a) a')
-> (MachineStep m (Is 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
>>= 
                          \(MachineStep m (Is a) a'
u :: MachineStep m (Is a) a') -> case MachineStep m (Is a) a'
u of
            MachineStep m (Is a) a'
Stop            -> TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go TeeT m a' b' c
ff Maybe (Async (StM m (MachineStep m (Is a) a')))
forall a. Maybe a
Nothing Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR
            Yield a'
a ProcessT m a a'
k       -> ProcessT m a a' -> m (Async (StM m (MachineStep m (Is a) a')))
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun ProcessT m a a'
k m (Async (StM m (MachineStep m (Is a) a')))
-> (Async (StM m (MachineStep m (Is 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
>>= (Maybe (Async (StM m (MachineStep m (Is a) a')))
 -> Maybe (Async (StM m (MachineStep m (Is b) b')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> m (Step (T a b) c (TeeT m a b c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go (t -> TeeT m a' b' c
f a'
t
a)) Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR (Maybe (Async (StM m (MachineStep m (Is a) a')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is a) a'))
    -> Maybe (Async (StM m (MachineStep m (Is a) a'))))
-> Async (StM m (MachineStep m (Is a) a'))
-> m (Step (T a b) c (TeeT m a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m (MachineStep m (Is a) a'))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
forall a. a -> Maybe a
Just
            Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg -> 
              (t -> ProcessT m a a')
-> T t b t
-> ProcessT m a a'
-> (Async (StM m (MachineStep m (Is a) a')) -> TeeT m a b c)
-> m (Step (T t b) c (TeeT m a b c))
forall (m :: * -> *) a (k :: * -> *) o (k' :: * -> *)
       (k1 :: * -> *) o1 b.
MonadBaseControl IO m =>
(a -> MachineT m k o)
-> k' a
-> MachineT m k o
-> (AsyncStep m k o -> MachineT m k1 o1)
-> m (Step k' b (MachineT m k1 o1))
asyncAwait t -> ProcessT m a a'
g T t b t
forall a b. T a b a
L ProcessT m a a'
fg ((Async (StM m (MachineStep m (Is a) a')) -> TeeT m a b c)
 -> m (Step (T t b) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is a) a')) -> TeeT m a b c)
-> m (Step (T t b) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ 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)
-> (Async (StM m (MachineStep m (Is a) a'))
    -> m (Step (T a b) c (TeeT m a b c)))
-> Async (StM m (MachineStep m (Is a) a'))
-> TeeT m a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Async (StM m (MachineStep m (Is a) a')))
 -> Maybe (Async (StM m (MachineStep m (Is b) b')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> m (Step (T a b) c (TeeT m a b c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go (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)) Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR (Maybe (Async (StM m (MachineStep m (Is a) a')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is a) a'))
    -> Maybe (Async (StM m (MachineStep m (Is a) a'))))
-> Async (StM m (MachineStep m (Is a) a'))
-> m (Step (T a b) c (TeeT m a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m (MachineStep m (Is a) a'))
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
forall a. a -> Maybe a
Just
          Await t -> TeeT m a' b' c
f T a' b' t
R TeeT m a' b' c
ff -> m (MachineStep m (Is b) b')
-> (Async (StM m (MachineStep m (Is b) b'))
    -> m (MachineStep m (Is b) b'))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (MachineStep m (Is b) b')
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MachineStep m (Is b) b' -> m (MachineStep m (Is b) b')
forall (m :: * -> *) a. Monad m => a -> m a
return MachineStep m (Is b) b'
forall (k :: * -> *) o r. Step k o r
Stop) Async (StM m (MachineStep m (Is b) b'))
-> m (MachineStep m (Is b) b')
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m a
wait Maybe (Async (StM m (MachineStep m (Is b) b')))
srcR m (MachineStep m (Is b) b')
-> (MachineStep m (Is 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
>>= 
                          \(MachineStep m (Is b) b'
u :: MachineStep m (Is b) b') -> case MachineStep m (Is b) b'
u of
            MachineStep m (Is b) b'
Stop            -> TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go TeeT m a' b' c
ff Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL Maybe (Async (StM m (MachineStep m (Is b) b')))
forall a. Maybe a
Nothing
            Yield b'
b ProcessT m b b'
k       -> ProcessT m b b' -> m (Async (StM m (MachineStep m (Is b) b')))
forall (m :: * -> *) (k :: * -> *) o.
MonadBaseControl IO m =>
MachineT m k o -> m (AsyncStep m k o)
asyncRun ProcessT m b b'
k m (Async (StM m (MachineStep m (Is b) b')))
-> (Async (StM m (MachineStep m (Is 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
>>= TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go (t -> TeeT m a' b' c
f b'
t
b) Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL (Maybe (Async (StM m (MachineStep m (Is b) b')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is b) b'))
    -> Maybe (Async (StM m (MachineStep m (Is b) b'))))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (T a b) c (TeeT m a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m (MachineStep m (Is b) b'))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
forall a. a -> Maybe a
Just
            Await t -> ProcessT m b b'
g Is b t
Refl ProcessT m b b'
fg -> 
              (t -> ProcessT m b b')
-> T a t t
-> ProcessT m b b'
-> (Async (StM m (MachineStep m (Is b) b')) -> TeeT m a b c)
-> m (Step (T a t) c (TeeT m a b c))
forall (m :: * -> *) a (k :: * -> *) o (k' :: * -> *)
       (k1 :: * -> *) o1 b.
MonadBaseControl IO m =>
(a -> MachineT m k o)
-> k' a
-> MachineT m k o
-> (AsyncStep m k o -> MachineT m k1 o1)
-> m (Step k' b (MachineT m k1 o1))
asyncAwait t -> ProcessT m b b'
g T a t t
forall a b. T a b b
R ProcessT m b b'
fg ((Async (StM m (MachineStep m (Is b) b')) -> TeeT m a b c)
 -> m (Step (T a t) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is b) b')) -> TeeT m a b c)
-> m (Step (T a t) c (TeeT m a b c))
forall a b. (a -> b) -> a -> b
$ 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)
-> (Async (StM m (MachineStep m (Is b) b'))
    -> m (Step (T a b) c (TeeT m a b c)))
-> Async (StM m (MachineStep m (Is b) b'))
-> TeeT m a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeeT m a' b' c
-> Maybe (Async (StM m (MachineStep m (Is a) a')))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
-> m (Step (T a b) c (TeeT m a b c))
go (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) Maybe (Async (StM m (MachineStep m (Is a) a')))
srcL (Maybe (Async (StM m (MachineStep m (Is b) b')))
 -> m (Step (T a b) c (TeeT m a b c)))
-> (Async (StM m (MachineStep m (Is b) b'))
    -> Maybe (Async (StM m (MachineStep m (Is b) b'))))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (T a b) c (TeeT m a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m (MachineStep m (Is b) b'))
-> Maybe (Async (StM m (MachineStep m (Is b) b')))
forall a. a -> Maybe a
Just