Previously we put together a DSL using the free monad and a corresponding interpreter using the cofree comonad.

We had an ad-hoc interpreter for our DSL:

```
interpret :: Monad m => Int -> Int -> AdderT m r -> m r
interpret limit count a = do
mr <- runFreeT a
case mr of
Pure r -> return r
Free (Add x k) ->
let
count' = x + count
test = count' <= limit
next = if test then count' else count
in
interpret limit next (k test)
Free (Clear k) ->
interpret limit 0 k
Free (Total k) ->
interpret limit count (k count)
```

We also had an interpreter based on the cofree comonad that corresponds to the DSL:

```
type CoAdder a = Cofree CoAdderF a
mkCoAdder :: Int -> Int -> CoAdder (Int, Int)
mkCoAdder limit count = coiter next start
where
next = CoAdderF <$> coAdd <*> coClear <*> coTotal
start = (limit, count)
coAdd :: (Int, Int) -> Int -> (Bool, (Int, Int))
coAdd (limit, count) x = (test, (limit, next))
where
count' = count + x
test = count' <= limit
next = if test then count' else count
coClear :: (Int, Int) -> (Int, Int)
coClear (limit, _) = (limit, 0)
coTotal :: (Int, Int) -> (Int, (Int, Int))
coTotal (limit, count) = (count, (limit, count))
```

Both of these work, but we can do better. The ad-hoc interpreter can be cleaned up by using monad transformers. It should be unsurprising - especially given the title of this post - that we can clean up the cofree comonad version of the interpreter using comonad transformers.

If you’re comfortable with monad transformers you can skip this. If you’re not yet comfortable with monad transformers this probably won’t help much.

A few people have found these links helpful:

I’ll at least put in a token effort, and some of the examples and analogies will be reused when I get to comonad transformers, so it’s not all a waste.

If you’ve ready my brief overview of comonads you might recall my hand-wavy explanation of how monads are related to building up a value in a monadic context from a pure values.

We might need to look at the `Monad`

typeclass at the correct angle to see that.

```
class Monad m where
return :: a -> m a
bind :: (a -> m b) -> m a -> m b
```

It shouldn’t be too much of stretch to see that `return`

does this directly. If we think of `m a`

as an intermediate step on the way to building up `m b`

, `bind`

can be viewed as a way to use a function from a pure value to a value in a monadic context to make that step.

Throughout all of this, we are working with a single `Monad`

. We will often want to write code that deals with more than one monad at the same time.

That is where monad transformers come into play. They “stack” monads on top of each other, via the `lift`

function from the `MonadTrans`

typeclass.

```
class MonadTrans t where
lift :: m a -> t m a
```

Every monad transformer is also a monad, so we’re again build up a value in a monadic context. Now we can use monadic values from lower in the “stack” to do so, by “lifting” them to the context of the monad transformer.

This will probably make more sense after some examples.

`State`

and `StateT`

The `State`

monad abstracts functions that transform a state value of a given type. It is a `newtype`

wrapper around a particular form of a state transformation function:

`newtype State s a = State { runState :: s -> (a, s) }`

The `newtype`

is used so that we can provide a `Monad`

instance. At least for me, it also helps me keep my types lining up nicely and prevents various late-night-coding-induced misbehaviours.

We use return and bind to build up more involved state transformation functions, and we can use `get`

/ `put`

/ `modify`

to query and manipulate the state in these functions:

```
get :: State s s
put :: s -> State s ()
modify :: (s -> s) -> State s ()
```

These functions are captured in the `MonadState s`

typeclass, which has instances available in all of the places that you’d expect.

Once we’ve built up the state transformation function that we want, we can use `runState`

/ `evalState`

/ `execState`

as our interpreters, which run the state transformation function and provide either the return value, the final state, or both. Note that `evalState`

and `execState`

can both be defined in terms of `runState`

.

```
evalState :: State s a -> s -> a
execState :: State s a -> s -> s
```

Where `State`

works for pure computations, `StateT`

