# Specializing Coroutine to our purposes

Rather than explain right now why we're doing this, just stick with me while I specialize the previous Coroutine code to our use case, hardcoding the `Interface`

into the type, and making `Producing`

and `Consuming`

newtypes. One benefit to this is that users will have clearer type errors. I've included the Coroutine type declarations to help illustrate that all I have done here is set the suspension functor to `Interface i o`

.

```
-- newtype Coroutine s m r
-- = Coroutine { resume :: m (CoroutineState s m r) }
newtype Producing o i m r
= Producing { resume :: m (ProducerState o i m r) }
-- data CoroutineState s m r
-- = Run (s (Coroutine s m r))
-- | Done r
data ProducerState o i m r
= Produced o (Consuming r m i o)
| Done r
newtype Consuming r m i o
= Consuming { provide :: i -> Producing o i m r }
```

Since nothing has really changed, the type class instances remain essentially the same as well. I'll provide my implementation here for clarity, though. Notice the similar recursion scheme for implementing `fmap`

for `ProducerState o i`

, and implementing `>>=`

and `hoist`

for `Producing o i`

.

```
instance (Functor m) => Functor (Producing o i m) where
fmap f p = Producing $ fmap (fmap f) (resume p)
instance (Functor m) => Functor (ProducerState o i m) where
fmap f (Done x) = Done (f x)
fmap f (Produced o k) = Produced o $ Consuming (fmap f . provide k)
instance (Functor m, Monad m) => Applicative (Producing o i m) where
pure = return
(<*>) = ap
instance (Monad m) => Monad (Producing o i m) where
return x = Producing $ return (Done x)
p >>= f = Producing $ resume p >>= \s -> case s of
Done x -> resume (f x)
Produced o k ->
return $ Produced o $ Consuming ((>>= f) . provide k)
instance MonadTrans (Producing o i) where
lift = Producing . liftM Done
instance MFunctor (Producing o i) where
hoist f = go where
go p = Producing $ f $ liftM map' (resume p)
map' (Done r) = Done r
map' (Produced o k) = Produced o $ Consuming (go . provide k)
```

The main operations, `yield`

and `$$`

, remain the same, modulo newtype gymnastics.

```
yield :: Monad m => o -> Producing o i m i
yield o = Producing $ return $ Produced o $ Consuming return
infixl 0 $$
($$) :: Monad m => Producing a b m r -> Consuming r m a b -> m r
producing $$ consuming = resume producing >>= \s -> case s of
Done r -> return r
Produced o k -> provide consuming o $$ k
```

Before we go further, I suppose we should play with what we've got.

# Play time

```
-- /show
import Control.Applicative
import Control.Monad
import Control.Monad.Morph
import Control.Monad.Trans.Class
newtype Producing o i m r
= Producing { resume :: m (ProducerState o i m r) }
data ProducerState o i m r
= Produced o (Consuming r m i o)
| Done r
newtype Consuming r m i o
= Consuming { provide :: i -> Producing o i m r }
instance (Functor m) => Functor (Producing o i m) where
fmap f p = Producing $ fmap (fmap f) (resume p)
instance (Functor m) => Functor (ProducerState o i m) where
fmap f (Done x) = Done (f x)
fmap f (Produced o k) = Produced o $ Consuming (fmap f . provide k)
instance (Functor m, Monad m) => Applicative (Producing o i m) where
pure = return
(<*>) = ap
instance (Monad m) => Monad (Producing o i m) where
return x = Producing $ return (Done x)
p >>= f = Producing $ resume p >>= \s -> case s of
Done x -> resume (f x)
Produced o k ->
return $ Produced o $ Consuming ((>>= f) . provide k)
instance MonadTrans (Producing o i) where
lift = Producing . liftM Done
instance MFunctor (Producing o i) where
hoist f = go where
go p = Producing $ f $ liftM map' (resume p)
map' (Done r) = Done r
map' (Produced o k) = Produced o $ Consuming (go . provide k)
yield :: Monad m => o -> Producing o i m i
yield o = Producing $ return $ Produced o $ Consuming return
infixl 0 $$
($$) :: Monad m => Producing a b m r -> Consuming r m a b -> m r
producing $$ consuming = resume producing >>= \s -> case s of
Done r -> return r
Produced o k -> provide consuming o $$ k
-- show
example1 :: Producing String String IO ()
example1 = do
name <- yield "What's your name? "
lift $ putStrLn $ "Hello, " ++ name
color <- yield "What's your favorite color? "
lift $ putStrLn $ "I like " ++ color ++ ", too."
-- this comes in handy for defining Consumers
foreverK :: Monad m => (a -> m a) -> a -> m r
foreverK f = go where
go a = f a >>= go
stdOutIn :: Consuming r IO String String
stdOutIn = Consuming $ foreverK $ \str -> do
lift $ putStrLn str
lift getLine >>= yield
stdInOut :: Producing String String IO r
stdInOut = provide stdOutIn ""
main = example1 $$ stdOutIn
```

