# Module 18: Monads

This module is due **Thursday, December 1 at 1:15pm**.

```
> {-# LANGUAGE DeriveFunctor #-}
> {-# LANGUAGE GADTs #-}
>
> import Control.Monad
> import Control.Monad.State
> import Control.Monad.Except
> import Control.Monad.Writer
```

Recall that we’ve seen the `(>>=)`

operator with the following type:

`(>>=) :: Either Error a -> (a -> Either Error b) -> Either Error b`

This is actually an instance of a more general pattern called a *monad*. A monad is a type `m`

which supports the following operations:

`return :: a -> m a`

`(>>=) :: m a -> (a -> m b) -> m b`

Intuitively, a value of type `m a`

represents a computation or program that computes a value of type `a`

, and might have some “effects” (depending on `m`

).

`return`

creates a computation that immediately results in the given value, with no effects. (In the case of`Either Error`

,`return = Right`

.)`(>>=)`

sequences two computations together into one bigger one, where the second computation can depend on the output of the first.

Let’s look at a simple example. The following `Possibly`

type is the same as the standard `Maybe`

, type, but redefined so you can practice making a `Monad`

instance for it (of course, `Maybe`

already has a `Monad`

instance defined in the standard library).

```
> data Possibly a where
> Nope :: Possibly a
> Definitely :: a -> Possibly a
> deriving (Show, Functor)
```

Note that every `Monad`

is also a `Functor`

(which generalizes the `<$>`

operator we saw for parsers), as well as an `Applicative`

(which generalizes the `<*>`

operator). (Because of time constraints, we won’t spend time talking about those but see here if you’re interested in learning more about them, or take CSCI 365, Functional Programming.) GHC can automatically generate a default instance of `Functor`

for us (see `deriving Functor`

above), and we can make an `Applicative`

instance for free once we have a `Monad`

instance: we just define `pure = return`

and `(<*>) = ap`

(`ap`

is a function from the standard library which is defined in terms of `return`

and `(>>=)`

).

```
> instance Applicative Possibly where
> pure = return
> (<*>) = ap
```

- Your turn: fill in a defintion for the
`Monad Possibly`

instance below!

`> instance Monad Possibly where`

Let’s look at a simple example. First, `checkEven`

returns `Just n`

when its argument `n`

is even, and `Nothing`

otherwise. That is, it is a sort of “filter” that only “lets through” even numbers.

```
> checkEven :: Int -> Maybe Int
> checkEven n
> | even n = Just n
> | otherwise = Nothing
```

`addEvens`

takes two `Int`

values as input and adds them if both are even (and fails otherwise). Here’s a straightforward first version:

```
> addEvens :: Int -> Int -> Maybe Int
> addEvens m n =
> checkEven m >>= (\me -> checkEven n >>= (\ne -> return (me + ne)))
```

We actually don’t need the parentheses, since anonymous functions extend as far to the right as possible:

```
> addEvens2 :: Int -> Int -> Maybe Int
> addEvens2 m n =
> checkEven m >>= \me -> checkEven n >>= \ne -> return (me + ne)
```

It’s annoying to have everything on the same line; it’s hard to read, and quickly gets unwieldy with larger compositions of actions. So we can introduce some newlines to make things more readable, like this:

```
> addEvens3 :: Int -> Int -> Maybe Int
> addEvens3 m n =
> checkEven m >>= \me ->
> checkEven n >>= \ne ->
> return (me + ne)
```

This style became so common that it was decided to add some special syntax sugar, called *do-notation*, to Haskell. We can rewrite `addEvens`

like so:

```
> addEvens4 :: Int -> Int -> Maybe Int
> addEvens4 m n = do
> me <- checkEven m
> ne <- checkEven n
> return (me + ne)
```

`addEvens4`

desugars to exactly the same thing as `addEvens3`

.

## Another monad: State

Let’s look at another example of a `Monad`

, one we haven’t seen before. The type `State s`

is a `Monad`

which represents the use of a *mutable* state of type `s`

. That is, a value of type `State s a`

is a computation that results in an `a`

and has access to a mutable state of type `s`

.

In addition to `return :: a -> State s a`

