Monads: How do they work?

March 5, 2012

I volunteered to give a presentation on monads for the Practical Functional Programming course at the U of U. This post is a product of me preparing for that talk. It is a general overview of monads, as well as what types of problems they can solve. I'm not concerned about providing anything novel here, in fact most of the content found here is a rehash of other online resources (see Further Reading section).

For readers interested in gaining a solid understanding of monads, I highly recommend trudging through chapters 14, 15, and 18 of Real World Haskell.

Motivation for Monads

How do you code up doubly nested for-loops in a purely functional language? Is there an elegant way to pass around program state without explicitly threading it in and out of every function? How do you encode sequential actions, such as reading and writing files?

It turns out that all of these problems can be solved using the monad abstraction.

What is a Monad?

Monads are a general way to encode sequential actions. I like to think of them as containers that wrap values of a given type and expose a framework enabling action composition.

When we work with monads we want to be able to wrap values in containers (return), as well as compose together containers (bind or >>=).

In Haskell code, a monad is a typeclass. Typeclasses are a way of defining ad hoc polymorphism.

-- Monad Typeclass
class Monad m where
    -- Chain together containers
    (>>=) :: m a -> (a -> m b) -> m b

    -- Inject value into a container
    return :: a -> m a

    -- additional helper functions that aren't necessary:
    -- >> is like >>= but throws away the first result
    (>>) :: m a -> m b -> m b

    -- fail is a technical necessity used for pattern match failures
    -- in do notation
    fail :: String -> m a

If we want to make a type an instance of the Monad typeclass, we just have to define >>= and return for that type. Let's try it out with a data type you may have seen before.

Maybe Monad

Did you know that the Maybe datatype is a monad used for anonymous exception handling? Let's define it and its monadic operators here:

data Maybe a = Nothing
             | Just a

instance Monad Maybe where
    -- bind together operations
    Just x >>= k  =  k x
    Nothing >>= _ =  Nothing

    -- inject value
    return x      =  Just x

    -- then
    Just _ >> k   =  k
    Nothing >> _  =  Nothing

    fail _        =  Nothing

How does extending Maybe to be an instance of the Monad typeclass make our lives easier? Let's take a look at the animalColorLookup function, which doesn't utilize Maybe as a monad:

animalFriends :: [(String, String)]
animalFriends = [ ("Pony", "Lion")
                , ("Lion", "Manticore")
                , ("Unicorn", "Lepricon")
                ]

-- Explicitly chaining Maybes to find ponys friends friends friend
animalFriendLookup :: [(String, String)] -> Maybe String
animalFriendLookup animalMap =
  case lookup "Pony" animalMap of
       Nothing -> Nothing
       Just ponyFriend ->
         case lookup ponyFriend animalMap of
              Nothing -> Nothing
              Just ponyFriendFriend ->
                case lookup ponyFriendFriend animalMap of
                     Nothing -> Nothing
                     Just friend -> Just friend

The chaining of lookup statements wrapped in case gets out of hand quickly. To remedy this we can make use of the bind (>>=) operator defined by the Maybe monad along with some anonymous functions to writer a cleaner version:

-- Use Bind to chain lookups
monadicAnimalFriendLookup :: [(String, String)] -> Maybe String
monadicAnimalFriendLookup animalMap =
      lookup "Pony" animalMap
  >>= (\ponyFriend -> lookup ponyFriend animalMap
  >>= (\ponyFriendFriend -> lookup ponyFriendFriend animalMap
  >>= (\friend -> Just friend)))

Lastly, most Haskellers are used to seeing do blocks when dealing with monads. do blocks are syntactic sugar to make monadic code look cleaner, as well as giving it an imperative feel.

-- Use Do-Block sugar magic
sugaryAnimalFriendLookup :: [(String, String)] -> Maybe String
sugaryAnimalFriendLookup animalMap = do
  ponyFriend <- lookup "Pony" animalMap
  ponyFriendFriend <- lookup ponyFriend animalMap
  friend <- lookup ponyFriendFriend animalMap
  return friend

While do block syntax is nice, it sugar coats a lot details that monad beginners should be exposed to. Hence, I'm going to stick with the more explicit syntax for now, but later on I'll explain how do block code is desugared.

The Maybe monad offers some nice abstractions to clean up code, but let's explore some examples that really show off the power of monadic abstractions.

Threading State

Say you want to code up some sort of abstract syntax tree (AST) transformation program that traverses an AST, inserting unique symbols every once and a while.