Try building your own coroutines with the Producing monad, and hooking them together with `$$`

. But remember, they must be in opposite states, and have compatible interfaces, as well as the same underlying monad, in order to connect.

# Two interfaces makes a Proxy

What happens when we put two interfaces on top of each other?

`Producing a b (Producing c d m) r`

What *is* this? Well, it is a computation which can transfer control to one of two interfaces. The action `yield a`

will surrender control to the outer interface, while `lift (yield c)`

will surrender control to the inner interface. What happens when we connect such a thing's outer interface?

```
p :: Producing a b (Producing c d m) r
c :: Consuming r (Producing c d m) a b
p $$ c :: Producing c d m r
```

Since the "inner monad" is `Producing c d m`

, the "Consuming" counterpart must have the same inner monad, `Producing c d m`

. Once connected, the two computations *merge* their use of the `c/d`

interface, and become (to the outside world) one computation. The `a/b`

interface becomes unobservable, or satisfied, or connected, or whatever you want to call it.

That's cool, but there is something obnoxious about it. What if I want to connect computations which don't necessarily suspend on the same underlying interfaces?

```
p :: Producing a b m r
c :: Consuming r (Producing c d m) a b
p $$ c :: Type Error
```

Luckily, `hoist`

and `lift`

can help us insert the missing layer, so that the two can connect. After all, we can say that `p`

communicates on the `c/d`

interface, it just *happens* to do so zero times.

```
insert0 = lift -- add a new layer at depth 0 (the outermost layer)
insert1 = hoist insert0 -- add a new layer at depth 1
insert2 = hoist insert1 -- add a new layer at depth 2
p :: Producing a b m r
insert1 p :: Producing a b (t m) r -- t = any MonadTrans we want
c :: Consuming r (Producing c d m) a b
-- t becomes specialized to (Producing c d)
insert1 p $$ c :: Producing c d m r
```

What just happened? We took a computation over the `a/b`

interface, *connected* it to a computation over *both* the `a/b`

and `c/d`

interfaces, and *transformed* it into just a computation over the `c/d`

interface. My friends, we have stumbled onto the concept of a `Proxy`

, and just implemented `$=`

.

```
newtype Proxy r m upI downI
= Proxy { unProxy :: Consuming r (Producing (Fst downI) (Snd downI) m) (Fst upI) (Snd upI) }
type family Fst (xy :: (*,*)) :: *
type family Snd (xy :: (*,*)) :: *
type instance Fst '(x,y) = x
type instance Snd '(x,y) = y
($=) :: Monad m => Producing a b m r -> Proxy r m '(a,b) '(c,d) -> Producing c d m r
producing $= Proxy proxy = insert1 producing $$ proxy
```

Proxies have two interfaces, a "downstream" interface, and an "upstream" interface. We can connect a proxy to a `Producing`

coroutine via the proxy's upstream interface (also its *outer* interface, which is in a state of `Consuming`

). I gave `Proxy`

a rather unsightly definition, which allows us to write each interface as a tuple. (This requires `DataKinds`

, `KindSignatures`

, and `TypeFamilies`

language extensions.) The reason for this is so that we can (once ghc-7.8 is finished) write the Category instance for `Proxy`

. We'll talk more about this later.

# Producing layers commute

On the topic of two interfaces, when thinking about it from the "enhanced language" perspective, it seems intuitive that `Producing a b (Producing c d m) r`

is the same as `Producing c d (Producing a b m) r`

. And it is!

```
-- show given this (puzzle pieces)
{-# LANGUAGE ScopedTypeVariables #-} -- this comes in handy
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE KindSignatures #-}
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.Morph (MFunctor, hoist)
data Producing o i (m :: * -> *) r -- don't rely on the internals of this
instance (Monad m) => Monad (Producing o i m) where
instance MonadTrans (Producing o i) where
instance MFunctor (Producing o i) where
newtype Consuming r m i o
= Consuming { provide :: i -> Producing o i m r }
infixl 0 $$
($$) :: Monad m => Producing a b m r -> Consuming r m a b -> m r
producing $$ consuming = undefined -- take this as a given
-- The proxy newtype was left out for simplicity
idProxy :: Monad m => Consuming r (Producing a b m) a b
idProxy = undefined -- take this as a given
-- bonus: implement this by also assuming yield as a given
insert0 :: Monad m =>
m r -> Producing a b m r
insert0 = lift
insert1 :: (MFunctor t, Monad m) =>
t m r -> t (Producing a b m) r
insert1 = hoist insert0
insert2 :: (MFunctor t, MFunctor t2, Monad m, Monad (t m)) =>
t2 (t m) r -> t2 (t (Producing a b m)) r
insert2 = hoist insert1
-- show implement this (the puzzle)
commute :: forall a b c d m r. Monad m =>
Producing a b (Producing c d m) r -> Producing c d (Producing a b m) r
commute p = p' $$ funnel where
-- what types should p' and funnel have? (leverage scoped type variables)
p' :: ()
p' = undefined
funnel :: ()
funnel = undefined
-- types hint: remember, $$ removes the outermost interface
-- implementation hint: use insert0/1/2 with p and idProxy
-- show and see if it compiles. Type tetris is fun!
main = putStrLn "It compiles!"
```

