Introduction

Some very brief notes summarizing Haskell’s listlike monads. It’s my crib sheet, written partly to straighten matters in my own mind and partly for future reference.

Most of the information here comes from the usual places, notably the Typeclassopedia.1 I’m also indebted to Dominic Prior for many helpful discussions. Dominic is collecting useful and interesting monad examples2 on Google Docs.

The list monad

If you use GHC, the list instance is defined in GHC-Base3 these days:

instance  Monad []  where
    x >>= f             = foldr ((++) . f) [] x		
    x >> f              = foldr ((++) . (\ _ -> f)) [] x
    return x            = [x]				
    fail _              = []				

Perhaps the following equivalent definitions of bind (>>=) are clearer though. I’ve always found list comprehensions intuitive, and I think that’s my favourite:

x >>= f = [ z | y <- x, z <- f y ]

x >>= f = concat (map f x)

(x:xs) >>= f = (f x) ++ (xs >>= f)
[]     >>= f = []

It’s probably also good to compare the general monadic and specific list instance types:

(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>>=) ::            [a] -> (a -> [b]) -> [b]

With these it’s easy to see how bind unwraps the monad (here by treating the incoming list one element at a time), applies f, then joins the resulting lists together.

join

Speaking of join, recall,

join x = x >>= id

and thus,

join x = [ z | y <- x, z <- y ]

join   = concat

>=>

Given the general result that

(f >=> g) x = f x >>= g

It’s easy to derive the pleasingly symmetric result that,

(f >=> g) x = [ z | y <- f x, z <- g y ]

Monad laws

We should check that these definitions comply with the monad laws. Let’s use the Kleisli set for elegance:

return >=> f    = f
f >=> return    = f
(f >=> g) >=> h = f >=> (g >=> h)

We’ll begin with the left-identity, recalling return x = [x]:

(return >=> f) x = [ z | y <- [x], z <- f y ]
                 = [ z |           z <- f x ]
                 = f x

The right identity is essentially the same, so we’ll look at the associativity law:

((f >=> g) >=> h) x
    = [ z | y <- (f >=> g) x, z <- h y ]
    = [ z | y <- [ w | v <- f x, w <- g v ], z <- h y ]
    = [ z | v <- f x, w <- g v, z <- h w ]
    = [ z | v <- f x, z <- [ t | w <- g v, t <- h w ] ]
    = [ z | v <- f x, z <- (g >=> h) v ]
    = (f >=> (g >=> h)) x

The key observation is that the middle expression is symmetric.

Intuition

We’ll look at two ways to think about the list monad: the first is simpler, but corresponds to a special case; the second is more abstract but more faithful.

The Cartesian Product

A helpful intuition for the list monad is the Cartesian product.4 To see this, think how bind operates:

Here’s an example:

p as bs = do
            a <- as
            b <- bs
            return (a,b)

p [1,2] "ab" = [(1,'a'),(1,'b'),(2,'a'),(2,'b')]

one could define p more succinctly:

p = liftM2 (,)

Actually, for the Cartesian product, we don’t need the full power of monads: applicatives are enough. We could also define p thus:

p as bs = (,) <$> as <*> bs

sequence

If we are happy to work with lists (which implies that all the values have the same type), sequence does just what we want:

> sequence [[1,2],[3,4]]
[[1,3],[1,4],[2,3],[2,4]]

Nondeterministic calculations

Suppose we’re exploring a space: at each step there are several possible directions we could take: storing those as a list seem natural enough. The key insight is that the monad instance chains these steps together naturally.

For example, suppose we’re exploring a set of cells { 1,2,3,...,maxCell } a step at a time, and at each step can either stay still, or move to a neighbour. We could model it thus:

import Control.Monad							
import qualified Data.List as L						
									
type Cell = Int								
									
maxCell = 3								
									
inBounds :: Cell -> Bool						
inBounds x = x >= 1 && x <= maxCell			         	
									
explore :: Cell -> [Cell]						
explore x = filter inBounds [x-1..x+1]

What’s going on here ?

Suppose we always start in cell 1, which we’d represent by the singleton list [1].

Where can we move ? Let’s ask explore:

*Main> [1] >>= explore
[1,2]

That makes sense: we can’t move down (because there’s no cell 0), so we must either stay in cell 1, or move up to cell 2. What about another step ?

[1] >>= explore >>= explore
  =       [1,2] >>= explore
  =       [1,2,1,2,3]

To understand this step split [1,2,1,2,3] into two parts:

To get the final answer, i.e. a list of all the places we might end up, we just concatenate the two lists.

Note that although there are three possible move at each step, and thus nine paths after two steps, we only consider the five valid paths here. This is not a simple Cartesian product.

It can be tedious to work with long lists, so let’s just count the number of times we end up in each cell.

freq :: Ord a => [a] -> [(a,Int)]				
freq = map (\as -> (head as, length as)) . L.group . L.sort

*Main> freq $ [1] >>= explore >>= explore
[(1,2),(2,2),(3,1)]

In other words of the five possible sets of two moves, we end up in cell 1 twice, cell 2 twice, and cell 3 once.

Finally, it gets boring iterating explore by hand, so let’s automate it. We’ll introduce nTimesM n f which composes f with itself n times:

nTimesM n f = foldr (>=>) return (replicate n f)

Then we can do n steps easily:

stepN n = nTimesM n explore 2					

*Main> freq $ stepN 12
[(1,13860),(2,19601),(3,13860)]

It’s easy to show algebraically that as the number of steps increases we’ll end up in cell 2 about √2 times as often as cell 1. Happily:

*Main> (19601 / 13860)^2
2.000000005205633

The probability monad

These nondeterministic calculations have the whiff of probability distributions about them, in particular distributions where each outcome is equally likely.

One could imagine weighting the outcomes by replicating each case a commensurate number of times, but a better approach is to replace the outcome with a tuple of outcome and probability.

Unsurprisingly this is still a monad. Although the idea is older, I originally read about the idea on The Universe of Discourse,5 to which MJD has now added a bibliography.6 You could just grab an implementation from Hackage.7

Trivial lists

Suppose we limit ourselves to lists of a single element, can we make a monad ? We can, but only if we restrict ourselves to functions which return a singleton lists.

Recall,

return x = [x]

and so all of our functions must decompose thus:

f  :: a -> m b
f' :: a -> b
f = return . f'

We can simplify bind too:

x >>= f = [ z | y <- x, z <- f y ]