does the same for monadic computations for a particular monad `m`

:

```
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
get :: StateT s m s
put :: s -> StateT s m ()
modify :: (s -> s) -> StateT s m ()
evalStateT :: StateT s m a -> s -> m a
execStateT :: StateT s m a -> s -> m s
```

We can write all of our code in terms of `StateT`

, as we can use the `Identity`

monad at the bottom of our stack to finish things off.

In fact, we can define `State`

in terms of `StateT`

and `Identity`

:

```
type State s = StateT s Identity
runState :: State s -> s -> (a, s)
runState sm = runIdentity . runStateT sm
```

We used `StateT`

stacked on top of our `Adder`

monad in the helper function for `findLimit`

in the last post:

```
-- in findLimit
...
r <- execStateT findLimit' 0
...
findLimit' :: StateT Int Adder ()
findLimit' = do
-- add 1 to the total
r <- lift $ add 1
-- check for overflow
when r $ do
-- if no overflow, add to our state counter ...
modify (+ 1)
-- and continue
findLimit'
```

This is a good example of using `lift`

to build up the values in a monad stack and using the various domain specific functions to help interpret them.

Inside of `findLimit`

, we can make use of `modify`

because `StateT`

is on top of the stack.

If we remember the type of `add`

:

`add :: Int -> Adder Bool`

we can see that it’s not going to work in the `StateT Int Adder`

stack that `findLimit'`

is expecting.

However, `lift . add`

has type

`lift . add :: MonadTrans t => Int -> t Adder Bool`

or in this case

`lift . add :: Int -> StateT Int Adder Bool`

and so everything works out.

While `findLimit'`

has type

`StateT Int Adder ()`

we can see that `execStateT findLimit' (0 :: Int)`

has type

`Adder Int`

and so `execStateT`

has allowed us to temporarily make use of an additional effect.

`Reader`

and `ReaderT`

The `Reader`

monad abstracts functions that operate with a value of a given type as a context or environment. In this case it is a `newtype`

wrapper around a simple function:

`newtype Reader r a = Reader { runReader :: r -> a }`

and we use `runReader`

to interpret a `Reader`

monad value once we’re done building it up.

The `MonadReader r`

typeclass captures the `Reader`

specific functions, although for this post we’ll only be making us of `ask`

:

`ask :: Reader r r `

which returns the environment value.

Just like with `State`

, we can make use of `Reader`

in a monad transformer stack with `ReaderT`

:

```
newtype ReaderT r m a = Reader { runReaderT :: r -> m a }
ask :: ReaderT r m r
```

and we can also define `Reader`

in terms of `ReaderT`

:

```
type Reader r = ReaderT r Identity
runReader :: Reader r a -> a
runReader = runIdentity . runReaderT
```

The ad-hoc interpreter is manually doing the work of a `State`

monad for the count and a `Reader`

monad for the limit.

Let us clean that up, using `Reader`

over `State`

:

```
type Base m = ReaderT Int (StateT Int m)
runBase :: Monad m => Int -> Int -> Base m r -> m r
runBase limit count =
flip evalStateT count .
flip runReaderT limit
```

We have a helper function, `interpret'`

, which builds up a value of `Base m r`

. We have written the code for `AdderT`

and the `add`

/`clear`

/`total`

helpers so that they’re generic in the underlying monads. This is where that genericity pays off - we have deferred mentioning the underlying monad right up until the point where we are interpreting our DSL, and so we can choose whatever monad we want.

```
interpret' :: Monad m => AdderT (Base m) r -> Base m r
interpret' a = do
mr <- runFreeT a
case mr of
Pure r -> return r
Free (Add x k) -> do
limit <- ask
count <- lift get
let count' = x + count
let test = count' <= limit
let next = if test then count' else count
lift . put $ next
interpret' (k test)
Free (Clear k) -> do
lift . put $ 0
interpret' k
Free (Total k) -> do
count <- lift get
interpret' (k count)
```