```
commute :: forall a b c d m r. Monad m =>
Producing a b (Producing c d m) r -> Producing c d (Producing a b m) r
commute p = p' $$ funnel where
p' :: Producing a b (Producing c d (Producing a b m)) r
p' = insert2 p
funnel :: Consuming r (Producing c d (Producing a b m)) a b
funnel = Consuming (insert1 . provide idProxy)
```

Cool! With clever use of `insert1`

and friends, we see that coroutine interface layers commute.

# More implementation

Now that we have `$$`

, and `commute`

at our disposal, we have the high-level tools we need to implement `=$`

and `=$=`

as well. Go ahead, give it a shot!

```
-- show given this
{-# LANGUAGE ScopedTypeVariables #-} -- this comes in handy
{-# LANGUAGE EmptyDataDecls, KindSignatures #-}
{-# LANGUAGE DataKinds, TypeFamilies #-}
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.Morph (MFunctor, hoist)
data Producing o i (m :: * -> *) r -- don't rely on the internals of this
instance (Monad m) => Monad (Producing o i m) where
instance MonadTrans (Producing o i) where
instance MFunctor (Producing o i) where
newtype Consuming r m i o
= Consuming { provide :: i -> Producing o i m r }
newtype Proxy r m upI downI
= Proxy { unProxy :: Consuming r (Producing (Fst downI) (Snd downI) m) (Fst upI) (Snd upI) }
type family Fst (xy :: (*,*)) :: *
type family Snd (xy :: (*,*)) :: *
type instance Fst '(x,y) = x
type instance Snd '(x,y) = y
infixl 0 $$
($$) :: Monad m => Producing a b m r -> Consuming r m a b -> m r
producing $$ consuming = undefined -- take this as a given
commute :: Monad m => Producing a b (Producing c d m) r
-> Producing c d (Producing a b m) r
commute = undefined -- take this as a given
insert0 :: Monad m =>
m r -> Producing a b m r
insert0 = lift
insert1 :: (MFunctor t, Monad m) =>
t m r -> t (Producing a b m) r
insert1 = hoist insert0
insert2 :: (MFunctor t, MFunctor t2, Monad m, Monad (t m)) =>
t2 (t m) r -> t2 (t (Producing a b m)) r
insert2 = hoist insert1
-- show implement these
(=$) :: forall a b c d m r. Monad m =>
Proxy r m '(a,b) '(c,d) -> Consuming r m c d -> Consuming r m a b
Proxy proxy =$ consuming = Consuming $ \(a :: a) ->
let
p :: ()
p = undefined
c :: ()
c = undefined
in
p $$ c
(=$=) :: forall a a' b b' c c' m r. Monad m =>
Proxy r m '(a,a') '(b,b') -> Proxy r m '(b,b') '(c,c') -> Proxy r m '(a,a') '(c,c')
Proxy proxyl =$= Proxy proxyr = Proxy $ Consuming $ \(a :: a) ->
let
p :: ()
p = undefined
c :: ()
c = undefined
in
p $$ c
-- show and see if it compiles.
main = putStrLn "It compiles!"
```

```
(=$) :: forall a b c d m r. Monad m =>
Proxy r m '(a,b) '(c,d) -> Consuming r m c d -> Consuming r m a b
Proxy proxy =$ consuming = Consuming $ \(a :: a) ->
let
p :: Producing c d (Producing b a m) r
p = commute (provide proxy a)
c :: Consuming r (Producing b a m) c d
c = Consuming (insert1 . provide consuming)
in
p $$ c
(=$=) :: forall a a' b b' c c' m r. Monad m =>
Proxy r m '(a,a') '(b,b') -> Proxy r m '(b,b') '(c,c') -> Proxy r m '(a,a') '(c,c')
Proxy proxyl =$= Proxy proxyr = Proxy $ Consuming $ \(a :: a) ->
let
p :: Producing b b' (Producing a' a (Producing c c' m)) r
p = insert2 (commute (provide proxyl a))
c :: Consuming r (Producing a' a (Producing c c' m)) b b'
c = Consuming $ insert1 . provide proxyr
in
p $$ c
```