{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.Wye
-- 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.Wye
  (
  -- * Wyes
    Wye, WyeT
  , Y(..)
  , wye
  , addX, addY
  , capX, capY, capWye
  ) where

import Control.Category
import Data.Machine.Process
import Data.Machine.Type
import Data.Machine.Is
import Data.Machine.Source
import Prelude hiding ((.),id)

-------------------------------------------------------------------------------
-- Wyes
-------------------------------------------------------------------------------

-- | The input descriptor for a 'Wye' or 'WyeT'
data Y a b c where
  X :: Y a b a            -- block waiting on the left input
  Y :: Y a b b            -- block waiting on the right input
  Z :: Y a b (Either a b) -- block waiting on either input

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

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

-- | Compose a pair of pipes onto the front of a 'Wye'.

-- | Precompose a 'Process' onto each input of a 'Wye' (or 'WyeT').
--
-- This is left biased in that it tries to draw values from the 'X' input whenever they are
-- available, and only draws from the 'Y' input when 'X' would block.
wye :: Monad 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
$ 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
  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 (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.
Monad m =>
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
k)
  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
  Await t -> WyeT m a' b' c
f Y a' b' t
X WyeT 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 (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 (Is a) a' (ProcessT m a a')
u -> case Step (Is a) a' (ProcessT m a a')
u of
    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 -> WyeT m a b c)
-> WyeT m a' b' c
-> m (Step (Y a b) c (WyeT m a b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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 ProcessT m b b'
mb (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
$ t -> WyeT m a' b' c
f a'
t
a
    Step (Is a) a' (ProcessT m 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
$ 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.
Monad 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'
mb WyeT m a' b' c
ff
    Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg     -> 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)))