Since `ReaderT`

is at the top of the stack in `Base`

, we can use `ask`

directly.

We need to use `lift`

whenever we deal with the state. This transforms computations in the `StateT Int m`

monad into computations in the `ReaderT Int (StateT Int m)`

monad, which is what we are working in.

We can combine both of these to get our cleaned up interpreter:

```
interpret :: Monad m => Int -> Int -> AdderT (Base m) r -> m r
interpret limit count =
runBase limit count .
interpret'
```

At this point we’re no longer explicitly threading a read-only environment value and an updatable state value through our computation and instead we access that functionality through a well-defined interface. Things are nicer, at least in the realm of the ad-hoc version of the interpreter.

`transformers`

style and `mtl`

styleThere are different schools of thought on whether to use `transformers`

style monad transformers - in which you have concrete types and you use explicit lifts - or `mtl`

style monad transformers - in which you use typeclass constraints and don’t have to lift anything.

I lean slightly towards working with `mtl`

style transformers, since I like the ease with which I can use it for prototyping and putting together pieces that I might reuse - even if the reuse is just between now and the next refactoring. Anyhow.

With `transformers`

your code is explicit, and you can have multiple transformers of the same type in your stack.

With `mtl`

you can’t have multiple transformers of the same type, but you can easily write code that is decoupled from the concrete stack you end up using.

This only involves a change to `interpret'`

:

```
type Base m = ReaderT Int (StateT Int m)
runBase :: Monad m => Int -> Int -> Base m r -> m r
runBase limit count =
flip evalStateT count .
flip runReaderT limit
interpret' :: (MonadReader Int m, MonadState Int m) => AdderT m r -> m r
interpret' a = do
mr <- runFreeT a
case mr of
Pure r -> return r
Free (Add x k) -> do
limit <- ask
count <- get
let count' = x + count
let test = count' <= limit
let next = if test then count' else count
put next
interpret' (k test)
Free (Clear k) -> do
put 0
interpret' k
Free (Total k) -> do
count <- get
interpret' (k count)
interpret :: (Monad m) => Int -> Int -> AdderT (Base m) r -> m r
interpret limit count =
runBase limit count .
interpret'
```

We are using typeclass constraints to assert that the required functionality is in the monad transformer stack. We then use the functionality - `ask`

, `get`

, and `put`

- directly, as it is all available from the typeclasses we mentioned in our typeclass constraints.

This means we can change the order of the transformers in the stack without having to change `interpret'`

```
interpret1 :: Monad m => Int -> Int -> AdderT (ReaderT Int (StateT Int m)) r -> m r
interpret1 limit count =
flip runStateT count .
flip runReaderT limit .
interpret'
interpret2 :: Monad m => Int -> Int -> AdderT (StateT Int (ReaderT Int m)) r -> m r
interpret2 limit count =
flip runReaderT limit .
flip runStateT count .
interpret'
```

It also means we can factor out bits of the functionality, and limit the constraints to just what is required for what we’re working on:

```
clearCount :: MonadState Int m -> m ()
clearCount = put 0
```

Limiting the scope can mean that we can reuse the functionality in more places, and that our code can’t make sneaky use of the other transformers in the stack.

It is worth noting that we can get these benefits from `transformers`

style code if we want to, just like we can have multiple components to our `Reader`

and `State`

monads in `mtl`

style. There is much more to say about the two styles, and about the tools and techniques that make working with monad transformers more pleasant - including the `mmorph`

library and several different parts of `lens`

. Going into further details on these is probably a post for another day.

In contrast to monads, comonads are about converting values in a comonadic context to pure values. I tend to think of this is “tearing down” a value in a comonadic context where monads are “building up” a value in a monadic context, however that’s perhaps not the best metaphor.

```
class Comonad w where
extract :: w a -> a
extend :: (w a -> b) -> w a -> w b
```

Recall that `extract`

is the dual to `return`

and `extend`

is the dual to `bind`

. Given that, we probably won’t find it too hard to view `extract`

