[More monad progress. Bryan O'Sullivan **20071216092011] { addfile ./examples/ch14/Logger.hs addfile ./examples/ch14/logger.ghci hunk ./en/ch14-monads.xml 27 - tool to help solve a problem. + tool to help solve a problem. We'll define a few monads in this + chapter, to show how easy it is. hunk ./en/ch14-monads.xml 184 - ubiquitous in Haskell code precisely because they are so - simple and impose so few rules on how they're used. + ubiquitous in Haskell code precisely because they are so simple: + many common programming patterns have a monadic structure. hunk ./en/ch14-monads.xml 193 - Monad typeclass is a standard part of the - Prelude. + standard Prelude already defines just such a typeclass, named + Monad. hunk ./en/ch14-monads.xml 198 - Here, &bind; is the chaining function. We've already been + Here, &bind; is our chaining function. We've already been hunk ./en/ch14-monads.xml 215 - functions. The first is &bind_;, which performs chaining, but - ignores whatever was wrapeyped up on the left. + functions. The first is &bind_;. Like &bind;, it performs + chaining, but it ignores the value on the left. hunk ./en/ch14-monads.xml 220 - As shown above, the default implementation for &bind_; is in - terms of &bind;. + 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;. hunk ./en/ch14-monads.xml 241 + + To revisit the parser that we developed in , here is its Monad + instance. + + &Parse.hs:Monad; + + + + + Building a monad: show your work! + + In our introduction to monads, we showed how some + pre-existing code was already monadic in form. Now that we are + beginning to grasp what a monad is, and we've seen the + Monad typeclass, let's build a monad with + foreknowledge of what we're doing. + + Pure Haskell code is wonderfully clean to write, but of + course it can't perform I/O. Sometimes, though, we'd like to + have a record of decisions we took. Let's develop a small + library to help with this. + + Recall the globToRegex function that we + 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. + + &Logger.hs:globToRegex.type; + + Before we get into the details of the Logger + monad, we'll show how we use it. + + + Information hiding + + We'll intentionally keep the internals of the + Logger module abstract, and provide our users + with a simple interface. + + &Logger.hs:module; + + Hiding the details like this grants us considerable + flexibility in how we implement our monad. + + The Logger type is purely a + type constructor. We don't export the + value constructor that a user would need + to create a value of this type. All they can do is write type + signatures. + + The Log type is just a synonym, to make a few + signatures more readable. + + &Logger.hs:Log; + + 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. + + &Logger.hs:execLogger.type; + + 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. + + When executing inside a Logger action, user + code calls record to record + something. + + &Logger.hs:record.type; + + Again, most monads provide helper functions that add + functionality on top of the base Monad + typeclass. + + Our module also defines the Monad instance + for the Logger type. These definitions are all + that a client module needs in order to be able to use this + monad. + + + + Using the Logger monad + + Here's how we kick off our glob-to-regexp conversion + inside the Logger monad. + + &Logger.hs:rooted; + + Remember the type of &bind;; it extracts the value on the + left from its Logger wrapper, and passes the + unwrapped value to the function on the right. The function on + the right must, in turn, wrap its result + with the Logger wrapper. This is exactly what + &return; does. + + &logger.ghci:bind.type; + + There are a few coding style issues worth mentioning here. + The body of the function starts on the line after its name. By + doing this, we gain some horizontal white space. We've also + hung the parameter of the anonymous function at + the end of the line. This is common practice in monadic + code. + + Even when we write a function that does almost nothing, we + must call return to wrap the result with + the correct type. + + &Logger.hs:eof; + + When we call record to save a log + entry, we use &bind_; instead of &bind; to chain it with the + following action. + + &Logger.hs:question; + + Recall that this is a variant of &bind; that ignores the + result on the left. We know that the result of + record will always be (), so + there's no point in capturing it. + + We can use &do; notation, which we first encountered in + , to somewhat tidy up our + code. + + &Logger.hs:asterisk; + + The choice of &do; notation versus explicit &bind; with + anonymous functions is mostly a matter of taste. There is one + significant difference between the two, though, which we'll + return to in . + + huh? + + + + + Putting a few misconceptions to rest + + 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. + + + + 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 unique to Haskell. + Haskell is probably the language that makes the most + explicit use of monads, but people write them in other + languages, too, ranging from C++ to OCaml. + + + + + + Desugaring of do blocks + Blorp. hunk ./examples/ch14/Logger.hs 1 +{-- snippet module --} +module Logger + ( + Logger + , Log + , execLogger + , record + ) where +{-- /snippet module --} + +import Control.Monad (liftM, liftM2) + +{-- snippet Log --} +type Log = [String] +{-- /snippet Log --} + +newtype Logger a = Logger { runLogger :: (a, Log) } + deriving (Show) + +instance Monad Logger where + return a = Logger (a, []) + m >>= k = let (a, w) = runLogger m + (b, x) = runLogger (k a) + in Logger (b, w ++ x) + +{-- snippet execLogger.type --} +execLogger :: Logger a -> (a, Log) +{-- /snippet execLogger.type --} +execLogger m = runLogger m + +{-- snippet record.type --} +record :: String -> Logger () +{-- /snippet record.type --} +record s = Logger ((), [s]) + +{-- snippet globToRegex.type --} +globToRegex :: String -> Logger String +{-- /snippet globToRegex.type --} + +{-- snippet rooted --} +globToRegex cs = + globToRegex' cs >>= \ds -> + return ('^':ds) +{-- /snippet rooted --} + +{-- snippet eof --} +globToRegex' :: String -> Logger String +globToRegex' "" = return "$" +{-- /snippet eof --} + +{-- snippet question --} +globToRegex' ('?':cs) = + record "any" >> + globToRegex' cs >>= \ds -> + return ('.':ds) +{-- /snippet question --} + +{-- snippet asterisk --} +globToRegex' ('*':cs) = do + record "kleene star" + ds <- globToRegex' cs + return (".*" ++ ds) +{-- /snippet asterisk --} + +{-- snippet class --} +globToRegex' ('[':'!':c:cs) = + record "character class, negative" >> + charClass cs >>= \ds -> + return ("[^" ++ c : ds) +globToRegex' ('[':c:cs) = + record "character class" >> + charClass cs >>= \ds -> + return ("[" ++ c : ds) +globToRegex' ('[':_) = + fail "unterminated character class" +{-- /snippet class --} +{-- snippet last --} +globToRegex' (c:cs) = liftM2 (++) (escape c) (globToRegex' cs) +{-- /snippet last --} + +{-- snippet escape --} +escape :: Char -> Logger String +escape c + | c `elem` regexChars = record "escape" >> return ('\\' : [c]) + | otherwise = return [c] + where regexChars = "\\+()^$.{}]|" +{-- /snippet escape --} + +{-- snippet charClass_wordy --} +charClass_wordy (']':cs) = + globToRegex' cs >>= \ds -> + return (']':ds) +charClass_wordy (c:cs) = + charClass_wordy cs >>= \ds -> + return (c:ds) +{-- /snippet charClass_wordy --} + +{-- snippet charClass --} +charClass :: String -> Logger String +charClass (']':cs) = (']':) `liftM` globToRegex' cs +charClass (c:cs) = (c:) `liftM` charClass cs +charClass [] = fail "unterminated character class" +{-- /snippet charClass --} hunk ./examples/ch14/logger.ghci 1 +:load Logger + +--# firstExample +execLogger (globToRegex "foo*.[ch]") + +--# bind.type +:type (>>=) +:type (globToRegex "" >>=) }