and `(>>=) :: State s a -> (a -> State s b) -> State s b`

, the `State`

monad supports two additional operations:

`get :: State s s`

returns the current state as its output.`put :: s -> State s ()`

sets the state to a new value. It returns`()`

(“unit”), which is an uninformative type with only a single value (also called`()`

). Essentially a return type of`()`

means it “does not return anything”,*i.e.*it is the same as a`void`

method in C or Java.

Let’s try some examples.

- Write a function called
`tick`

which adds one to the current integer state and returns the old state. For example, if the state is 6,`tick`

will update the state to 7 and then return 6.

```
> tick :: State Int Int
> tick = undefined
```

To test your implementation of `tick`

and other exercises below, you can use the function

`runState :: State s a -> s -> (a,s)`

which takes a `State`

computation to run and an initial state value, and yields the return value and final state value. For example,

```
ghci> runState tick 4
(4,5)
```

This runs the `tick`

computation with an initial state of `4`

, which results in the return value 4 and an updated state of 5. (You may also be interested in `evalState`

and `execState`

; ask GHCi for their types to see what they do.)

- Now write a function
`tick3 :: State Int Int`

which increments the state by 3 and returns the original state. For example, running`tick3`

with an initial state of`4`

will return`4`

and update the state to`7`

. Do not use the number 3 or the`+`

operator in your solution; just call`tick`

three times.

```
> tick3 :: State Int Int
> tick3 = undefined
```

`State`

also supports an operation called`modify`

, which applies a given function to the mutable state. Show how to implement`modify`

in terms of`get`

and`put`

:

```
> modify2 :: (s -> s) -> State s ()
> modify2 = undefined
```

Essentially, we can think of `State`

as a mini-EDSL for expressing programs that manipulate a single mutable variable.

## A tiny stack EDSL

**ROTATE ROLES**and write the name of the new driver here:

Let’s use the `State`

monad to build a tiny embedded DSL for operating on a mutable stack of integers.

- Complete the definition of the
`StackProgI`

EDSL below.

```
> -- A 'StackProgI a' is a program which returns an 'a' and has access
> -- to a mutable stack of Ints.
> type StackProgI a = State [Int] a
>
> -- Get the size of the stack.
> sizeI :: StackProgI Int
> sizeI = undefined
>
> -- Push an Int onto the stack.
> pushI :: Int -> StackProgI ()
> pushI = undefined
>
> -- Pop the top Int from the stack and return it. (For now, fail by
> -- calling 'error' the stack is empty.)
> popI :: StackProgI Int
> popI = undefined
>
> -- Look at the top Int on the stack without popping it. (Fail with 'error'
> -- if the stack is empty.)
> peekI :: StackProgI Int
> peekI = undefined
>
> -- Run a 'StackProgI a' starting with the empty stack, returning the
> -- produced value of type 'a' along with the final stack state.
> runStackProgI :: StackProgI a -> (a, [Int])
> runStackProgI = undefined
```

Now let’s write a few programs using this new EDSL.

- Write
`opI`

, which pops the top two values from the stack, performs a given binary operation on them, and pushes the result back on the stack. (Hint: use`popI`

and`pushI`

instead of manipulating the stack directly!)

```
> opI :: (Int -> Int -> Int) -> StackProgI ()
> opI = undefined
```

- Write
`pushListI`

, which pushes all the elements in a list onto the stack. (Hint: it is possible to implement`pushListI`

with one line of code.)

```
> pushListI :: [Int] -> StackProgI ()
> pushListI = undefined
```

- Write
`crushI`

, which repeatedly performs an operation on the top two items on the stack until there is only one item left. (Hint: don’t manipulate the stack directly; use`sizeI`

,`opI`

, and recursion to get the job done. You may also find the`when`

function useful.)

```
> crushI :: (Int -> Int -> Int) -> StackProgI ()
> crushI = undefined
```

Be sure to test your programs using `runStackProgI`

. You will find `pushListI`

helpful for testing `opI`

and `crushI`

.

## Error handling and monad transformers

**ROTATE ROLES**and write the name of the new driver here:

It’s unsatisfactory having our stack language crash with `error`