[x] >>= f = f x
          = [ f' x ]

and for completeness:

join [[x]] = [x]
(f >=> g) [x] = [ (f.g) x ]

It all works, but it’s all trivial!

Note that return is a universal constructor for these restricted lists. This isn’t true for the normal list monad, because you can’t construct e.g. [] or [1,2] with return.

Rather than singleton lists, which the type system can’t easily enforce, we might as well define a new monad instance:

data Trivial a = Trivial a
   deriving (Show, Eq, Ord)

instance Monad Trivial where
    (Trivial x) >>= f   = f x
    return x            = Trivial x

    join (Trivial (Trivial x)) = Trivial x
    (f >=> g) (Trivial x)      = Trivial ((f.g) x)

This is essentially the Identity monad,8 which Dan Piponi has discussed9 on sigfpe.com.

Almost trivial lists

If trivial lists aren’t much fun, let’s consider lists with zero or one elements. Return is easy:

return x = [x]

There are two cases for bind:

[]  >>= _ = []
[x] >>= f = f x

and three for join:

join [[x]] = [x]
join [[]]  = []
join []    = []

The Kleisli arrow is messy but as long as the values are all singleton lists it will behave as the trivial monad above:

(f >=> g) [x] = [ (f.g) x ]

However as soon as a null list appears, the calculation immediately returns [].

Finally we know that f x must return either [] or [x'] for some x'. Immediately we can see there's a richer structure here: unlike the Trivial monad above we can’t always decompose f into a pure function and return.

Seasoned Haskell programmers will recognize all this as the Maybe monad.10 We define two constructors:

We can then say:

data Maybe a = Nothing | Just a
  deriving (Show, Eq, Ord)

instance Monad Maybe where
   Nothing  >>= _ = Nothing
   (Just x) >>= f = f x
   return x = Just x

join (Just (Just x)) = Just x
join _               = Nothing

The standard intuition for the Maybe monad is that it represents a calculation which might fail: for example a database query. A chain of such calculations should proceed normally until one fails, at which point the whole calculation fails.

In the context of our nondeterministic search example for the full list monad, this is equivalent to saying that at each step at most one solution can be found.

Other lists

It’s tempting to ask if other subsets of the list monad exist. For example. simply including lists of length 2 seems doomed to fail, because we can easily make lists of length 4:

Prelude Control.Monad> sequence [[1],[1]]
[[1,1]]
Prelude Control.Monad> sequence [[1,2],[1,2]]
[[1,1],[1,2],[2,1],[2,2]]

We don’t have this problem with the Trivial and Maybe monads because the sets {1} and {0,1} are closed under multiplication.

Job Vranish has implemented a fixed-length list11 which includes a monad instance, but I think it’s closer in spirit to a monad instance for ZipList12

You can’t make a monad instance from normal ZipLists though. See the following discussions in the Haskell Café:

Cookbook

Powersets: all subsets from a list of items

> filterM (const [True,False]) "abc"
["abc","ab","ac","a","bc","b","c",""]

I saw this in a comment Cale Gibbard made on Cristiano Paris’ Monadic headaches blog.16

To see why it works, first consider a map rather than a filter:

> mapM (const [True,False]) "abc"
[[True,True,True],[True,True,False],[True,False,True],...]

Our nondeterministic list monad maps each element of the "abc" list into a pair of alternatives ([True,False]), then generates a list of all eight possible combinations.

We could use the same idea to make list of binary numbers split into digits:

> mapM (const [0,1]) [1..2]
[[0,0],[0,1],[1,0],[1,1]]

Although personally I find sequence a more intuitive solution:

> sequence $ replicate 2 [0,1]
[[0,0],[0,1],[1,0],[1,1]]

In an article17 on Stack Exchange someone pointed out that you can improve this:

> replicateM 2 [0,1]
[[0,0],[0,1],[1,0],[1,1]]

Words

Suppose we want to extend the powerset by allowing repetition of the elements. The haskell wiki18 gives us a helpful recipe:

(inits . repeat) ['a'..'b'] >>= sequence

Prelude Data.List> (inits . repeat) "ab" >>= sequence
["","a","b","aa","ab","ba","bb","aaa","aab","aba","abb",...]

How does this work ?

Let’s work up to it in stages. repeat generates an infinite list of strings, then inits gives us a list of lists of strings of increasing lengths:

Prelude Data.List> repeat "ab"
["ab","ab","ab","ab","ab","ab","ab","ab",...]
Prelude Data.List> (inits . repeat) "ab"
[[],["ab"],["ab","ab"],["ab","ab","ab"],...]

As we saw above sequence gives the Cartesian product of lists:

Prelude Data.List> sequence []
[]
Prelude Data.List> sequence ["ab"]
["a","b"]
Prelude Data.List> sequence ["cd","ef"]
["ce","cf","de","df"]

To process all of these at once, just bind sequence to a list of lists:

Prelude Data.List> [[],["ab"],["cd","ef"]] >>= sequence
["","a","b","ce","cf","de","df"]

which is essentially what we need:

Prelude Data.List> (inits . repeat) "ab" >>= sequence
["","a","b","aa","ab","ba","bb","aaa","aab","aba","abb",...]

Words II

In his excellent Write You a Haskell19 series, Stephen Diehl gives a neater version:

Prelude Control.Monad> take 10 $ [1..] >>= flip replicateM ['a'..'c']
["a","b","c","aa","ab","ac","ba","bb","bc","ca"]

To unpick this, start with the replicateM:

Prelude Control.Monad> replicateM 2 ['a'..'c']
["aa","ab","ac","ba","bb","bc","ca","cb","cc"]
Prelude Control.Monad> flip replicateM  ['a'..'c'] $ 2
["aa","ab","ac","ba","bb","bc","ca","cb","cc"]

So flip replicateM ['a'..'c'] maps n to all the n letter words. If we pipe increasing integers to this with >>=, we will get the words in the desired order.