Lecture 20: Monad Transformers

A fundamental issue with monads is that they don't compose naturally. This can be a great challenge if you want to combine monadic effects, e.g., to both carry state and do IO. Monad transformers provide a solution to this problem. We've already seen how so-called monad transformers can be used to dramatically simplify the parser code we wrote.

The paper, Monad Transformers Step by Step by Martin Grabmüller is an excellent introduction to monad transformers, set in the context of an evaluator for a simple expression language. Grabmüller starts with the standard Identity monad, and successively adds effects by adding error handling via ErrorT, hiding the environment via ReaderT, adding a tick-counter for profiling via StateT, adding logging via WriterT, and finally IO by replacing the innermost Identity monad with IO. It is, quite frankly, a tour de force, and well worth the effort of reading several times, which you'll need to do to understand it. Let me be more explicit here: don't expect to fully “get it” the first time you read his paper, or the second. There is no royal road to monad transformers.

Today's lecture will be far simpler than Grabmüller's paper. My goal is to give enough background so that you can read “Monad Transformers Step by Step” with profit.

Control.Monad.NState

Recall the Parser monad, and our sense that it was a mashup of a State String monad and a []. This intuition was ultimately rewarded by our discovery that we could define Parser as StateT String [], understanding parsing objects as non-deterministic state-based functions, realized via the type String -> [(a,String)], and thereby gaining the automatic derivation of instances of the most important Haskell typeclasses for Parser. We can further exploit this observation by generalizing the Parser type by abstracting out its reliance on String:

type NState s = StateT s []

With this, a great deal of functionality comes along for free, including the functions put, get, state, and modify. We add functions nstate and branch for building building non-deterministic state-based computations, and provide functions runNState, evalNState and execNState for running non-deterministic computations.

We'll provide an nstate function, analogous to state, which allows us to convert a non-deterministic state-based function realized as a function of type s -> [(a,s)] as NState s value, which simply puts the non-deterministic function into a StateT box:

nstate :: (s -> [(a,s)]) -> NState s a nstate = StateT

The branch function is interesting, both for what it does, and how it's implemented. The idea behind branch is that we'll provide a list, and the computation will non-deterministically select an item from that list:

branch :: [a] -> NState s a

A naïve implementation uses nstate:

branch as = nstate $ \s -> [(a,s) | a <- as]

This works, but there is a more sophisticated, but in the end more natural approach. The type of branch is a function that takes a value of type [a], i.e., the “inner monad” [] applied to a base type a, and “lifts” it a value in the transformed monad StateT s [] a. This is a very common thing to what to do. When possible, which is almost always, monad transformers belong to the MonadTrans type class (defined in Control.Monad.Trans.Class), and so define the corresponding lift function:

class MonadTrans t where lift :: Monad m => m a -> t m a

With this, we have a simplified implementation of branch:

branch :: [a] -> NState s a branch = lift

The other functions are just re-namings of the corresponding functions from Control.Monad.State, associating them with our specific type. This code, which I expect to reuse, was then packaged as a cabal project, installed in the usual way, and is available on github.com. Note the use of -- ^ to document something after it appears in the source.

Sudoku

Sudoku is a popular puzzle, based on filling in a 3x3 grid of 3x3 grids, partially filled with the numbers 1, 2,..., 9, e.g.,

6 9 2 8
8 5 6 9
4 2
3
9 4
46 831
1 76
7 39
7

The rules to Sudoku are simple: each digit must appear exactly once in each row, column, and bold-edged 3x3 square. Solving Sudokus is not so simple, and writing a Sudoku solver is a common programming exercise, one that we'll do twice in this course, in very different ways, and to very different ends. The traditional approach involves building a data structure that contains a representation of the board, and then for making recursive calls to a solver function on each empty cell, trying every possible way to fill that cell in. That's the basic approach we're going to take here, but because this is Haskell, the punchline to the code is going to be unexpected and breathtakingly succinct.

We'll first define some basic types around which we'll organize the computation:

import Data.Map (Map,(!)) import qualified Data.Map as Map type Position = (Int,Int) type Board = Map Position Int type Solver = Board -> [Board]

A Position indexes a cell on a Sudoku board, in (row,col) form, with row and column indices in the range [1..9]. A Board represents a Sudoku puzzle. Remember that a Map is a finite partial function, and as such, we can and will represent a blank cell at a position p by not including p as a key in the Map. Finally, a Solver is an algorithm that tries to solve a Sudoku puzzle. Note that it returns a list of results, allowing for the possibility that the particular puzzle we're working on has 0, 1, or a multiplicity of solutions. This type is a good hint that we can approach the problem of solving a Sudoku via non-determinism.

We'll often need the list of valid Position values, and so define:

positions :: [Position] positions = [(row,col) | row <- [1..9], col <- [1..9]]

Of course, the code transformation fairy never sleeps, and realizes that this can be written in a way that eliminates the local variables row and col within the list comprehension.

positions = liftM2 (,) [1..9] [1..9]

or better still,

positions = (,) <$> [1..9] <*> [1..9]

There are those who think the code transformation fairy needs to get a life. She'd tell you she has one.

