Haskell monads

by Carl Burch, Hendrix College, September 2012

Creative Commons License
Haskell monads by Carl Burch is licensed under a Creative Commons Attribution-Share Alike 3.0 United States License.
Based on a work at www.cburch.com/books/hsmonad/.

Contents

1. Transformations
1.1. Basic transformations
1.2. Transformations with data
2. Haskell support for monads
2.1. The Monad class
2.2. Lists of monads
2.3. do notation
3. The IO type
3.1. Displaying text
3.2. Reading keyboard input
3.3. A complete program
4. The Maybe type

Functional programming concentrates on state-free computation, and so accordingly a purely functional language does not include variables, assignment statements, or loops. But sometimes state is simply unavoidable. Maybe we want a program to interact with the user, or communicate over the network, or access a database. All of these operations inherently involve transitioning between states: The computer is in one state before the computer displays anything, then in another state after it displays a prompt and waits for user input, and then another state after the user completes entering input, and then another state after the computer displays a response. Naturally, Haskell has a way of dealing with this: It is called the monad.

1. Transformations

Let's suppose we're writing a program to manipulate a simple key-value database, which we happen to be using to map names of people (strings) to their ages (integers).

1.1. Basic transformations

If we stored this database in memory, then we'd imagine a type DB to represent the database, with a method such as the following.

put :: String -> Int -> DB -> DB

put name age db returns a new database structure retaining all the associations of db plus a new association between name and age.

For a function that populates the database with several people, we can write the following.

addVonTrapps :: DB -> DB
addVonTrapps db0 = put "Liesl" 16 (put "Friedrich" 14 (put "Louisa" 13
                                    (put "Kurt" 11 (put "Briggitta" 10
                                    (put "Marta" 7 (put "Gretl" 5 db0))))))

We could simplify this using the function composition operator (.); this allows us to avoid the parentheses and the db0 parameter.

addVonTrapps :: DB -> DB
addVonTrapps = put "Liesl" 16 . put "Friedrich" 14 . put "Louisa" 13
                                    . put "Kurt" 11 . put "Briggitta" 10
                                    . put "Marta" 7 . put "Gretl" 5

But we still are writing the operations in reverse order: This function adds Gretl first, followed by Marta, and concluding with Liesl. It would be more intuitive if the associations appeared in the code in the same order they are added into the database. That leads us to suggest a new operator >> that we could use to write functions in the order they should actually be applied.

addVonTrapps :: DB -> DB
addVonTrapps = put "Gretl" 5 >> put "Marta" 7 >> put "Briggitta" 10 >>
                                    put "Kurt" 11 >> put "Louisa" 13 >>
                                    put "Friedrich" 14 >> put "Liesl" 16

As a matter of fact, looking at this, we can rethink how we are imagining what put does. As initially defined, we thought of it as a function taking three parameters (name, age, current database) and returning the revised database. But now we think of it as something that takes two parameters (name and age) and produces a function transforming the database from one state to another. The (>>) operator allows us to sequence together several such transformations.

We can formalize this explicitly using a new type that represents a transformation of the database.

type DBTransform = DB -> DB

And then we reword our definition of put as follows.

put :: String -> Int -> DBTransform

put name age returns a function that transforms a database to retain all its associations plus a new association between name and age.

Finally, we define the operator >>, which works similarly to the composition operator (.) except that the transformation to be applied first is actually written first.

(>>) :: DBTransform -> DBTransform
step0 >> step1 = \db -> step1 (step0 db)

Let's close with one final example: Suppose we want to write a function that takes two parallel lists — one of names, the other of ages — and we want to insert all the associations into a database. We accomplish this using zipWith and put to create a list of transformations, which we then sequence together using foldl with the (>>) operator.