on a stack underflow. In this section we’ll explore a more principled approach to error handling via *monad transformers*, which allow us to combine the effects of several monads into one.

Here’s a type for runtime errors that can arise from stack programs (for now there’s only `Underflow`

):

```
> data StackError where
> Underflow :: StackError
> deriving Show
```

And now for the definition of `StackProgE`

, which adds the possibility of errors. While we’re at it, let’s generalize from stacks of `Int`

s to stacks of any type, represented by the type variable `el`

:

`> type StackProgE el a = ExceptT StackError (State [el]) a`

`ExceptT`

is a *monad transformer* which adds the possibility of `StackErrors`

on top of the existing monad `State [el]`

.

Reimplement the stack EDSL by implementing

`sizeE`

,`pushE`

,`popE`

, and`peekE`

. They should work like the corresponding methods for`StackProgI`

, but modified to throw`StackError`

s as appropriate instead of calling`error`

.Here’s what you need to know:

`StackProgE`

is still a`Monad`

, of course.`StackProgE`

still has a`State`

component, so you can use`put`

,`get`

, and`modify`

as before.You can use

`throwError :: StackError -> StackProgE el a`

to signal an error. Essentially, use`throwError`

anywhere you would have used`Left`

, as if we were still working in terms of a type like`Either StackError`

.

```
> sizeE :: StackProgE el Int
> sizeE = undefined
>
> pushE :: el -> StackProgE el ()
> pushE = undefined
>
> popE :: StackProgE el el
> popE = undefined
>
> peekE :: StackProgE el el
> peekE = undefined
```

- Now implement
`runStackProgE`

below. Follow the types! You will find the`runExceptT`

function helpful.

```
> runStackProgE :: StackProgE el a -> (Either StackError a, [el])
> runStackProgE = undefined
```

Test the operations that can throw an error to make sure they work properly. For example, what happens when you call

`runStackProgE popE`

?Finally, reimplement operations analogous to

`opI`

,`pushListI`

, and`crushI`

. Ideally, if you implemented them elegantly in the first place, their implementations will not need to change other than updating`popI`

to`popE`

and so on:

```
> opE :: (el -> el -> el) -> StackProgE el ()
> opE = undefined
>
> pushListE :: [el] -> StackProgE el ()
> pushListE = undefined
>
> crushE :: (el -> el -> el) -> StackProgE el ()
> crushE = undefined
```

## A deep stack EDSL

**ROTATE ROLES**and write the name of the new driver here:

It was annoying that we had to reimplement everything when we switched from `StackProgI`

to `StackProgE`

. The solution is to use a deep embedding, which we can then interpret via multiple semantics. The cool thing is that we can make a `Monad`

instance for our deep embedding, and continue to write exactly the same programs as before, using `do`

-notation and so on. The difference is that our programs will now construct ASTs, which we can separately optimize, interpret, and so on.

Here is the AST for our deep embedding:

```
> data StackProgAST el a where
>
> -- A simple return value.
> Return :: a -> StackProgAST el a
>
> -- Push a value on the stack. This instruction stores the value
> -- to push, and the rest of the program (i.e. it's a node with a
> -- single child node).
> Push :: el -> StackProgAST el a -> StackProgAST el a
>
> -- Pop a value from the stack. Stores a function which, when
> -- given the element that is popped, determines the rest of the
> -- program. Another way to think of it is that a Pop node is like
> -- an infinitely-branching tree node: there is one child AST node
> -- for every possible element that could be popped.
> Pop :: (el -> StackProgAST el a) -> StackProgAST el a
>
> -- Peek at the value on the top of the stack.
> Peek :: (el -> StackProgAST el a) -> StackProgAST el a
>
> -- Get the size of the stack.
> Size :: (Int -> StackProgAST el a) -> StackProgAST el a
>
> deriving Functor
>
> -- We get an Applicative instance for free from the Monad instance.
> instance Applicative (StackProgAST el) where
> pure = return
> (<*>) = ap
```

Write a

`Monad`

instance for`StackProgAST el`

below. You can do it just by following the types, but here is the intuitive way to think about it: given an AST`t :: StackProgAST el a`