The key function in our code is extend, a function that takes a position, and tries to non-deterministically extend its state, a Board, by defining it at that position:

extend :: Position -> NState Board () extend pos = do board <- get val <- branch $ viable pos board put $ Map.insert pos val board

The computational idea is very simple: we'll get the board (which is the underlying state), branch on the list of distinct ways we can assign value to the indicated cell without creating a conflict, and save the updated state. Note that if there are no viable assignments, this call fails in the sense that the returned value packs up the empty list of boards.

To calculate the conflicts, we'll first build neighbors :: Map Position [Position], which will map a position on the board to all of the positions that aren't allowed to hold the same value. Looked at this way, a Sudoku problem amounts to extending a partial 9-coloring of a particular graph to a total 9-coloring.

neighbors = Map.fromList [(p,neighborf p) | p <- positions] where neighborf pos = delete pos . nub . concatMap ($ pos) $ [rowOf,colOf,blockOf] rowOf (row,col) = map ((,) row) [1..9] colOf (row,col) = map (flip (,) col) [1..9] blockOf (row,col) = [(trunc row + rx,trunc col + cx) | rx <- [1..3], cx <- [1..3]] trunc x = nx - nx `mod` 3 where nx = x-1

The neighbors map memoizes the encapsulated function neighborf, which we do because even though there are only 81 positions on a Sudoku puzzle, we may need to determine the neighbors of various positions thousands of times as we try different alternatives, and the neighborhood calculation is just a bit intricate. Basically, we build the list of cells (including the argument) that are on the same row, column, and block, concatenating the results, using nub to prune duplicates, and delete to remove the argument from the resulting list of neighbors. The nub function is actually a bit problematic from a complexity-theoretic point of view, as it is quadratic in the length of the input list. In this case, it's going to be called on 27 element lists (3x9) 81 times, and this isn't really worth improving, especially as there are ongoing discussions in the Haskell community as to how to do nub better.

Next, we need to implement the viable functions that lists the values that we can assign to a particular cell:

viable :: Position -> Board -> [Int] viable pos board = candidates \\ conflicts where candidates = case Map.lookup pos board of Just x -> [x] Nothing -> [1..9] conflicts = mapMaybe (`Map.lookup` board) $ neighbors pos

This is a bit tricky. The candidate values for a cell are going to be [1..9] if the cell is empty (in which case Map.lookup pos board returns Nothing), and x if the cell contains x (in which case Map.lookup pos board returns Just x). And the values that our cell conflicts with is determined by mapping (`Map.lookup` board) across the neighbor list, obtain a list of Maybe Int's, which is then collapsed down via catMaybes. Except that mapMaybe collapses the calls to map and catMaybes down into a single call.

Finally, we're ready for the punchline. Our solver can now be written as:

backtrack :: Solver backtrack = execNState $ mapM_ extend positions

Yup. We just build a list of NState objects each of which tries to extend the board at a single position, and sequence our way through that list.

There is a little more (actually more than a little more) code involved in parsing and formatting Sudoku boards, and the final version does a few encapsulations, but now if we have a Sudoku problem in a text file like this:

6 . 9 . 2 . . . 8 . 8 . 5 . 6 . . 9 4 . . . . . . 2 . . . . . . 3 . . . 9 . . . . . . . 4 . . . 4 6 . 8 3 1 . . . . 1 . . 7 6 . . 7 . . . 3 9 . . . . . 7 . . . .

We can solve it using this program:

$ ./sudoku < sudoku-1.txt problem: 6 . 9 . 2 . . . 8 . 8 . 5 . 6 . . 9 4 . . . . . . 2 . . . . . . 3 . . . 9 . . . . . . . 4 . . . 4 6 . 8 3 1 . . . . 1 . . 7 6 . . 7 . . . 3 9 . . . . . 7 . . . . solution: 6 3 9 7 2 4 5 1 8 2 8 1 5 3 6 7 4 9 4 7 5 8 9 1 6 2 3 8 1 4 2 5 3 9 6 7 9 6 3 1 8 7 2 5 4 7 5 2 4 6 9 8 3 1 5 9 8 3 1 2 4 7 6 1 2 7 6 4 8 3 9 5 3 4 6 9 7 5 1 8 2 $

The source for this program (modified so as to not require installing Control.Monad.NState), can be found in the following two files:

And here are some files containing Sudoku puzzles in the appropriate format for solution by our sudoku program.

hp, Calc revisited

Way back in Lecture 16: State Monad, I, we considered a program that enabled us to simulate a reverse-polish calculator, inspired by the Hewlett-Packard calculators of my youth. But actually using that program required that we write out the calculations we wanted to do in the State monad, which is not a very satisfactory way of interacting with a calculator. Our next goal is to produce an interactive version of that calculator, which I'll call hp in deference to and honor of the Hewlett-Packard Corporation and its excellent calculators of yore. Part of our goal here will be to change as little of the code we wrote before as possible.

We begin by remember the basic type of an action in our calculator:

data InternalState = InternalState { stack :: [Double], memory :: Double } type CalcState = State InternalState