-> (WyeT m a' b' c -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (t -> WyeT m a b c)
-> Y t b t -> WyeT m a b c -> Step (Y t b) c (WyeT 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' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad 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) ProcessT m b b'
mb (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) Y t b t
forall a b. Y a b a
X
                                  (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a' b' c
-> Step (Y a b) c (WyeT m a b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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'
mb (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
$ 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
  Await t -> WyeT m a' b' c
f Y a' b' t
Y WyeT 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 (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 (Is b) b' (ProcessT m b b')
u -> case Step (Is b) b' (ProcessT m b b')
u of
    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 -> WyeT m a b c)
-> WyeT m a' b' c
-> m (Step (Y a b) c (WyeT m a b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad m =>
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'
k (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
$ t -> WyeT m a' b' c
f b'
t
b
    Step (Is b) b' (ProcessT m 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
$ 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.
Monad m =>
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'
forall (k :: * -> *) b. Machine k b
stopped WyeT m a' b' c
ff
    Await t -> ProcessT m b b'
g Is b t
Refl ProcessT m b b'
fg     -> 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)))
-> (WyeT m a' b' c -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (t -> WyeT m a b c)
-> Y a t t -> WyeT m a b c -> Step (Y a t) c (WyeT 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' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m a a'
ma (t -> ProcessT m b b'
g t
b) (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) Y a t t
forall a b. Y a b b
Y
                                  (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a' b' c
-> Step (Y a b) c (WyeT m a b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad m =>
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'
fg (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
$ 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
  Await t -> WyeT m a' b' c
f Y a' b' t
Z WyeT 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 (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 (Is a) a' (ProcessT m a a')
u -> case Step (Is a) a' (ProcessT m a a')
u of
    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)))
-> (Either a' b' -> WyeT m a b c)
-> Either a' b'
-> m (Step (Y a b) c (WyeT m a b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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 ProcessT m b b'
mb (WyeT m a' b' c -> WyeT m a b c)
-> (Either a' b' -> WyeT m a' b' c) -> Either a' b' -> WyeT m a b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> WyeT m a' b' c
Either a' b' -> WyeT m a' b' c
f (Either a' b' -> m (Step (Y a b) c (WyeT m a b c)))
-> Either a' b' -> m (Step (Y a b) c (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
    Step (Is a) a' (ProcessT m a a')
Stop                -> 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 (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 (Is b) b' (ProcessT m b b')
w -> case Step (Is b) b' (ProcessT m b b')
w of
      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)))
-> (Either a' b' -> WyeT m a b c)
-> Either a' b'
-> m (Step (Y a b) c (WyeT m a b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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'
k (WyeT m a' b' c -> WyeT m a b c)
-> (Either a' b' -> WyeT m a' b' c) -> Either a' b' -> WyeT m a b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> WyeT m a' b' c
Either a' b' -> WyeT m a' b' c
f (Either a' b' -> m (Step (Y a b) c (WyeT m a b c)))
-> Either a' b' -> m (Step (Y a b) c (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
      Step (Is b) b' (ProcessT m 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
$ 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.
Monad 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 -> ProcessT m b b'
g Is b t
Refl ProcessT m b b'
fg     -> 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)))
-> (WyeT m a' b' c -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (t -> WyeT m a b c)
-> Y a t t -> WyeT m a b c -> Step (Y a t) c (WyeT 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' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad 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 (t -> ProcessT m b b'
g t
b) (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) Y a t t
forall a b. Y a b b
Y
                                    (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a' b' c
-> Step (Y a b) c (WyeT m a b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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'
fg (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
$ 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
    Await t -> ProcessT m a a'
g Is a t
Refl ProcessT m a a'
fg     -> 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 (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 (Is b) b' (ProcessT m b b')
w -> case Step (Is b) b' (ProcessT m b b')
w of
      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)))
-> (Either a' b' -> WyeT m a b c)
-> Either a' b'
-> m (Step (Y a b) c (WyeT m a b c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (Step (Is a) a' (ProcessT m a a') -> ProcessT m a a'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is a) a' (ProcessT m a a')
u) ProcessT m b b'
k (WyeT m a' b' c -> WyeT m a b c)
-> (Either a' b' -> WyeT m a' b' c) -> Either a' b' -> WyeT m a b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> WyeT m a' b' c
Either a' b' -> WyeT m a' b' c
f (Either a' b' -> m (Step (Y a b) c (WyeT m a b c)))
-> Either a' b' -> m (Step (Y a b) c (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
      Step (Is b) b' (ProcessT m b b')
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)
 -> m (Step (Y a b) c (WyeT m a b c)))
-> (WyeT m a' b' c -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (t -> WyeT m a b c)
-> Y t b t -> WyeT m a b c -> Step (Y t b) c (WyeT 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' -> WyeT m a' b' c -> WyeT m a b c
forall (m :: * -> *) a a' b b' c.
Monad 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) ProcessT m b b'
forall (k :: * -> *) b. Machine k b
stopped (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) Y t b t
forall a b. Y a b a
X
                                    (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a' b' c
-> Step (Y a b) c (WyeT m a b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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'
forall (k :: * -> *) b. Machine k b
stopped (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
$ 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
      Await t -> ProcessT m b b'
h Is b t
Refl ProcessT m b b'
fh     -> 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)))
-> (WyeT m a' b' c -> 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (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.
Monad 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) (Step (Is b) b' (ProcessT m b b') -> ProcessT m b b'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is b) b' (ProcessT m b b')
w) (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 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.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye (Step (Is a) a' (ProcessT m a a') -> ProcessT m a a'
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step (Is a) a' (ProcessT m a a')
u) (t -> ProcessT m b b'
h t
b) (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) Y t t (Either t t)
forall a b. Y a b (Either a b)
Z
                                    (WyeT m a b c -> Step (Y a b) c (WyeT m a b c))
-> (WyeT m a' b' c -> WyeT m a b c)
-> WyeT m a' b' c
-> Step (Y a b) c (WyeT m a b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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.
Monad 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 -> 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
$ 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

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

-- | Precompose a pipe onto the right input of a wye.
addY :: Monad m => ProcessT m b c -> WyeT m a c d -> WyeT m a b d
addY :: ProcessT m b c -> WyeT m a c d -> WyeT m a b d
addY = ProcessT m a a -> ProcessT m b c -> WyeT m a c d -> WyeT m a b d
forall (m :: * -> *) a a' b b' c.
Monad 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 a. Process a a
echo
{-# INLINE addY #-}

-- | Tie off one input of a wye by connecting it to a known source.
capX :: Monad m => SourceT m a -> WyeT m a b c -> ProcessT m b c
capX :: SourceT m a -> WyeT m a b c -> ProcessT m b c
capX SourceT m a
s WyeT m a b c
t = (forall a. Y b b a -> b -> a)
-> MachineT m (Y b b) c -> ProcessT m b c
forall (m :: * -> *) (k :: * -> *) i o.
Monad m =>
(forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process ((b -> Either b b) -> Y b b a -> b -> a
forall a b. (a -> Either a a) -> Y a a b -> a -> b
capped b -> Either b b
forall a b. b -> Either a b
Right) (ProcessT m b a -> WyeT m a b c -> MachineT m (Y b b) c
forall (m :: * -> *) a b c d.
Monad m =>
ProcessT m a b -> WyeT m b c d -> WyeT m a c d
addX ProcessT m b a
SourceT m a
s WyeT m a b c
t)
{-# INLINE capX #-}

-- | Tie off one input of a wye by connecting it to a known source.
capY :: Monad m => SourceT m b -> WyeT m a b c -> ProcessT m a c
capY :: SourceT m b -> WyeT m a b c -> ProcessT m a c
capY SourceT m b
s WyeT m a b c
t = (forall a. Y a a a -> a -> a)
-> MachineT m (Y a a) c -> ProcessT m a c
forall (m :: * -> *) (k :: * -> *) i o.
Monad m =>
(forall a. k a -> i -> a) -> MachineT m k o -> ProcessT m i o
process ((a -> Either a a) -> Y a a a -> a -> a
forall a b. (a -> Either a a) -> Y a a b -> a -> b
capped a -> Either a a
forall a b. a -> Either a b
Left) (ProcessT m a b -> WyeT m a b c -> MachineT m (Y a a) c
forall (m :: * -> *) b c a d.
Monad m =>
ProcessT m b c -> WyeT m a c d -> WyeT m a b d
addY ProcessT m a b
SourceT m b
s WyeT m a b c
t)
{-# INLINE capY #-}

-- | Tie off both inputs of a wye by connecting them to known sources.
capWye :: Monad m => SourceT m a -> SourceT m b -> WyeT m a b c -> SourceT m c
capWye :: SourceT m a -> SourceT m b -> WyeT m a b c -> SourceT m c
capWye SourceT m a
a SourceT m b
b WyeT m a b c
w = MachineT m (Y Any Any) c -> SourceT m c
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
MachineT m k o -> SourceT m o
plug (MachineT m (Y Any Any) c -> SourceT m c)
-> MachineT m (Y Any Any) c -> SourceT m c
forall a b. (a -> b) -> a -> b
$ ProcessT m Any a
-> ProcessT m Any b -> WyeT m a b c -> MachineT m (Y Any Any) c
forall (m :: * -> *) a a' b b' c.
Monad m =>
ProcessT m a a'
-> ProcessT m b b' -> WyeT m a' b' c -> WyeT m a b c
wye ProcessT m Any a
SourceT m a
a ProcessT m Any b
SourceT m b
b WyeT m a b c
w
{-# INLINE capWye #-}

-- | Natural transformation used by 'capX' and 'capY'
capped :: (a -> Either a a) -> Y a a b -> a -> b
capped :: (a -> Either a a) -> Y a a b -> a -> b
capped a -> Either a a
_ Y a a b
X = a -> b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
capped a -> Either a a
_ Y a a b
Y = a -> b
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
capped a -> Either a a
f Y a a b
Z = a -> b
a -> Either a a
f
{-# INLINE capped #-}