To do this in a pure setting, one must pass a counter in and out of every function call that needs to create unique symbols:

-- for simplicity we'll use a string instead of an Abstract Data Type for ASTs
type Sexpr = String

-- Add unique symbol to Sexpr using naive threading of program state
transformStmt :: Sexpr -> Int -> (Sexpr, Int)
transformStmt expr counter = (newExpr, newCounter)
  where newExpr = "(define " ++ uniqVarName ++ " " ++ expr ++ ")"
        newCounter = counter + 1
        uniqVarName = "tmpVar" ++ (show counter)

This is fine, but there is potential for a lot of boilerplate. In addition, if we decide we also need to pass around an environment set, we'll have to manually change all of our function type signatures.

This problem is screaming to be abstracted, so let's see if monads help…

Like the Internet, Monads are a series of pipes

It turns out we can generalize the threading of state seen in transformStmt. Let's chop off Int -> (Sexpr, Int) from the transformStmt type signature and replace it with the State type constructor defined below. This leaves us with transformStmt :: Sexpr -> State Int Sexpr. They are of the exact same type but we've used the type constructor to abstract away the fact that we take in a state value and output a state value.

-- State type constructor with the runState record syntax
-- to extraction or 'run' the state
newtype State s a = State {
      runState :: s -> (a, s)
    }

Now that we have a type constructor we can start to think about making an instance of the Monad typeclass. With return we want to take a normal value and make it accept a piece of state and return that state along with the original value.

instance Monad (State s) where
  -- return :: a -> State s a
  return a = State $ \s -> (a, s)

  -- (>>=) :: State s a -> (a -> State s b) -> State s b
  m >>= k = State $ \s -> let (a, s') = runState m s
                          in runState (k a) s'

And to compose state carrying functions (using >>=), we want to take in a piece of state, evaluate the first function with that state, and store the resulting state and value. Then we pass those as parameters to the second function. This results in the program state getting threaded in and out of both functions.

Let's solidify this a bit by applying it to our AST transformer idea:

-- create a type for the state we want to pass around
type SexprState = State Int

-- let's wrap an Sexpr in the State monad
sexprWithState :: SexprState Sexpr
sexprWithState = return "(foo bar)"

-- Now let's run it with the initially state of 0
ghci> runState sexprWithState 0
("(foo bar)", 0)

-- wrap Sexpr in parenthesis
wrapSexpr :: Sexpr -> SexprState Sexpr
wrapSexpr exp = return $ "(" ++ exp ++ ")"

-- wrap Sexpr in qux
addQux :: Sexpr -> SexprState Sexpr
addQux exp = return $ "(qux " ++ exp ++ ")"

ghci> runState (sexprWithState
           >>= (\exp -> wrapSexpr exp
           >>= (\exp2 -> addQux exp2))) 0
("(qux ((foo bar)))",0)

So now we are doing all of our S-Expression manipulation while passing around state in the background. But wait, we aren't doing anything with the state!

Accessing and Modifying State

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

-- example of getting and modifying state
ghci> runState (sexprWithState
           >>= wrapSexpr
           >>= (\exp' -> get
           >>= (\counter -> (put (counter+1))
           >> (return exp')
           >>= addQux))) 0
("(qux ((foo bar)))",1)

transformStmt revisited

With our new found friend the State monad, we can rewrite the original transformStmt function in a monadic style. This enables us to abstract away all the explicit threading of state.

transformStmt' :: Sexpr -> SexprState Sexpr
transformStmt' expr =
  -- grab the current program state
  get
  -- increment the counter by 1 and store it
  >>= (\counter -> (put (counter+1))
  -- do the sexpr transformation
  >> (return $ "(define tmpVar" ++ (show counter) ++ " " ++ expr ++ ")"))

-- And again using do block sugar
transformStmtDo :: Sexpr -> SexprState Sexpr
transformStmtDo expr = do
  counter <- get
  put (counter+1)
  return $ "(define tmpVar" ++ (show counter) ++ " " ++ expr ++ ")"

List is a Monad

Haskell is known for making easy things really hard. In fact, I was never really able iterate over a doubly nested list until I realized that lists are monads in Haskell. Specifically, lists are used in a monadic style to model nondeterminism, most commonly in Haskell's crazy list comprehension sugar.

As before, let's try and define return and >>= for the [] type constructor. In the Monad typeclass, return takes type a and wraps it in a type constructor m to give the type m a. So in the case of list, a will be wrapped in the type constructor [], resulting in [] a, or more easily read as [a].

To formulate >>= for lists, let us look at the type signature and see if we can find something that matches.

ghci> :type (>>=)
(>>=) :: (Monad m) => m a -> (a -> m b) -> m b

ghci> :type map
map :: (a -> b) -> [a] -> [b]

ghci> :type flip map
flip map :: [a] -> (a -> b) -> [b]

flip map looks close, but we really want a type of [a] -> (a -> [b]) -> [b]. Hence we can substitute [b] for b, resulting in a type of [a] -> (a -> [b]) -> [[b]], which can then be massaged using concat :: [[a]] -> [a].

The resulting formulation is:

instance Monad [] where
    return x = [x]
    xs >>= f = concat (map f xs)

    xs >> f = concat (map (\_ -> f) xs)
    fail _ = []

What does this give us?

Well, list comprehension:

-- monadic powerset
ghci> powerset = [1,2]
             >>= (\i -> [1..4]
             >>= (\j -> [(i, j)]))
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4)]