as something that converts from values in a comonad context to pure values directly, while `extend`

helps us to do something similar in stages.

That pattern continues with `lower`

from `ComonadTrans`

:

```
class ComonadTrans t where
lower :: t w a -> w a
```

Every comonad transformer is also a comonad, and we can see that `lower`

is helping us step down the stack to get closer to a pure value.

Let’s look at a few of these things so we can get a bit more concrete.

`Store`

and `StoreT`

The `Store`

comonad is related to the `State`

monad, but does things a bit differently.

We store a function and an initial value:

`data Store s a = Store (s -> a) s`

As an aside, if we squint at (and uncurry) `State`

and `Store`

we might see them as combinations of `(-> s)`

and `(, s)`

but in different orders. There are volumes more to say about that, involving the relationship between adjunctions, monads, and comonads. If you’re interested to know more, you should ask in the reddit comments - there are folks in that community that are incredibly well versed in explaining those links and the various interesting avenues that branch off from there.

We can use `fmap`

to modify the function via composition:

```
instance Functor (Store s) where
fmap f (Store g s) = Store (f . g) s
```

The `extract`

function applies the stored function to the stored value, and `duplicate`

turns the `a`

into a `Store s a`

:

```
instance Comonad (Store s) where
extract (Store f s) = f s
duplicate (Store f s) = Store (Store f) s
```

We have a number of helper functions - also accessible from the `ComonadStore s`

typeclass - including:

```
pos :: Store s a -> s
seek :: s -> Store s a -> Store s a
peek :: s -> Store s a -> a
```

where

`pos`

gets the stored value`seek`

sets the stored value, and`peek`

applies the stored function to a new value

We’ll be making use of `pos`

and `seek`

to maintain state in our interpreter.

In the `State`

monad, `get`

and `put`

were able to return their values in the `State`

monad, since we were building up a value in a monadic context. In the `Store`

comonad, we’re tearing things down and so `pos`

and `seek`

look and behave like regular getter and setter functions - because that’s exactly what they are.

There is a `runStore`

function:

`runStore :: Store s a -> ((s -> a), s)`

but it’s not as exciting as `runState`

.

In the `State`

monad, we were busily building up a state transformation function, and `runState`

was the interpreter that tore it down into a pure value.

In the `Store`

comonad, we are doing the tearing down with the comonad, but we need something to tear down in the first place. For that reason, where we were interested in the accessor functions inside the `newtype`

wrappers for the monads, we are are more interested in the constructors for the `comonads`

- since the constructors give our context a starting point.

This is also handy because we are making use of these comonad transformers in an interpreter, and that interpreter is meant to run forever. We could use `runStore`

after that, for a sense of completeness, but I’ll omit it here.

As we might expect, there is a `StoreT`

comonad transformer which corresponds with `Store`

:

```
data StoreT s w a = StoreT (w (s -> a)) a
pos :: StoreT s w a -> s
seek :: s -> StoreT s w a -> StoreT s w a
peek :: Comonad w => s -> StoreT s w a -> a
```

and we can use the `Identity`

comonad to define the `Store`

in terms of `StoreT`

.

`Env`

and `EnvT`

The last piece we’ll need is the `Env`

comonad:

`data Env e a = Env e a`

which is similar to the `Reader`

monad in its functionality.

Where `Reader`

was a function from `e`

to `a`

, `Env`

is the pair of the two values.

We have a helper function, also available in `ComonadEnv e`

:

`ask :: Env e a -> e`

that returns the environment value, and the expected transformer version:

```
data EnvT e w a = EnvT e (w a)
ask :: EnvT e w a -> e
```

With all of that in hand, let us clean up the cofree-based interpreter.

We’re adding in a transformer stack, so we’ll switch from `Cofree`

`data Cofree f a = a :< f (Cofree f a)`

to `CofreeT`

```
data CofreeF f a b = a :< f b
data CofreeT f w a = CoFreeT { runCofreeT :: w (CofreeF f a (CofreeT f w a)) }
```