Now, we recall that State a is actually StateT a Identity. To add IO to this, we're going to replace that inner Identity monad with IO, resulting in:

type IOCalcState = StateT InternalState IO

We expect interactions to look like this:

$ ./hp : 15 10 -20 12 + * : p s = -80.0 15 m = 0.0 : q $

The program prompts us with ": ". We'll then enter a sequence of commands, separated by spaces. Commands that look like numbers result in pushing that number on the stack. The arithmetic operators, +, -, *, and / result in popping off the first two elements of the stack, performing the corresponding operation on those two values, and pushing the result on the stack. The command swap, dup, sin, cos, tan, and sqrt perform the expected operations. The p command prints the state of the calculation, while q quits. Commands that aren't recognized result in an error message, and suspend the execution of any of the pending commands from the same line, e.g.,

$ ./hp : 1.2e7 sqrt p s = 3464.1016151377544 m = 0.0 : foobar 10 20 + unrecognized command: foobar commands not executed: 10 20 + : p s = 3464.1016151377544 m = 0.0 : q $

A key to such programs is the repl, which stands for “read-eval-print-loop.” Our repl is a bit of a misnomer because it doesn't follow exactly the expected pattern, but it comes close:

repl :: IOCalcState () repl = while $ do liftIO $ putStr ": " >> hFlush stdout commands <- liftIO (fmap words getLine) runCommands commands

There's a lot going on here! First, we'll focus on the do block. The liftIO command is used to “lift” an bare IO action into a transformed IO monad. Note that we have to use liftIO rather than just lift to lift an IO action into a transformed IO monad. The action fmap words getLine reads a line of input, and breaks between on-empty sequences of space-like characters. We lift this into the IOCalcState [String] monad, and pass the results to runCommands :: [String] -> IOCalcState Bool. The returned value indicates whether or not we should iterate, via:

while :: Monad m => m Bool -> m () while action = loop where loop = do continue <- action when continue loop

This brings us to runCommands, which is where the heavy-lifting finally takes place:

import Text.Regex.Posix runCommands :: [String] -> IOCalcState Bool runCommands [] = return True runCommands (c:cs) | c =~ "^-?[0-9]+([.][0-9]*)?([eE]-?[0-9]+)?$" = run $ kEnter (read c) | c == "+" = run kAdd | c == "-" = run kSub | c == "*" = run kMul | c == "/" = run kDiv | c == "swap" = run kSwap | c == "dup" = run kDup | c == "sin" = run kSin | c == "cos" = run kCos | c == "tan" = run kTan | c == "sqrt" = run kSqrt | c == "+/-" = run kNeg | c == "c" = run kClear | c == "p" = printState >> runCommands cs | c == "q" = return False | otherwise = do liftIO $ do putStrLn $ "unrecognized command: " ++ c putStrLn $ "commands not executed: " ++ unwords cs return True where run cmd = shift cmd >> runCommands cs shift = state . runState

Again, there's a lot going on here! We work our way through the command strings one at a time. That big list of guards is used to figure out what kind of command we're looking at. The first guard looks for something that satisfies a number format, in which case the command is converted into a Double via read, and pushed on the stack via kEnter. Most of the other commands correspond to key-presses in the calculator, the exceptions being p and q. Mind them! Oh, and handling unrecognized commands. Mind that too.

The ordinary commands get passed to run, which first shift's them (moving them from CalcState () to IOCalcState () by lifting a state-transformation function out of a CalcState box via runState, and then putting that function back into a IOCalcState box via state), and then calls runCommands on the remaining commands.

The q command returns False, which results in the termination of the repl when it gets interpreted by the while command, while the p command calls printState:

printState :: IOCalcState () printState = do state <- get liftIO $ do putStrLn $ "s = " ++ (intercalate " " $ map show $ stack state) putStrLn $ "m = " ++ show (memory state)

All that's left is main, which makes sure that stdin is properly buffered, and which sets up an appropriate call to repl:

startState :: InternalState startState = InternalState { stack = [], memory = 0.0 } main :: IO () main = do buffering <- hGetBuffering stdin hSetBuffering stdin LineBuffering runStateT repl startState hSetBuffering stdin buffering

Our final implementation abstracts out the buffer management into reusable boilplate:

withInputBuffering :: MonadIO m => BufferMode -> m a -> m a withInputBuffering mode action = do savedMode <- liftIO $ hGetBuffering stdin liftIO $ hSetBuffering stdin mode result <- action liftIO $ hSetBuffering stdin savedMode return result main :: IO () main = void $ withInputBuffering LineBuffering $ runStateT repl startState

The type of withInputBuffering is overkill for now, but it substantially increases reusability, which is the point to boilerplate after all. This will become a bit clearer (I hope!) in a couple of lectures. The source for this program can be found in the following file:

*Exercise 20.1 Remember Exercise 16.5 where you implemented kSto and kRcl? Extend the hp.hs program so that the commands s and r run kSto and kRcl respectively.

Turn in a copy of runCommands, along with any other code from hp.hs you might have changed, together with an illustrative run that demonstrates the functionality you added.