-- or the same using do sugar
do i <- [1,2]
   j <- [1..4]
   return (i,j)

-- or as list comprehension
[(i, j) | i <- [1,2], j <- [1..4]]

For a more detailed explanation and formulation of the list monad, see Chapter 14 of Real World Haskell.

Desurgaring Do Blocks

Ahhh, the sugary sweetness of do blocks. To the novice Haskeller it makes monads look like magic. We've avoided them thus far, but once the desugaring of do blocks is demystified, using do syntax is much more convenient.

So how are do blocks desugared into monadic operators?

-- this do block notation
do x <- foo
   bar
-- desugars into:
foo >>= (\x -> bar)

-- successive actions
do act1
   act2
   ...
-- desugar into:
 act1 >>
 act2 >>
 ...

-- this do block notation
do let x = expr
       x1 ...
   act1
   act2
   ...
-- desugars into:
let x = expr
    x1 ...
in do act1
      act2
      ...

Parametric Guarantees

One thing to note is that only types of the kind * -> * (type constructors of arity 1) can be made instances of the Monad typeclass. This means that the values monads wrap are parametrically polymorphic, ensuring that monadic functions act uniformily on them. That is, >>= and return cannot directly manipulate the values they wrap because Haskell doesn't support type introspection. This doesn't mean that these functions cannot however manipulate other non-polymorphic values present in the type constructor. For instance this we can construct a monad that counts the number of times >>= is called:

data BindCounter a = BindCounter Int a

instance Monad BindCounter where
  -- inject
  return a = BindCounter 0 a
  -- bind
  (BindCounter x y) >>= k = BindCounter (x+1) y'
                              where BindCounter _ y' = (k y)

fooRun :: IO ()
fooRun = do
      -- inject "foo" into the BindCounter Monad
  let x = return "foo" :: BindCounter String
      -- do some monadic string appends
      BindCounter count val = x
        >>= (\y -> BindCounter 0 (y ++ " bar"))
        >>= (\y -> BindCounter 0 (y ++ " baz"))
        >>= (\y -> BindCounter 0 (y ++ " qux"))
  putStrLn $ "bind count: " ++ (show count) ++ ", resulting value: " ++ val

ghci> fooRun
bind count: 3, resulting value: foo bar baz qux

Monadic Laws

Monads should also follow 3 laws: right identity, left identity and associativity. Haskell doesn't enforce these laws, but if your monads don't follow them, people will probably get confused. In addition, these laws are required in order for a monad to form a mathematical category, which is where the name monad came from [ref].

-- Right Identity:
--   no need to wrap an already wrapped value
m >>= return === m

-- do-notation version:
do { x' <- return x            do { f x
     f x' }            ===        }

-- Left Identity:
--   no need to wrap and unwrap a pure value
return x >>= f === f x

-- do-notation version:
do { x <- m            ===     do { m
     return x }                   }

-- associativity:
--   preservation of ordering
(m >>= f) >>= g  ===  m >>= (\x -> f x >>= g)

-- do-notation version:
do { y <- do { x <- m          do { x <- m
               f x                  do { y <- f x
             }         ===               g y
     g y                               }
   }                              }

                               do { x <- m
                                    y <- f x
                       ===          g y
                                  }

We can also define these laws using the monad composition operator defined in Control.Monad [ref]:

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
m >=> n = \x -> do { y <- m x; n y }

-- Left identity
return >=> g === g

-- Right identity
f >=> return === f

-- Associativity
(f >=> g) >=> h === f >=> (g >=> h)

Resources

Further Reading