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:

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).

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
> 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:

Let’s try some examples.

> 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

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.)

> tick3 :: State Int Int
> tick3 = undefined
> 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

Let’s use the State monad to build a tiny embedded DSL for operating on a mutable stack of integers.

> -- 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.

> opI :: (Int -> Int -> Int) -> StackProgI ()
> opI = undefined
> pushListI :: [Int] -> StackProgI ()
> pushListI = undefined
> 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

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 Ints 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].

> sizeE :: StackProgE el Int
> sizeE = undefined
> pushE :: el -> StackProgE el ()
> pushE = undefined
> popE :: StackProgE el el
> popE = undefined
> peekE :: StackProgE el el
> peekE = undefined
> runStackProgE :: StackProgE el a -> (Either StackError a, [el])
> runStackProgE = undefined
> 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

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
> instance Monad (StackProgAST el) where
> size :: StackProgAST el Int
> size = undefined
> push :: el -> StackProgAST el ()
> push = undefined
> pop :: StackProgAST el el
> pop = undefined
> peek :: StackProgAST el el
> peek = undefined

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
> interpStackProgE :: StackProgAST el a -> StackProgE el a
> interpStackProgE = undefined
> runAsStackProgE :: StackProgAST el a -> (Either StackError a, [el])
> runAsStackProgE = undefined

An alternative semantics

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".

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