{-# LANGUAGE CPP, GADTs, FlexibleContexts, RankNTypes, ScopedTypeVariables,
             TupleSections #-}
-- | Support for machines with two inputs from which input may be
-- drawn deterministically or non-deterministically. In contrast to
-- "Data.Machine.Wye", the two inputs are eagerly run concurrently in
-- this implementation.
module Data.Machine.Concurrent.Wye (wye) where
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Concurrent.Async.Lifted (wait, waitEither)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Machine hiding (wye, (~>), (<~))
import Data.Machine.Concurrent.AsyncStep

isX :: Is a c -> Y a b c
isX :: Is a c -> Y a b c
isX Is a c
Refl = Y a b c
forall a b. Y a b a
X

isY :: Is b c -> Y a b c
isY :: Is b c -> Y a b c
isY Is b c
Refl = Y a b c
forall a b. Y a b b
Y

-- | Only the 'X' input of a 'Wye' is not yet stopped, so we may employ
-- simpler dispatch logic.
wyeOnlyX :: forall a a' b b' c m. MonadBaseControl IO m
         => AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX :: AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX AsyncStep m (Is a) a'
src WyeT m a' b' c
snk = m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall a b. (a -> b) -> a -> b
$ WyeT m a' b' c -> m (Step (Y a' b') c (WyeT m a' b' c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT WyeT m a' b' c
snk m (Step (Y a' b') c (WyeT m a' b' c))
-> (Step (Y a' b') c (WyeT m a' b' c)
    -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Y a' b') c (WyeT m a' b' c)
v -> case Step (Y a' b') c (WyeT m a' b' c)
v of
  Step (Y a' b') c (WyeT m a' b' c)
Stop -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. Step k o r
Stop
  Yield c
o WyeT m a' b' c
k -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Y a b) c (WyeT m a b c)
 -> m (Step (Y a b) c (WyeT m a b c)))
-> Step (Y a b) c (WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ c -> WyeT m a b c -> Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX AsyncStep m (Is a) a'
src WyeT m a' b' c
k)
  Await t -> WyeT m a' b' c
_ Y a' b' t
Y WyeT m a' b' c
ff -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
forall (k :: * -> *) b. Machine k b
stopped ProcessT m b b'
forall (k :: * -> *) b. Machine k b
stopped WyeT m a' b' c
ff
  Await t -> WyeT m a' b' c
f Y a' b' t
X WyeT m a' b' c
ff -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ (forall c. Is a c -> Y a b c)
-> AsyncStep m (Is a) t
-> (t -> WyeT m a' b' c)
-> WyeT m a' b' c
-> WyeT m a' b' c
-> (AsyncStep m (Is a) t -> WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) a' d b.
MonadBaseControl IO m =>
(forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync forall c. Is a c -> Y a b c
forall a c b. Is a c -> Y a b c
isX AsyncStep m (Is a) a'
AsyncStep m (Is a) t
src t -> WyeT m a' b' c
f WyeT m a' b' c
ff (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v) AsyncStep m (Is a) t -> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX
  Await t -> WyeT m a' b' c
f Y a' b' t
Z WyeT m a' b' c
ff -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ 
    (forall c. Is a c -> Y a b c)
-> AsyncStep m (Is a) a'
-> (a' -> WyeT m a' b' c)
-> WyeT m a' b' c
-> WyeT m a' b' c
-> (AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) a' d b.
MonadBaseControl IO m =>
(forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync forall c. Is a c -> Y a b c
forall a c b. Is a c -> Y a b c
isX AsyncStep m (Is a) a'
src (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> (a' -> t) -> a' -> WyeT m a' b' c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> t
forall a b. a -> Either a b
Left) WyeT m a' b' c
ff (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v) AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX

-- | Only the 'Y' input of a 'Wye' is not yet stopped, so we may
-- employ simpler dispatch logic.
wyeOnlyY :: MonadBaseControl IO m
         => AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY :: AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY AsyncStep m (Is b) b'
src WyeT m a' b' c
m = m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall a b. (a -> b) -> a -> b
$ WyeT m a' b' c -> m (Step (Y a' b') c (WyeT m a' b' c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT WyeT m a' b' c
m m (Step (Y a' b') c (WyeT m a' b' c))
-> (Step (Y a' b') c (WyeT m a' b' c)
    -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Y a' b') c (WyeT m a' b' c)
v -> case Step (Y a' b') c (WyeT m a' b' c)
v of
  Step (Y a' b') c (WyeT m a' b' c)
Stop -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. Step k o r
Stop
  Yield c
o WyeT m a' b' c
k -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Y a b) c (WyeT m a b c)
 -> m (Step (Y a b) c (WyeT m a b c)))
-> Step (Y a b) c (WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ c -> WyeT m a b c -> Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY AsyncStep m (Is b) b'
src WyeT m a' b' c
k)
  Await t -> WyeT m a' b' c
_ Y a' b' t
X WyeT m a' b' c
ff -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
forall (k :: * -> *) b. Machine k b
stopped ProcessT m b b'
forall (k :: * -> *) b. Machine k b
stopped WyeT m a' b' c
ff
  Await t -> WyeT m a' b' c
f Y a' b' t
Y WyeT m a' b' c
ff -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ (forall c. Is b c -> Y a b c)
-> AsyncStep m (Is b) t
-> (t -> WyeT m a' b' c)
-> WyeT m a' b' c
-> WyeT m a' b' c
-> (AsyncStep m (Is b) t -> WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) a' d b.
MonadBaseControl IO m =>
(forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync forall c. Is b c -> Y a b c
forall b c a. Is b c -> Y a b c
isY AsyncStep m (Is b) b'
AsyncStep m (Is b) t
src t -> WyeT m a' b' c
f WyeT m a' b' c
ff (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v) AsyncStep m (Is b) t -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY
  Await t -> WyeT m a' b' c
f Y a' b' t
Z WyeT m a' b' c
ff -> 
    WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ (forall c. Is b c -> Y a b c)
-> AsyncStep m (Is b) b'
-> (b' -> WyeT m a' b' c)
-> WyeT m a' b' c
-> WyeT m a' b' c
-> (AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) a' d b.
MonadBaseControl IO m =>
(forall c. k c -> k' c)
-> AsyncStep m k a'
-> (a' -> d)
-> d
-> d
-> (AsyncStep m k a' -> d -> MachineT m k' b)
-> MachineT m k' b
stepAsync forall c. Is b c -> Y a b c
forall b c a. Is b c -> Y a b c
isY AsyncStep m (Is b) b'
src (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> (b' -> t) -> b' -> WyeT m a' b' c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b' -> t
forall a b. b -> Either a b
Right) WyeT m a' b' c
ff (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v) AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY

-- | Precompose a 'Process' onto each input of a 'Wye' (or 'WyeT').
--
-- When the choice of input is free (using the 'Z' input descriptor)
-- the two sources will be interleaved.
wye :: forall m a a' b b' c.
       (MonadBaseControl IO m)
    => ProcessT m a a' -> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye :: ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
ma ProcessT m b b'
mb WyeT m a' b' c
m = m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c)) -> WyeT 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
                            Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
True WyeT m a' b' c
m Async (StM m (MachineStep m (Is a) a'))
srcL Async (StM m (MachineStep m (Is b) b'))
srcR
  where go :: Bool
           -> WyeT m a' b' c
           -> AsyncStep m (Is a) a'
           -> AsyncStep m (Is b) b'
           -> m (MachineStep m (Y a b) c)
        go :: Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair WyeT m a' b' c
snk Async (StM m (MachineStep m (Is a) a'))
srcL Async (StM m (MachineStep m (Is b) b'))
srcR = WyeT m a' b' c -> m (Step (Y a' b') c (WyeT m a' b' c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT WyeT m a' b' c
snk m (Step (Y a' b') c (WyeT m a' b' c))
-> (Step (Y a' b') c (WyeT m a' b' c)
    -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step (Y a' b') c (WyeT m a' b' c)
v -> case Step (Y a' b') c (WyeT m a' b' c)
v of
          Step (Y a' b') c (WyeT m a' b' c)
Stop         -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. Step k o r
Stop
          Yield c
o WyeT m a' b' c
k    -> Step (Y a b) c (WyeT m a b c) -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Y a b) c (WyeT m a b c)
 -> m (Step (Y a b) c (WyeT m a b c)))
-> (m (Step (Y a b) c (WyeT m a b c))
    -> Step (Y a b) c (WyeT m a b c))
-> m (Step (Y a b) c (WyeT m a b c))
-> m (Step (Y a b) c (WyeT m a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> WyeT m a b c -> Step (Y a b) c (WyeT m a b c)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield c
o (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> m (Step (Y a b) c (WyeT m a b c))
-> Step (Y a b) c (WyeT m a b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c))
 -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
-> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair WyeT m a' b' c
k Async (StM m (MachineStep m (Is a) a'))
srcL Async (StM m (MachineStep m (Is b) b'))
srcR
          Await t -> WyeT m a' b' c
f Y a' b' t
X WyeT m a' b' c
ff -> 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 Async (StM m (MachineStep m (Is a) a'))
srcL m (MachineStep m (Is a) a')
-> (MachineStep m (Is a) a' -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT 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 -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ Async (StM m (MachineStep m (Is b) b'))
-> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY Async (StM m (MachineStep m (Is b) b'))
srcR WyeT m a' b' c
ff
            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 (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Async (StM m (MachineStep m (Is a) a'))
 -> Async (StM m (MachineStep m (Is b) b'))
 -> m (Step (Y a b) c (WyeT m a b c)))
-> Async (StM m (MachineStep m (Is b) b'))
-> Async (StM m (MachineStep m (Is a) a'))
-> m (Step (Y a b) c (WyeT m a b c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair (t -> WyeT m a' b' c
f a'
t
a)) Async (StM m (MachineStep m (Is b) b'))
srcR
            Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg -> 
              (t -> ProcessT m a a')
-> Y t b t
-> ProcessT m a a'
-> (Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
-> m (Step (Y t b) c (WyeT 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 Y t b t
forall a b. Y a b a
X ProcessT m a a'
fg ((Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
 -> m (Step (Y t b) c (WyeT m a b c)))
-> (Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
-> m (Step (Y t b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> (Async (StM m (MachineStep m (Is a) a'))
    -> m (Step (Y a b) c (WyeT m a b c)))
-> Async (StM m (MachineStep m (Is a) a'))
-> WyeT m a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Async (StM m (MachineStep m (Is a) a'))
 -> Async (StM m (MachineStep m (Is b) b'))
 -> m (Step (Y a b) c (WyeT m a b c)))
-> Async (StM m (MachineStep m (Is b) b'))
-> Async (StM m (MachineStep m (Is a) a'))
-> m (Step (Y a b) c (WyeT m a b c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)) Async (StM m (MachineStep m (Is b) b'))
srcR
          Await t -> WyeT m a' b' c
f Y a' b' t
Y WyeT m a' b' c
ff -> 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 Async (StM m (MachineStep m (Is b) b'))
srcR m (MachineStep m (Is b) b')
-> (MachineStep m (Is b) b' -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT 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 -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ Async (StM m (MachineStep m (Is a) a'))
-> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX Async (StM m (MachineStep m (Is a) a'))
srcL WyeT m a' b' c
ff
            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 (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair (t -> WyeT m a' b' c
f b'
t
b) Async (StM m (MachineStep m (Is a) a'))
srcL
            Await t -> ProcessT m b b'
h Is b t
Refl ProcessT m b b'
fh -> 
              (t -> ProcessT m b b')
-> Y a t t
-> ProcessT m b b'
-> (Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
-> m (Step (Y a t) c (WyeT 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'
h Y a t t
forall a b. Y a b b
Y ProcessT m b b'
fh ((Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
 -> m (Step (Y a t) c (WyeT m a b c)))
-> (Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
-> m (Step (Y a t) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step (Y a b) c (WyeT m a b c)) -> WyeT m a b c)
-> (Async (StM m (MachineStep m (Is b) b'))
    -> m (Step (Y a b) c (WyeT m a b c)))
-> Async (StM m (MachineStep m (Is b) b'))
-> WyeT m a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go Bool
fair (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v) Async (StM m (MachineStep m (Is a) a'))
srcL

          -- Wait for whoever yields first
          Await t -> WyeT m a' b' c
f Y a' b' t
Z WyeT m a' b' c
_  -> 
            Bool
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Either (MachineStep m (Is a) a') (MachineStep m (Is b) b'))
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Bool -> Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitFair Bool
fair Async (StM m (MachineStep m (Is a) a'))
srcL Async (StM m (MachineStep m (Is b) b'))
srcR
            m (Either (MachineStep m (Is a) a') (MachineStep m (Is b) b'))
-> (Either (MachineStep m (Is a) a') (MachineStep m (Is b) b')
    -> m (Step (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Either (MachineStep m (Is a) a') (MachineStep m (Is b) b')
u :: Either (MachineStep m (Is a) a')
                              (MachineStep m (Is b) b')) -> case Either (MachineStep m (Is a) a') (MachineStep m (Is b) b')
u of
            Left (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 (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Async (StM m (MachineStep m (Is a) a'))
srcL' -> Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go (Bool -> Bool
not Bool
fair) (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> t -> WyeT m a' b' c
forall a b. (a -> b) -> a -> b
$ a' -> Either a' b'
forall a b. a -> Either a b
Left a'
a) Async (StM m (MachineStep m (Is a) a'))
srcL' Async (StM m (MachineStep m (Is b) b'))
srcR
            Right (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 (Y a b) c (WyeT m a b c)))
-> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Async (StM m (MachineStep m (Is b) b'))
srcR' -> Bool
-> WyeT m a' b' c
-> Async (StM m (MachineStep m (Is a) a'))
-> Async (StM m (MachineStep m (Is b) b'))
-> m (Step (Y a b) c (WyeT m a b c))
go (Bool -> Bool
not Bool
fair) (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> t -> WyeT m a' b' c
forall a b. (a -> b) -> a -> b
$ b' -> Either a' b'
forall a b. b -> Either a b
Right b'
b) Async (StM m (MachineStep m (Is a) a'))
srcL Async (StM m (MachineStep m (Is b) b'))
srcR'
            Left MachineStep m (Is a) a'
Stop -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ Async (StM m (MachineStep m (Is b) b'))
-> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY Async (StM m (MachineStep m (Is b) b'))
srcR (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
            Right MachineStep m (Is b) b'
Stop -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ Async (StM m (MachineStep m (Is a) a'))
-> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX Async (StM m (MachineStep m (Is a) a'))
srcL (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)

            -- The first source to respond wants to await, see what
            -- the other source has to offer.
            Left la :: MachineStep m (Is a) a'
la@(Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg) -> 
              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 Async (StM m (MachineStep m (Is b) b'))
srcR m (MachineStep m (Is b) b')
-> (MachineStep m (Is b) b' -> m (Step (Y t b) c (WyeT m a b c)))
-> m (Step (Y t b) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(MachineStep m (Is b) b'
w :: MachineStep m (Is b) b') -> case MachineStep m (Is b) b'
w of
                MachineStep m (Is b) b'
Stop -> (t -> ProcessT m a a')
-> Y t b t
-> ProcessT m a a'
-> (Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
-> m (Step (Y t b) c (WyeT 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 Y t b t
forall a b. Y a b a
X ProcessT m a a'
fg ((Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
 -> m (Step (Y t b) c (WyeT m a b c)))
-> (Async (StM m (MachineStep m (Is a) a')) -> WyeT m a b c)
-> m (Step (Y t b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ \Async (StM m (MachineStep m (Is a) a'))
l' -> Async (StM m (MachineStep m (Is a) a'))
-> WyeT m a' b' c -> WyeT m a b c
forall a a' b b' c (m :: * -> *).
MonadBaseControl IO m =>
AsyncStep m (Is a) a' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyX Async (StM m (MachineStep m (Is a) a'))
l' (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
                Yield b'
b ProcessT m b b'
k -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (MachineStep m (Is a) a' -> ProcessT m a a'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is a) a'
la) ProcessT m b b'
k (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> t -> WyeT m a' b' c
forall a b. (a -> b) -> a -> b
$ b' -> Either a' b'
forall a b. b -> Either a b
Right b'
b)
                ra :: MachineStep m (Is b) b'
ra@(Await t -> ProcessT m b b'
h Is b t
Refl ProcessT m b b'
fh) -> Step (Y t t) c (WyeT m a b c) -> m (Step (Y t t) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Y t t) c (WyeT m a b c)
 -> m (Step (Y t t) c (WyeT m a b c)))
-> Step (Y t t) c (WyeT m a b c)
-> m (Step (Y t t) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$
                  (Either t t -> WyeT m a b c)
-> Y t t (Either t t)
-> WyeT m a b c
-> Step (Y t t) c (WyeT m a b c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\Either t t
c -> case Either t t
c of
                                 Left t
a -> ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (t -> ProcessT m a a'
g t
a) (MachineStep m (Is b) b' -> ProcessT m b b'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is b) b'
ra) (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
                                 Right t
b -> ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (MachineStep m (Is a) a' -> ProcessT m a a'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is a) a'
la) (t -> ProcessT m b b'
h t
b) (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v))
                        Y t t (Either t t)
forall a b. Y a b (Either a b)
Z
                        (ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
fg ProcessT m b b'
fh (WyeT m a' b' c -> WyeT m a b c) -> WyeT m a' b' c -> WyeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
            Right ra :: MachineStep m (Is b) b'
ra@(Await t -> ProcessT m b b'
h Is b t
Refl ProcessT m b b'
fh) -> 
              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 Async (StM m (MachineStep m (Is a) a'))
srcL m (MachineStep m (Is a) a')
-> (MachineStep m (Is a) a' -> m (Step (Y a t) c (WyeT m a b c)))
-> m (Step (Y a t) c (WyeT m a b c))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(MachineStep m (Is a) a'
w :: MachineStep m (Is a) a') -> case MachineStep m (Is a) a'
w of
                MachineStep m (Is a) a'
Stop -> (t -> ProcessT m b b')
-> Y a t t
-> ProcessT m b b'
-> (Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
-> m (Step (Y a t) c (WyeT 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'
h Y a t t
forall a b. Y a b b
Y ProcessT m b b'
fh ((Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
 -> m (Step (Y a t) c (WyeT m a b c)))
-> (Async (StM m (MachineStep m (Is b) b')) -> WyeT m a b c)
-> m (Step (Y a t) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ \Async (StM m (MachineStep m (Is b) b'))
r' -> Async (StM m (MachineStep m (Is b) b'))
-> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) b b' a' c a.
MonadBaseControl IO m =>
AsyncStep m (Is b) b' -> WyeT m a' b' c -> WyeT m a b c
wyeOnlyY Async (StM m (MachineStep m (Is b) b'))
r' (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
                Yield a'
a ProcessT m a a'
k -> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c)))
-> WyeT m a b c -> m (Step (Y a b) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$ ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
k (MachineStep m (Is b) b' -> ProcessT m b b'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is b) b'
ra) (t -> WyeT m a' b' c
f (t -> WyeT m a' b' c) -> t -> WyeT m a' b' c
forall a b. (a -> b) -> a -> b
$ a' -> Either a' b'
forall a b. a -> Either a b
Left a'
a)
                la :: MachineStep m (Is a) a'
la@(Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg) -> Step (Y t t) c (WyeT m a b c) -> m (Step (Y t t) c (WyeT m a b c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Y t t) c (WyeT m a b c)
 -> m (Step (Y t t) c (WyeT m a b c)))
-> Step (Y t t) c (WyeT m a b c)
-> m (Step (Y t t) c (WyeT m a b c))
forall a b. (a -> b) -> a -> b
$
                  (Either t t -> WyeT m a b c)
-> Y t t (Either t t)
-> WyeT m a b c
-> Step (Y t t) c (WyeT m a b c)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\Either t t
c -> case Either t t
c of
                                 Left t
a -> ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (t -> ProcessT m a a'
g t
a) (MachineStep m (Is b) b' -> ProcessT m b b'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is b) b'
ra) (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
                                 Right t
b -> ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (MachineStep m (Is a) a' -> ProcessT m a a'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased MachineStep m (Is a) a'
la) (t -> ProcessT m b b'
h t
b) (Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v))
                        Y t t (Either t t)
forall a b. Y a b (Either a b)
Z
                        (ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
MonadBaseControl IO m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
fg ProcessT m b b'
fh (WyeT m a' b' c -> WyeT m a b c) -> WyeT m a' b' c -> WyeT m a b c
forall a b. (a -> b) -> a -> b
$ Step (Y a' b') c (WyeT m a' b' c) -> WyeT m a' b' c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Y a' b') c (WyeT m a' b' c)
v)
          where waitFair :: Bool -> Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitFair Bool
True Async (StM m a)
l Async (StM m b)
r = Async (StM m a) -> Async (StM m b) -> m (Either a b)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEither Async (StM m a)
l Async (StM m b)
r
                waitFair Bool
False Async (StM m a)
l Async (StM m b)
r = (b -> Either a b) -> (a -> Either a b) -> Either b a -> Either a b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> Either a b
forall a b. b -> Either a b
Right a -> Either a b
forall a b. a -> Either a b
Left (Either b a -> Either a b) -> m (Either b a) -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Async (StM m b) -> Async (StM m a) -> m (Either b a)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEither Async (StM m b)
r Async (StM m a)
l