[More monads. Oh boy! Bryan O'Sullivan **20071218074401] { move ./examples/ch14/bind_.ghci ./examples/ch14/bind.ghci hunk ./en/book-shortcuts.xml 131 -print"> +print"> hunk ./en/ch10-binary.xml 361 - + hunk ./en/ch14-monads.xml 220 - We use this function for sequencing, when we want to perform - actions in a certain order, but don't care what the result of - one is. As we show above, the default implementation for - &bind_; is in terms of &bind;. + We use this function when we want to perform actions in a + certain order, but don't care what the result of one is. This + might seem pointless: why would we not care what a function's + return value is? Consider a function like &print;, which + returns nothing useful. + + &bind.ghci:print; + + If we use plain &bind;, we have to provide as its right hand + side a function that ignores its argument. + + &bind.ghci:bind; + + But if we use &bind_;, we can omit the needless + function. + + &bind.ghci:bind_; + + As we showed above, the default implementation of &bind_; is + defined in terms of &bind;. hunk ./en/ch14-monads.xml 254 - don't call &fail; unless you know that you're using a monad + don't call &fail; unless you know that you're inside a monad hunk ./en/ch14-monads.xml 267 - Building a monad: show your work! + And now, a jargon moment + + There are a few terms of jargon around monads that you may + not be familiar with. These aren't formal terms, but they're in + common use, so it's helpful to know about them. + + + + Monadic simply means pertaining to + monads. A monadic type is an + instance of the Monad typeclass; a monadic + value has a monadic type. + + + An action is another name for a monadic + value. This use of the word probably originated with the + introduction of monads for I/O, where a monadic value like + print "foo" can have an observable side effect. + A function with a monadic return type might also be referred + to as an action, though this is a little less common. + + + + + + Using a new monad: show your work! hunk ./en/ch14-monads.xml 298 - foreknowledge of what we're doing. + foreknowledge of what we're doing. We'll start out by defining + its interface, then we'll put it to use. Once we have those out + of the way, we'll finally build it. hunk ./en/ch14-monads.xml 308 - developed in . Let's modify - it so that it keeps a record of each of the special pattern - sequences that it translates. To do this, we'll add a - Logger type constructor to our result type. + developed in . We will + modify it so that it keeps a record of each of the special + pattern sequences that it translates. We are revisiting + familiar territory for a reason: it lets us compare non-monadic + and monadic versions of the same code. hunk ./en/ch14-monads.xml 314 - &Logger.hs:globToRegex.type; + To start off, we'll wrap our result type with a + Logger type constructor. hunk ./en/ch14-monads.xml 317 - Before we get into the details of the Logger - monad, we'll show how we use it. + &Logger.hs:globToRegex.type; hunk ./en/ch14-monads.xml 323 - Logger module abstract, and provide our users - with a simple interface. + Logger module abstract. hunk ./en/ch14-monads.xml 327 - Hiding the details like this grants us considerable - flexibility in how we implement our monad. + Hiding the details like this has two benefits: it grants + us considerable flexibility in how we implement our monad, and + more importantly, it gives users a simple interface. hunk ./en/ch14-monads.xml 334 - to create a value of this type. All they can do is write type - signatures. + to create a value of this type. All they can can use + Logger for is writing type signatures. hunk ./en/ch14-monads.xml 337 - The Log type is just a synonym, to make a few - signatures more readable. + The Log type is just a synonym for a list of + strings, to make a few signatures more readable. We're using + a list of strings to keep the implementation simple. hunk ./en/ch14-monads.xml 343 - To evaluate a logged action, users call the - execLogger function. This returns both - the result of an action and whatever was logged while the - result was being computed. + Instead of giving our users a value constructor, we + provide them with a function, execLogger, + that evaluates a logged action. This returns both the result + of an action and whatever was logged while the result was + being computed. hunk ./en/ch14-monads.xml 351 - Most monads have an execLogger-like - function, which is responsible for starting off execution of - the monad and extracting its result. The notable exception to - this rule is IO. + + + + Controlled escape + + The Monad typeclass doesn't provide any means + for values to escape their monadic shackles. We can inject a + value into a monad using &return;. We can extract a value + from a monad using &bind; but the function on the right that + can see an unwrapped value has to wrap its own result back up + again. + + Most monads have one or more + execLogger-like functions. The notable + exception is of course IO, which we usually only + escape from by exiting a program. + + A monad execution function runs the code inside the monad + and extracts its result. These functions are usually the only + means provided for values to escape. Thus, the author of a + monad has complete control over the external visibility of + whatever happens inside the monad. In our case, we can + imagine a few alternatives to execLogger: + one might only return the log messages, while another might + return just the result and drop the log messages. + + + + Leaving a trace hunk ./en/ch14-monads.xml 395 + + We'll use &ghci; to produce a simple example of our monad + in use. + + &logger.ghci:simple; + + When we run the logged action using + execLogger, we get back a two-tuple. The + first element is the result, and the second is the list of + items logged while the action executed. We haven't logged + anything, so the list is empty. Let's fix that. + + &logger.ghci:logged; + hunk ./en/ch14-monads.xml 419 - Remember the type of &bind;; it extracts the value on the + Remember the type of &bind;: it extracts the value on the hunk ./en/ch14-monads.xml 463 - huh? + Parsing a character class mostly follows the same pattern + that we've already seen. + + &Logger.hs:class; + + The interesting exception is in the final clause above. + Where we called error in + , we now call + fail from the Monad + typeclass instead. hunk ./en/ch14-monads.xml 476 + + Mixing pure and monadic code + + Based on the code we've seen so far, monads seem to have a + substantial shortcoming: the type constructor that wraps a + monadic value makes it tricky to use a normal, pure function on + a value trapped inside a monadic wrapper. Here's a simple + illustration of the apparent problem. Let's say we have a + trivial piece of code that runs in the Logger monad + and returns a string. + + &logger.ghci:m; + + If we want to find out the length of that string, we can't + simply call length: the string is wrapped, + so the types don't match up. + + &logger.ghci:m.length; + + What we've done so far to work around this is something like + the following. + + &logger.ghci:m.length2; + + We use &bind; to unwrap the string, then write a small + anonymous function that calls length and + rewraps the result using return. + + This need crops up so often in Haskell code that we won't be + surprised to learn that a shorthand already exists. We reuse + the lifting technique that we introduced + for functors in . Lifting a + pure function into a functor usually involves unwrapping the + value inside the functor, calling the function on it, and + rewrapping the result with the same constructor. + + We do exactly the same thing with a monad. In fact, with a + monad, the job is easier, because the Monad + typeclass already provides unwrapping and rewrapping functions + for us, in the form of &bind; and &return;. + + &Logger.hs:liftM; + + When we declare a type to be an instance of the + Functor typeclass, we have to write our own version + of fmap specially tailored to that type. By + contrast, liftM doesn't need to know + anything of a monad's internals, because they're abstracted by + &bind; and &return;. We only need to write it once, with the + appropriate type constraint. + + The liftM function is predefined for us + in the standard Control.Monad module. + + To see how liftM can help readability, + we'll compare two otherwise identical pieces of code. First, the + familiar kind that does not use + liftM. + + &Logger.hs:charClass_wordy; + + Now we can eliminate the &bind; and anonymous function cruft + with liftM. + + &Logger.hs:charClass; + + As with fmap, we often use + liftM in infix form. An easy way to read + such an expression is apply the pure function on the left + to the result of the monadic action on the + right. + + So useful is liftM that + Control.Monad defines several variants that combine + longer chains of actions. We can see one in the last clause of + our globToRegex' function. + + &Logger.hs:last; + + The liftM2 function that it uses is + defined as follows. + + &Logger.hs:liftM2; + + It executes the first action, then the second, then combines + their results using the pure function f, and + wraps that result. In addition to liftM2, + the variants in Control.Monad go up to + liftM5. + + hunk ./en/ch14-monads.xml 570 - We've now seen enough examples of monads in action to have a - feeling for what's going on. Before we continue, there are a - few oft-repeated myths about monads that we're going to - address. You're bound to encounter these assertions in - the wild, so you might as well be prepared with a few - good retorts. + We've now seen enough examples of monads in action to have + some feel for what's going on. Before we continue, there are a + few oft-repeated myths about monads that we're going to address. + You're bound to encounter these assertions in the + wild, so you might as well be prepared with a few good + retorts. hunk ./en/ch14-monads.xml 579 - Monads are only useful for I/O. - While we use monads for I/O in Haskell, they're valuable for - many other purposes besides. We've already used them for - short-circuiting a chain of computations, hiding complicated - state, and logging. Even so, we've barely scratched the - surface. + Monads are hard to understand. + We've already shown that monads fall out + naturally from several problems. We've found that + the best key to understanding them is to explain several + concrete examples, then talk about what they have in + common. + + + + Monads are only useful for I/O and imperative + coding. While we use monads for I/O in Haskell, + they're valuable for many other purposes besides. We've + already used them for short-circuiting a chain of + computations, hiding complicated state, and logging. Even + so, we've barely scratched the surface. hunk ./en/ch14-monads.xml 602 + + + Monads are for controlling the order of + evaluation. + hunk ./en/ch14-monads.xml 609 + + + Building the Logger monad + + The definition of our Logger type is very + simple. + + &Logger.hs:Logger; + + It's a two-tuple, where the first element is the result of + an action, and the second is a list of messages logged while + that action was run. + + We've wrapped the tuple in a &newtype; to make it a distinct + type. The runLogger function extracts the + tuple from its wrapper. The function that we're exporting to + execute a logged action, execLogger, is + just a synonym for runLogger. + + &Logger.hs:execLogger; + + Our record helper function creates a + singleton list of the message we pass it. The result of this + action is (), so that's the value we put in the + result slot. + + Let's begin our Monad instance with &return;, + which is trivial: it logs nothing, and stores its input in the + return slot of the tuple. + + &Logger.hs:return; + + Slightly more interesting is &bind;, which is the heart of + the monad. It combines an action and a monadic function to give + a new result and a new log. + + &Logger.hs:bind; + + Let's spell out explicitly what is going on. We use + runLogger to extract the result + a from the action m, and + we pass it to the monadic function k. We + extract the result b from that in turn, and + put it into the result slot of the final action. We concatenate + the logs w and x to give + the new log. + + + Sequential logging, not sequential evaluation + + Our definition of &bind; ensures that messages logged on + the left will appear in the new log before those on the right. + However, it says nothing about when the values + a and b are evaluated: + &bind; is lazy. + + Like most other aspects of a monad's behaviour, strictness + is under the control of the monad's implementor, not something + that's shared by all monads. Indeed, some monads come in + multiple flavours, each with different levels of + strictness. + + hunk ./examples/ch14/Logger.hs 11 -import Control.Monad (liftM, liftM2) - hunk ./examples/ch14/Logger.hs 15 +{-- snippet Logger --} hunk ./examples/ch14/Logger.hs 17 - deriving (Show) +{-- /snippet Logger --} hunk ./examples/ch14/Logger.hs 19 +{-- snippet return --} hunk ./examples/ch14/Logger.hs 22 +{-- /snippet return --} +{-- snippet bind --} hunk ./examples/ch14/Logger.hs 25 - (b, x) = runLogger (k a) + n = k a + (b, x) = runLogger n hunk ./examples/ch14/Logger.hs 28 +{-- /snippet bind --} + +{-- snippet stricterBind --} +stricterBind :: Logger a -> (a -> Logger a1) -> Logger a1 +stricterBind m k = + case runLogger m of + (a, w) -> let (b, x) = runLogger (k a) + in Logger (b, w ++ x) +{-- /snippet stricterBind --} hunk ./examples/ch14/Logger.hs 41 -execLogger m = runLogger m +{-- snippet execLogger --} +execLogger = runLogger +{-- /snippet execLogger --} hunk ./examples/ch14/Logger.hs 48 +{-- snippet record --} hunk ./examples/ch14/Logger.hs 50 +{-- /snippet record --} hunk ./examples/ch14/Logger.hs 115 -charClass :: String -> Logger String hunk ./examples/ch14/Logger.hs 117 -charClass [] = fail "unterminated character class" hunk ./examples/ch14/Logger.hs 119 +{-- snippet liftM --} +liftM :: (Monad m) => (a -> b) -> m a -> m b +liftM f m = m >>= \i -> + return (f i) +{-- /snippet liftM --} + +{-- snippet liftM2 --} +liftM2 :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c +liftM2 f m1 m2 = + m1 >>= \a -> + m2 >>= \b -> + return (f a b) +{-- /snippet liftM2 --} + hunk ./examples/ch14/logger.ghci 10 +--# simple +let simple = return True :: Logger Bool +execLogger simple + +--# logged +execLogger (record "hi mom!" >> return 3.1337) + +--# m +let m = return "foo" :: Logger String + +--# m.length +length m + +--# m.length2 +m >>= \s -> return (length s) + }