putPairs :: [String-> [Int-> DBTransform
putPairs names ages = foldl (>>) xform0 xforms
  where (xform0 : xforms= zipWith put names ages

1.2. Transformations with data

Now let's take this idea one step further. Inevitably, most transaction of several manipulations to the database will access values from the database. For instance, we might want a function that, given two names of people, removes the older person from the database. Such a function would need to read the two peoples' names before it can proceed with the removal.

The idea of DBTransform and a sequencing operator worked so well that we want to keep that idea. But we need some way that the DBTransform can both have a result value as well as the modified database. That leads to modifying our DBTransform definition so that it returns a tuple that includes not only the updated database but also the result value. Since the result value packed into the tuple will have a type depending on the operation, we'll define this modified DBTransform with a polymorphic parameter.

type DBTransform a = DB -> (aDB)

Now suppose we have the following functions for producing transformations. Notice how they illustrate a variety of possible result types.

get :: String -> DBTransform Int

get name creates a transformation that leaves the database unchanged but incorporates a result having the age corresponding to the provided name.

getKeys :: DBTransform [String]

getKeys name creates a transformation that leaves the database unchanged but incorporates a result having a list of all names appearing in the database.

has :: String -> DBTransform Bool

has name creates a transformation that leaves the database unchanged but incorporates a result indicating whether the provided name exists in the database.

put :: String -> Int -> DBTransform Bool

put name age creates a transformation for adding a name-age pair if the name isn't already represented; the result is True if the pair could be added and False if the name was already paired.

remove :: String -> DBTransform Bool

remove name creates a transformation for removing a name-age pair; the result is True if the pair could be removed and False if the name couldn't be found.

Now let's suppose we want to write our function that removes the older of two people from the database given just those peoples' names. One way to do this is as follows.

removeOlder :: String -> String -> DBTransform Bool
removeOlder name0 name1
    = \db0 -> let
                    (age0db1= get name0 db0
                    (age1db2= get name1 db1
            in remove (if age0 > age1 then name0 else name1db2

Of course, the database db1 returned by the first call to get is the same as db0, so we could safely use db0 for the second call to get as well. But in general, each transform could conceivably alter the database, so we're faithfully executing the transforms in a way that guarantees the order of their execution.

Again, though, it would be nicer if we could find an analogue to the sequencing operator (>>), so that we don't have to deal with the different database versions. But we need some way to take a result value from one transformation and use it in computing future transformations. This leads us to define a new sequencing operator, (>>=), where we expect on the right side a function taking the result of the first transform in order to constructs the second transform to be applied.

(>>=) :: DBTransform a -> (a -> DBTransform b-> DBTransform b
step0 >>= step1f = \db -> let (resultdb'= step0 db in (step1f resultdb'

We can rewrite removeOlder using this new sequencing operator.

removeOlder name0 name1
    = get name0
        >>= (\age0 -> get name1
            >>= (\age1 -> remove (if age0 > age1 then name0 else name1)))

The outer two pairs of parentheses aren't actually required, since anonymous functions using lambda notation simply extend as far to the right as possible. Using this fact, and the fact that indentation doesn't matter, we can rewrite this using the following identical definition.

removeOlder name0 name1 =
    get name0 >>= \age0 ->
    get name1 >>= \age1 ->
    remove (if age0 > age1 then name0 else name1)

While this rewritten version obscures how the sequencing operator (>>=) is used, with practice it is easier to read: We have three lines corresponding to three different steps. In the first step, we retrieve the age associated with name0, with the symbol age0 receiving the result. In the second step, we similarly transfer into age1 the result from retrieving the age associated with name1. And the third step removes the name leading to the greater age.

As we go onto other functions, it will also be helpful simply to wrap a particular result into a transformation that doesn't do anything else. That leads to the following definition of a function named return — but don't let the name of the function mislead you, since this is quite different from the return statement from C, Java, or Python. In particular, it doesn't exit a function immediately as it does with these imperative languages.

return :: a -> DBTransform a
return result = \db -> (resultdb)

In the following function, we find the sum of ages for a list of names from the database. In this case, we use return to create the DBTransform with the desired sum, wrapped within the DBTransform as required by the sequencing operator and by the function's type signature.

sumAges :: [String-> DBTransform Int
sumAges [] = return 0
sumAges (name0 : names=
    get name0 >>= \age0 ->
    sumAges names >>= \ages ->
    return (age0 + ages)

Similarly, we can define a function that removes a person from the database if they fall below a threshold.

removeIfYounger :: Int -> String -> DBTransform Bool
removeIfYounger threshold name =
    get name >>= \actual ->
    if actual <= threshold then remove name else return False

And we'll close with a function that combines these two functions into a function to remove all people from the database whose age is below average.

removeBelowAverage :: DBTransform Bool
removeBelowAverage =
    getKeys >>= \allNames ->
    sumAges allNames >>= \total ->
    let
        avg = total `divlength allNames
        (xform0 : xforms= map (removeIfYounger avgallNames
    in foldl (>>) xform0 xforms

2. Haskell support for monads

So far, we've only worked with the DB and DBTransform types. These aren't built-in Haskell types, but they serve as a good way of introducing the sequencing operators that are central to Haskell.

2.1. The Monad class

To define the sequencing operators and the return function as functions that can apply to a variety of types, Haskell packages these together into a class, named Monad.

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

(Technically, our previous declaration of DBTransform as a type synonym for a function prevents it from being declared as an instance of this class. Consequently we could not really define DBTransform and use the sequencing operators as illustrated above. We could easily work around this, though, by defining DBTransform using a data declaration, with the function nested within a type constructor.)

Every type that is an instance of the Monad class should define the required functions in accordance with three basic monad properties. The Haskell compiler has no way of checking this, but these are key properties that any person using the type would expect.

  1. m >>= return should be equivalent to m. That is, if m has a result value that is passed to the return function using the sequencing operator, the return function's result value should be the same as m's result.

  2. return x >>= f should be equivalent to f x. If we package the result value x into a monad and then apply the sequencing operator to have x passed to f, it should be the same as passing x into f directly.

    Note that this property means that return cannot have the “stop immediately” meaning that one finds associated with the return keyword typical to imperative languages. That is, in a language like C, Java, or Python, the function stops computation as soon as return is encountered. But this property says that return simply wraps a value into a monad for further processing by later transformations in the sequence.

  3. Assuming that x is not used by g, m >>= (\x -> f x >>= g) should be equivalent to (m >>= f) >>= g. This is basically a law of associativity for the sequencing operator.

2.2. Lists of monads

The library also includes a couple of useful functions dealing with monads and lists of values.

sequence :: Monad m => [m a-> m [a]

sequence ms takes a list of monads ms and sequences them together using the monad's sequencing operators. The returned monad sequences the transformations together with the result being a list of the individual monads' results.

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

mapM f xs takes a function f returning a monad and a list xs of potential arguments to the function, and sequences together the monads created by applying f to each argument from xs. The returned monad's result value is a list of the results from the individual monads.

In fact, two of our earlier examples, putPairs and removeBelowAverage, could more easily be defined using these two functions.

putPairs :: [String-> [Int-> DBTransform [Bool]
putPairs names ages = sequence (zipWith put names ages)

removeBelowAverage :: DBTransform [Bool]
removeBelowAverage =
    getKeys >>= \allNames ->
    sumAges allNames >>= \total ->
    let avg = total `divlength allNames
     in mapM (removeIfYounger avgallNames

2.3. do notation

Haskell defines some syntactic sugar for sequences of monad operations. Rather than use the sequencing operators (>>) or (>>=), we can instead use do notation. First, let's look at an example that without do notation. The following function swaps the ages for two individuals.

swapAges :: String -> String -> DBTransform Bool
swapAges name0 name1 =
    get name0 >>= \age0 ->
    get name1 >>= \age1 ->
    remove name1 >>
    put name1 age0 >>
    remove name0 >>
    put name0 age1

With do notation, we can instead write it thus.

swapAges name0 name1 =
    do age0 <- get name0
       age1 <- get name1
       remove name1
       put name1 age0
       remove name0
       put name0 age1

This is purely syntactic sugar, and the compiler simply translates it into the first form. Basically, any line of the form “sym <- expr” is converted to “expr >>= \sym ->”, while any line of the form “expr” is converted to “expr >>”. (For the final line of the do block, though, the final sequencing operator is omitted.)

Though this is just syntactic sugar, it is still a handy way to rearrange a program. In fact, it looks deceptively like we have added assignment statements back into the language! It's important to note, though, that “sym <- expr” is not assignment. To see an example where this interpretation is invalid, recall our removeBelowAverage function.

removeBelowAverage =
    getKeys >>= \allNames ->
    sumAges allNames >>= \total ->
    let avg = total `divlength allNames
     in mapM (removeIfYounger avgallNames

You might be tempted to rewrite this as follows using do notation.

removeBelowAverage =
    do allNames <- getKeys
       total <- sumAges allNames
       avg <- total `divlength allNames    -- wrong!
       mapM (removeIfYounger avgallNames

However, this won't work. The reason is that the right-hand side of each of the pseudo-assignments must be a monad, but the right-hand side following “avg <-” is simply a number: It's not a DBTransform _ as required. The solution is simple enough: Use a let to associate a value with avg.

removeBelowAverage =
    do allNames <- getKeys
       total <- sumAges allNames
       let avg = total `divlength allNames
        in mapM (removeIfYounger avgallNames

(The space before in is required on the final line: If this line isn't indented beyond the let line, the Haskell compiler will regard the let and the in lines as being two different lines of the do notation, and it won't be able to compile. Indenting a bit further tells the Haskell compiler that it's looking at a continuation of the previous line.)

If you insist on using the pseudo-assignment for avg, though, there is a way: On the right side, we can use return to wrap the value up into a DBTransform so that we can legally include the pseudo-assignment.

removeBelowAverage =
    do allNames <- getKeys
       total <- sumAges allNames
       avg <- return (total `divlength allNames)
       mapM (removeIfYounger avgallNames

3. The IO type

Of course, DBTransform is just an example that doesn't really exist as a standard part of Haskell. Haskell does define the Monad class, though, and it defines several types that are instances of that class. The most important such type is named IO: It is used for output to a textual display, keyboard input, and file manipulation.

3.1. Displaying text

The functions for displaying to the textual display have the type IO (). The () result type indicates a tuple with nothing in it; this is a handy type when there is no information to return. There are three functions for displaying text that are particularly useful.

putChar :: Char -> IO ()

Places a single character on the display.

print :: Show a => a -> IO ()

Converts the parameter value to a string using the show function, and places this string on the display.

putStrLn :: String -> IO ()

Places a string on the display, followed by the newline character.

Let's put these functions together in a simple function that takes a parameter n and displays the numbers from n down to 1 on separate lines, followed by the string “Blastoff!”.

countDown :: Int -> IO ()
countDown 0 = putStrLn "Blastoff!"
countDown n = print n >> putChar '\n' >> countDown (n - 1)

In the recursive case, we could easily have used do notation, but in this case each step was so simple that we combined the three parts into one line using the sequencing operator. The recursive case first displays the current number, then displays a newline character, and finally it recurses to display the remaining numbers.

We could alternatively accomplish this non-recursively using the built-in list functions. The following implementation uses the fact that Haskell allows us to create a range of numbers with a defined step by listing the first two values followed by “..”; for example, [2,5..11] starts goes up by 3's (since 5 − 2 = 3) from 2 until 11, resulting in the list [2,5,8,11]. In our function, we go “up” by −1's, which of course is the same as counting down.

countDown :: Int -> IO ()
countDown n =
    do mapM (putStrLn . show) [nn - 1 .. 1]
       putStrLn "Blastoff!"

We use mapM to apply a composed function to each number in the descending list. For each such number, we first apply show to convert the number to a string, and then we pass that string to putStrLn to display the string followed by a newline character. After mapM is done sequencing together all these IO operations, we then use putStrLn one last time to display “Blastoff!”.

3.2. Reading keyboard input

The IO monad can also be used for reading keyboard input. There are three particularly useful functions for this.

getChar :: IO Char

Reads a single character, placing this character into the IO result.

getLine :: IO String

Reads all characters up to the newline, placing a string of these characters (excluding the newline) into the IO result.

readLn :: Read a => IO a

Reads all characters up to the newline, using read to convert a string of these characters (excluding the newline) to the IO result of the desired type.

We can incorporate this into our count-down program so that the starting point is entered by the user. Here, we first display a prompt for the user; then we use readLn to read the user's input, interpreted as a number; and finally we display our countdown and conclusion as before.

countDown :: IO ()
countDown =
    do putStr "Starting point? "
       n <- readLn
       mapM (putStrLn . show) [nn - 1 .. 1]
       putStrLn "Blastoff!"

Or another example: A function that reads several lines from the user and then displays the lines in sorted order. In this case, we first read some integer n from the user and then use mapM to display a prompt and read a string n times. Finally, we use the sort function from the Data.List module and pass it to mapM again to display each of the strings in the sorted list.

sortLines :: IO [()]
sortLines =
    do putStr "How many lines? "
       n <- readLn
       lines <- mapM (\i -> putStr (show i ++ ": ") >> getLine) [1..n]
       mapM putStrLn (sort lines)

The type of sortLines is rather odd. It comes from the fact that in the final line of the function, we apply putStrLn to each string. Each time, putStrLn's monad includes a result of the empty tuple (), and mapM includes each of these empty-tuple results in a list. If we wanted sortLines to have the more sensible type of IO [String], we'd need to add an additional line such as return (sort lines).

3.3. A complete program

We're now in a position to present a complete program written in Haskell. To be a complete program, the file should define a function named main, and its type must be IO (). In our program, whose job is to ascertain a number between 1 and 100 being considered by the user, we use a recursive helper function named guess to go through each iteration.

import System.IO

guess :: Int -> Int -> Int -> IO ()
guess lo hi count =
    do putStr ((show mid) ++ "? ")
       hFlush stdout    -- ensures prompt displays before user input
       line <- getLine
       if line == "low" then
           if lo == hi then
               putStrLn "You're cheating!"
           else
               guess (mid + 1hi (count + 1)
        else if line == "high" then
           if lo == hi then
               putStrLn "You're cheating!"
           else
               guess lo (mid - 1) (count + 1)
        else if line == "yes" then
           putStrLn ("Got it right in " ++ show count ++ " guesses!")
        else
           do putStrLn "Please type 'low', 'high', or 'yes'"
              guess lo hi count
    where mid = (lo + hi) `div2

main :: IO ()
main = guess 1 100 1

Some notes regarding this program:

4. The Maybe type

Another type that Haskell includes is Maybe, defined using the following data declaration.

data Maybe a = Nothing | Just a

This is often used in contexts that have nothing to do with monads or state, but rather to deal with values that may or may not exist. In other languages, we might write use null to represent the non-existent value; but in Haskell we'd use the type Maybe a, with Nothing being the non-existent value.

For instance, Haskell includes a handy built-in function called lookup that takes a list of pairs and a value, finds the first pair with the provided value in the first slot, and returns the second value in that pair. For instance, lookup 3 [(12), (23), (35), (47)] would return locate the pair (3, 5), since 3 is the first pair in the list starting with 3, and it would identify 5 as its result.

However, such a pair may not exist, so lookup doesn't simply return the second value in the located pair, but rather a Maybe value. If no such pair exists, it returns the value Nothing. But if it finds a pair, it returns a Just value with the corresponding value nested within it. In our example, the returned value is actually Just 5. In fact, if lookup weren't already defined for us, we could easily define it as follows.

lookup :: Eq a => a -> [(ab)] -> Maybe b
lookup key [] = Nothing
lookup key ((x0y0: rest| key == x0 = Just y0
                             | otherwise = lookup key rest

An example where we might use this is a function to add two people's ages based on a list of pairs each containing a person's name and age; but if either person is missing from the list, our result should be Nothing.

sum2Ages :: String -> String -> [(StringInt)] -> Maybe Int
sum2Ages name0 name1 pairs = decode (lookup name0 pairs) (lookup name1 pairs)
   where decode (Just age0) (Just age1= Just (age0 + age1)
         decode _ _ = Nothing

So far, this discussion of Maybe has had nothing to do with monads. But in fact Maybe is an instance of the Monad class. In applying the sequencing operator to combine several Maybe values, the result will be Nothing as soon as Nothing comes up as a result, but otherwise the Just values will be chained through the sequence. Meanwhile, the return function wraps a value up in the Just constructor.

We can use this to rewrite our sum2Ages function.

sum2Ages name0 name1 pairs =
    do age0 <- lookup name0 pairs
       age1 <- lookup name1 pairs
       return (age0 + age1)

If either lookup invocation returns Nothing, the monad simply returns Nothing without proceeding with subsequent parts of the sequence. But if it reaches the final statement, the return statement would wrap the sum into a Just constructor. (For that matter, we could just as validly replace the word return here with Just).

In getting introduced to the sequencing operators in Section 1, we learned about them as operators for chaining transformations together. Indeed, this is the most common way to use monads. But the Maybe monad breaks that mold: With the Maybe monad, each individual value in the sequence is not a transformation but an individual value (either Nothing or Just x). This is still a legitimate monad, though, because it still obeys the three vital properties that all monads must have.