[WIP ch17 Bryan O'Sullivan **20080415072039] { addfile ./examples/ch17/monadReader.ghci addfile ./examples/ch17/CountEntries.hs addfile ./examples/ch17/countEntries.ghci hunk ./en/ch17-monad-trans.xml 6 - Monads provide a powerful way to build computations with - effects. Each of the standard monads is specialised to do exactly - one thing. Quite often, this does not fit our real world - needs. + + Motivation: boilerplate avoidance hunk ./en/ch17-monad-trans.xml 9 - Recall the Parse type that we developed in + Monads provide a powerful way to build computations with + effects. Each of the standard monads is specialised to do + exactly one thing. Quite often, this does not fit our real + world needs. + + Recall the Parse type that we developed in hunk ./en/ch17-monad-trans.xml 16 - mentioned that this type was a state monad in disguise. However, - it's a little more complex than the standard State - monad, because it uses the Either type to allow the - possibility of a parsing failure. If a parse fails early on, we - want to stop parsing, not continue in some broken state. + mentioned that this type was a state monad in disguise. In fact, + it's a little more complex than the standard State + monad, because it uses the Either type to allow the + possibility of a parsing failure. If a parse fails early on, we + want to stop parsing, not continue in some broken state. + + The normal State monad doesn't let us exit + early in this way. It uses the default implementation of + fail: this calls + error, which throws an exception that we + can't catch in pure code. The State monad thus + appears to allow for failure, without + actually being any use. (Once again, we recommend that you + almost always avoid using fail!) + + Obviously, it would be ideal if we could somehow take the + standard State monad and add failure handling to + it, without resorting to the wholesale construction of custom + monads by hand. The standard monads in the mtl + library don't allow us to combine them. Instead, the library + provides a set of monad + transformersThe name + mtl stands for monad transformer + library. to achieve the same + result. + + A monad transformer is similar to a regular monad, but it's + not a standalone entity: instead, it modifies the behaviour of + an underlying monad. Most of the monads in the mtl + library have transformer equivalents. By convention, the + transformer version of a monad has the same name, with a + T stuck on the end. For example, the transformer + equivalent of State is StateT; it adds + mutable state to an underlying monad. The WriterT + monad transformer makes it possible to write data when stacked + on top of another monad. + + + + A simple monad transformer example + + This function recurses into a directory tree, and returns a + list of the number of entries it finds at each level of the + tree. + + &CountEntries.hs:countEntriesTrad; + + Conceptually, we might expect this function to list a + directory, add an entry to the result list for that directory, + then recurse into subdirectories. Instead, we have a somewhat + awkward structure, because we can only return a result from one + place: the function's exit point. + + The Writer monad could solve this structural + problem for us. Since it lets us record a value wherever we + need to, we can keep our two logically related activities + (listing a directory, recording the data for it) closer + together, and worry about recursing deeper into the tree + afterwards. + + As our function executes in the IO monad, we + can't use the Writer monad directly. Instead, we + use WriterT to add the recording capability to + IO. To do this, we have to understand the types + involved. + + The normal Writer monad has two parameters, so + it's more properly written Writer w a. The type + parameter w is the type of the + values to be recorded, while a is + the usual type that the Monad type class requires. + Thus Writer [(FilePath, Int)] is a writer monad + that records a list of directory sizes. + + The WriterT transformer has a similar type, but + adds another type parameter, m, + which is the underlying monad whose behaviour we are augmenting. + The full type of WriterT is WriterT w m + a. + + Here, we'll need to stack our writer on top of the + IO monad to traverse directories. Our combination + of monad transformer and underlying monad will thus have the + type WriterT [(FilePath, Int)] IO a. + + &CountEntries.hs:countEntries; + + This code is not terribly different from our earlier + version. We use liftIO to expose the + IO monad where necessary, and + tell to record the visit to the + directory. + + To invoke this action, we must use one of + WriterT's execution functions. + + &countEntries.ghci:runWriterT; + + These functions execute the action, then remove the + WriterT wrapper and give a result that is wrapped + in the underlying monad. The runWriterT + function gives both the result of the action and whatever was + recorded as it ran, while execWriterT + throws away the result and just gives us what was + recorded. + + &countEntries.ghci:countEntries; + + + + + Common patterns in monads and monad transformers + + Most of the monads and monad transformers in the + mtl library follow a few common patterns around + naming and type classes. It's helpful to know these rules of + thumb, because they are both useful and few in number. + + Rather than speak in general terms, we'll focus on a single, + simple monad: the reader monad. This provides a piece of + immutable, implicit state. It's often used to carry around + static information, where we don't want to be burdened with the + bother of passing it around as an explicit parameter. A common + example of this would be the parsed contents of a program's + configuration file. + + The reader monad's interface is specified by the + MonadReader type class. + + &monadReader.ghci:class; + + The type variable r + represents the immutable state that the reader monad carries + around. The Reader r monad is an instance of this + type class, as is the ReaderT r m monad + transformer. hunk ./en/ch17-monad-trans.xml 153 - Even if we were to recast Parse as an instance of - the Monad type class, we can't simply drop it and use - State instead. The State monad uses the - default implementation of fail: this calls - error, which throws an exception that we - can't catch in pure code. The State monad thus - appears to allow for failure, without - actually being any use. Once again, we recommend that you almost - always avoid using fail. + If the underlying monad m is + an instance of MonadIO, so is ReaderT r + m. This also holds for several other common type + classes, notably MonadPlus and + Functor. + hunk ./en/ch17-monad-trans.xml 160 - There is no joy in the prospect of having to hand-craft a new - monad every time we want behaviour that differs slightly from that - provided by some standard monad. Fortunately, we can - combine monads by layering them: for example, - we can take the standard State monad, and add the - possibility of failure to it. + + Stacking multiple monad transformers hunk ./en/ch17-monad-trans.xml 163 - We call one of these layering monads a monad - transfomer, because it modifies the behaviour of an - underlying monad. This finally gives us an explanation of the - name of the standard mtl library, where most of the - standard monads are defined: it's the monad transformer library. - It defines both normal monads and transformer versions of most of - them. + Because a monad transformer stacked ... + hunk ./examples/ch17/CountEntries.hs 1 +{-- snippet countEntriesTrad --} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.FilePath (()) +import Control.Monad (forM_, liftM) +import Control.Monad.Writer + +listDirectory :: FilePath -> IO [String] +listDirectory = liftM (filter notDots) . getDirectoryContents + where notDots p = p /= "." && p /= ".." + +countEntriesTrad :: FilePath -> IO [(FilePath, Int)] +countEntriesTrad path = do + contents <- listDirectory path + rest <- forM contents $ \name -> do + let newName = path name + isDir <- liftIO $ doesDirectoryExist newName + if isDir + then countEntriesTrad newName + else return [] + return $ (path, length contents) : concat rest +{-- /snippet countEntriesTrad --} + +newtype Traversal a = Traversal { + runT :: WriterT [(FilePath, Int)] IO a + } deriving (Monad, MonadWriter [(FilePath, Int)], MonadIO) + +runTraversal = runWriterT . runT + +countEntriesT :: FilePath -> Traversal () +countEntriesT path = do + contents <- liftIO . listDirectory $ path + tell [(path, length contents)] + forM_ contents $ \name -> do + let newName = path name + isDir <- liftIO $ doesDirectoryExist newName + when isDir $ countEntriesT newName + +{-- snippet countEntries --} +countEntries :: FilePath -> WriterT [(FilePath, Int)] IO () +countEntries path = do + contents <- liftIO . listDirectory $ path + tell [(path, length contents)] + forM_ contents $ \name -> do + let newName = path name + isDir <- liftIO $ doesDirectoryExist newName + when isDir $ countEntries newName +{-- /snippet countEntries --} hunk ./examples/ch17/countEntries.ghci 1 +:load CountEntries + +--# runWriterT +:type runWriterT +:type execWriterT + +--# countEntries +:type countEntries ".." +:type execWriterT (countEntries "..") +take 4 `liftM` execWriterT (countEntries "..") hunk ./examples/ch17/monadReader.ghci 1 +--# class +:m +Control.Monad.Reader +:info MonadReader rmdir ./examples/ch18a }