We’re making use of `count`

as a kind of state, and `limit`

as a kind of environment:

`type Base a = StoreT Int (EnvT Int Identity) a`

In the case of our interpreter, we have:

`type CoAdderT w a = CofreeT CoAdderF w a`

and then we combine the two to get:

`type CoAdder a = CoAdderT Base a`

Now we just need to switch to the comonad transformer version of `coiter`

- called `coiterT`

:

`coiterT :: (Functor f, Comonad w) => (w a -> f (w a)) -> w a -> CofreeT f w a`

and update the value of `start`

.

```
mkCoAdder :: Int -> Int -> CoAdder ()
mkCoAdder limit count = coiterT next start
where
next = CoAdderF <$> coAdd <*> coClear <*> coTotal
start = flip StoreT count . EnvT limit . Identity $ const ()
```

Now `coAdd`

, `coClear`

and `coTotal`

will change from having an argument of `(Int, Int)`

to having an argument of `Base ()`

. We’ll be a little more general and use `Base a`

to keep the code as general as we can.

We have `StoreT`

at the top of our comonad transformer stack, and `coClear`

and `coTotal`

only make use of the `StoreT`

part of the stack. This means we can use the `seek`

and `pos`

functions directly:

```
coClear :: Base a -> Base a
coClear = seek 0
coTotal :: Base a -> (Int, Base a)
coTotal w = (pos w, w)
```

As `coAdd`

makes use of `EnvT`

, we need to use `lower`

to get access to the `EnvT`

:

```
coAdd :: Base a -> Int -> (Bool, Base a)
coAdd w x = (test, seek next w)
where
count = pos w
limit = ask . lower $ w
count' = count + x
test = count' <= limit
next = if test then count' else count
```

Party on, Wayne.

Things get a little trickier if we change the order of the transformer stack.

It is straight-forward to update the definition of `Base`

and change the way we construct `start`

:

```
type Base a = EnvT Int (StoreT Int Identity) a
type CoAdderT w a = CofreeT CoAdderF w a
type CoAdder a = CoAdderT Base a
mkCoAdder :: Int -> Int -> CoAdder ()
mkCoAdder limit count =
coiterT next start
where
next = CoAdderF <$> coAdd <*> coClear <*> coTotal
start = EnvT limit . flip StoreT count . Identity $ const ()
```

We need some fancy footwork to update the value in the `StoreT`

, since `seek s`

is defined as `peek s . duplicate`

:

```
coClear :: Base a -> Base a
coClear = peek 0 . lower . duplicate
```

That might not look all that fancy, but it was one the trickiest things I had to work out to put this post together.

Getting access to `pos`

requires that we `lower`

into the `StoreT`

first:

```
coTotal :: Base a -> (Int, Base a)
coTotal w = ((pos . lower $ w), w)
```

and we can use `ask`

directly since `EnvT`

is on the top of our stack:

```
coAdd :: Base a -> Int -> (Bool, Base a)
coAdd w x = (test, peek next . lower . duplicate $ w)
where
count = pos . lower $ w
limit = ask w
count' = count + x
test = count' <= limit
next = if test then count' else count
```

Party on, Garth.

`transformers`

style to `mtl`

styleWhat we have so far demonstrates the use `transformers`

style comonad transformers. It’s worth showing off the differences between that and `mtl`

style comonad transformers.

We’ll revert to `StoreT`

over `EnvT`

for this.

With `StoreT`

at the top of the stack, the cases for `coClear`

and `coTotal`

don’t change except for the type signatures:

```
coClear :: ComonadStore Int w => w a -> w a
coClear = seek 0
coTotal :: ComonadStore Int w => w a -> (Int, w a)
coTotal w = (pos w, w)
```

For `coAdd`

we make a similar change to the type signature. We also drop the explicit `lower`

, since the `ComonadEnv`

constraint makes `ask`

available to us no matter where it is in the stack:

```
coAdd :: (ComonadEnv Int w, ComonadStore Int w) => w a -> Int -> (Bool, w a)
coAdd w x = (test, seek next w)
where
count = pos w
limit = ask w
count' = count + x
test = count' <= limit
next = if test then count' else count
```

The code for `mkCoadder`

doesn’t change at all. More importantly, the `coClear`

, `coTotal`

and `coAdd`

methods don’t change even if we change the order of the transformer stack.

Both

```
type Base a = StoreT Int (EnvT Int Identity) a
type CoAdderT w a = CofreeT CoAdderF w a
type CoAdder a = CoAdderT Base a
mkCoAdder :: Int -> Int -> CoAdder ()
mkCoAdder limit count =
coiterT next start
where
next = CoAdderF <$> coAdd <*> coClear <*> coTotal
start = flip StoreT count . EnvT limit . Identity $ const ()
```

and

```
type Base a = EnvT Int (StoreT Int Identity) a
type CoAdderT w a = CofreeT CoAdderF w a
type CoAdder a = CoAdderT Base a
mkCoAdder :: Int -> Int -> CoAdder ()
mkCoAdder limit count =
coiterT next start
where
next = CoAdderF <$> coAdd <*> coClear <*> coTotal
start = EnvT limit . flip StoreT count . Identity $ const ()
```

will work without adjustments.

So far we’ve been using the `Pairing`

between `Cofree`

and `Free`

:

```
instance Pairing f g => Pairing (Cofree f) (Free g) where
pair p (a :< _ ) (Pure x) = p a x
pair p (_ :< fs) (Free gs) = pair (pair p) fs gs
```

but now we’re going to need something which can handle the transformer stacks.

We make use of the pure value at the root of our cofree tree with `extract`

:

`extract :: CofreeT f w a -> a`

and thanks to the `ComonadCofree`

typeclass we can also access the rest of the tree with `unwrap`

:

`unwrap :: Comonad w => CofreeT f w a -> f (w a)`

These are used in `pairEffect`

:

```
pairEffect :: (Pairing f g, Comonad w, Monad m)
=> (a -> b -> r) -> CofreeT f w a -> FreeT g m b -> m r
pairEffect p s c = do
mb <- runFreeT c
case mb of
Pure x -> return $ p (extract s) x
Free gs -> pair (pairEffect p) (unwrap s) gs
```

which interleaves handling effects and pairing DSL commands with interpreter handlers.

This is handy for the cases where we will continually be producing DSL commands, and so will never get to the `Pure`

case in the pairing. We need that if we try to write a console based `Adder`

:

```
consoleAdder' :: MonadIO m => AdderT m ()
consoleAdder' = do
l <- liftIO getLine
case words l of
["add", x] -> add (read x) >>= \b ->
output $ "add result: " ++ show b
["clear"] -> clear
["total"] -> total >>= \t ->
output $ "total result: " ++ show t
_ -> output prompt
where
output = liftIO . putStrLn
prompt = unlines [
"Commands:"
, " add [int]"
, " clear"
, " total"
]
consoleAdder :: MonadIO m => AdderT m ()
consoleAdder = forever consoleAdder'
```

We can use `pairEffect`

to couple this with our comonad transformer version of `mkCoAdder`

:

```
testConsole :: IO ()
testConsole = pairEffect (\_ r -> r) (mkCoAdder 10 0) consoleAdder
```

although we could just as easily have used a pure version of `mkCoAdder`

stacked on top of the `Identity`

comonad and `pairEffect`

would have continued to work.

We’ve now factored out the state and environment from the interpreter, but there are still aspects of both the DSL and the interpreter which are more strongly coupled than they need to be.

We’ll start to deal with this in the next post, where we’ll use coproducts to break out the orthogonal parts of the DSL and products to make a similar change to the interpreter. After that we’ll have a deeper look at making use of various effects in conjunction with free and cofree.

Site proudly generated by Hakyll

This work is licensed under a Creative Commons Attribution 4.0 International License