, which is like a big (infinitely-branching) tree with values of type`a`

at all the leaves (wrapped in`Return`

), and a function`a -> StackProgAST el b`

which says how to continue from any value of type`a`

, the bind operator`t >>= f`

calls`f`

on every leaf value and splices in the resulting trees.This instance is definitely tricky to think about, although the code does not end up being that long in the end. If you are stuck, try carefully writing out all the types involved. Treat it like a jigsaw puzzle, figuring out how to put all the different pieces together so the types fit properly.

`> instance Monad (StackProgAST el) where`

- Now write
`size`

,`push`

,`pop`

, and`peek`

below, which each build a single AST node immediately followed by a`Return`

node.

```
> size :: StackProgAST el Int
> size = undefined
>
> push :: el -> StackProgAST el ()
> push = undefined
>
> pop :: StackProgAST el el
> pop = undefined
>
> peek :: StackProgAST el el
> peek = undefined
```

- Now reimplement
`op`

,`pushList`

, and`crush`

. The implementations of`op`

and`crush`

should still be very similar to your previous implementations of these operations, even though they are now doing something very different (namely, splicing together ASTs instead of actually operating on stacks).

The implementation of `pushList`

, however, might have to change a bit. Previously, since you were implementing `pushList`

directly in terms of a state-based semantics with a stack, you could implement `pushList`

simply by modifying the state. Now, however, `pushList`

has to build an AST, and we don’t know in advance how the AST will be interpreted: the ultimate semantics might not even involve a mutable state at all! So instead, you will have to implement `pushList`

by turning it into a series of calls to `push`

(which will in turn build an AST containing a bunch of `Push`

nodes).

```
> op :: (el -> el -> el) -> StackProgAST el ()
> op = undefined
>
> pushList :: [el] -> StackProgAST el ()
> pushList = undefined
>
> crush :: (el -> el -> el) -> StackProgAST el ()
> crush = undefined
```

- Now write
`interpStackProgE`

, which interprets an AST as a`StackProgE`

program.

```
> interpStackProgE :: StackProgAST el a -> StackProgE el a
> interpStackProgE = undefined
```

- Finally, write
`runAsStackProgE`

, which combines`interpStackProgE`

with`runStackProgE`

to directly run an AST. Test it by running programs such as`pushList [3,2,6,4] >> crush (*)`

.

```
> runAsStackProgE :: StackProgAST el a -> (Either StackError a, [el])
> runAsStackProgE = undefined
```

## An alternative semantics

**ROTATE ROLES**and write the name of the new driver here:

Now that we have a deep EDSL, we can use different semantics to interpret it without having to rewrite all our existing programs.

Consider the following definition of `StackProgW`

, which adds `WriterT [String]`

as compared to `StackProgE`

. `WriterT [String]`

adds a write-only log of type `[String]`

, which we can use to generate a sequence of log messages.

`> type StackProgW el a = ExceptT StackError (WriterT [String] (State [el])) a`

You can use the function `tell :: [String] -> StackProgW el ()`

to add some logging messages. In particular, each pop or push operation should log a message like `"Popped 3"`

or `"Pushed 6"`

.

- Implement
`interpStackProgW`

, which interprets a`StackProgAST`

as a`StackProgW`

computation. (Hint: you will probably want to implement`sizeW`

,`pushW`

,`popW`

, and`peekW`

functions which implement the operations specifically for`StackProgW`

, with appropriate logging operations added. You will probably need to add`Show el`

constraints,*e.g.*`popW :: Show el => StackProgW el el`

.)

```
> interpStackProgW :: Show el => StackProgAST el a -> StackProgW el a
> interpStackProgW = undefined
```

Finally, implement

`runAsStackProgW`

. Test it. For example, here is what my implementation does:`>>> runAsStackProgW (pushList [1,2,3] >> crush (*)) ((Right (),["Pushed 1","Pushed 2","Pushed 3","Popped 3","Popped 2","Pushed 6","Popped 6","Popped 1","Pushed 6"]),[6])`

```
> runAsStackProgW :: Show el => StackProgAST el a -> ((Either StackError a, [String]), [el])
> runAsStackProgW = undefined
```