[Stacking order Bryan O'Sullivan **20080420071546] { addfile ./examples/ch17/MTComposition.hs addfile ./examples/ch17/mtComposition.ghci hunk ./en/ch17-monad-trans.xml 265 - &newtype; (as we will see below). As a result, we will rarely run into - this problem in practice. + &newtype; (as we will see below). As a result, we will rarely + run into this problem in practice. hunk ./en/ch17-monad-trans.xml 410 - For instance, we can create a monad transformer stack in - which instances of the same type class appear at different - levels. + + When explicit lifting is necessary + + One case in which we must use + lift is when we create a monad + transformer stack in which instances of the same type class + appear at multiple levels. + + &StackStack.hs:Foo; hunk ./en/ch17-monad-trans.xml 420 - &StackStack.hs:Foo; + If we try to use MonadState's + put action, StateT Int's + instance of MonadState is the one we get, because + it's at the top of the stack. hunk ./en/ch17-monad-trans.xml 425 - If we try to use MonadState's - put action, StateT Int's - instance of MonadState is the one we get, because - it's at the top of the stack. + &StackStack.hs:outerPut; hunk ./en/ch17-monad-trans.xml 427 - &StackStack.hs:outerPut; + The only way we can access the underlying + State monad's put is through + use of lift. hunk ./en/ch17-monad-trans.xml 431 - To access State's put, we - must use lift. + &StackStack.hs:innerPut; hunk ./en/ch17-monad-trans.xml 433 - &StackStack.hs:innerPut; + Sometimes, we need to access a monad more than one level + down the stack, in which case we must compose calls to + lift. Each composed use of + lift gives us access to one deeper + level. hunk ./en/ch17-monad-trans.xml 439 - Sometimes, we need to access a monad more than one level - down the stack, in which case we must compose calls to - lift. + &StackStack.hs:Bar; hunk ./en/ch17-monad-trans.xml 441 - &StackStack.hs:Bar; + When we need to use lift, it can be + good style to write wrapper functions that do the lifting for + us, as above, and to use those. The alternative of sprinkling + explicit uses of lift throughout our code + tends to look messy. hunk ./en/ch17-monad-trans.xml 447 - When we need lift, it is considered - good style to write wrapper functions that do the lifting for - us, as above, and to use those. The alternative of sprinkling - explicit uses of lift throughout code tends - to look messy. + hunk ./en/ch17-monad-trans.xml 517 - To turn our type into a monad transformer, we must provide - an instance of the MonadTrans class, so that a user - can access the underlying monad. + + Creating a monad transformer hunk ./en/ch17-monad-trans.xml 520 - &MaybeT.hs:MonadTrans; + To turn our type into a monad transformer, we must provide + an instance of the MonadTrans class, so that a + user can access the underlying monad. hunk ./en/ch17-monad-trans.xml 524 - The underlying monad starts out with a type parameter of - a: we inject the Just - constructor so it will acquire the type that we need, - Maybe a. We then hide the monad with our - MaybeT constructor. + &MaybeT.hs:MonadTrans; + + The underlying monad starts out with a type parameter of + a: we inject the Just + constructor so it will acquire the type that we need, + Maybe a. We then hide the monad with our + MaybeT constructor. + + + + More type class instances hunk ./en/ch17-monad-trans.xml 536 - Once we have an instance for MonadTrans - defined, we can use it to define instances for the umpteen other - mtl type classes. + Once we have an instance for MonadTrans + defined, we can use it to define instances for the umpteen + other mtl type classes. hunk ./en/ch17-monad-trans.xml 540 - &MaybeT.hs:mtl; + &MaybeT.hs:mtl; hunk ./en/ch17-monad-trans.xml 542 - Because several of the mtl type classes use - functional dependencies, some of our instance declarations - require us to considerably relax &GHC;'s usual strict type - checking rules. (If we were to forget any of these directives, - the compiler would helpfully advise us which ones we needed in - its error messages.) + Because several of the mtl type classes use + functional dependencies, some of our instance declarations + require us to considerably relax &GHC;'s usual strict type + checking rules. (If we were to forget any of these directives, + the compiler would helpfully advise us which ones we needed in + its error messages.) hunk ./en/ch17-monad-trans.xml 549 - &MaybeT.hs:LANGUAGE; + &MaybeT.hs:LANGUAGE; + + Is it better to use lift explicitly, + or to spend time writing these boilerplate instances? That + depends on what we expect to do with our monad transformer. + If we're going to use it in just a few restricted situations, we + can get away with providing an instance for + MonadTrans alone. A few more instances might + make sense, such as MonadIO. If the transformer + is going to pop up in diverse situations throughout a body of + code, spending a dull hour to write those instances might be a + good investment. + hunk ./en/ch17-monad-trans.xml 608 + + Transformer stacking order is important + + From our early examples using monad transformers like + ReaderT and StateT, it might be easy + to conclude that the order in which we stack monad transformers + doesn't matter. + + When we stack StateT on top of + State, it should be clearer that order can indeed + make a difference. The types StateT Int (State + String) and StateT String (State Int) + might carry around the same information, but we can't use them + interchangeably. The ordering determines when we need to use + lift to get at one or the other piece of + state. + + Here's a case that more dramatically demonstrates the + importance of ordering. Suppose we have a computation that + might fail, and we want to log the circumstances under which it + does so. + + &MTComposition.hs:problem; + + Which of these monad stacks will give us the information we + need? + + &MTComposition.hs:types; + + Let's try the alternatives in &ghci;. + + &mtComposition.ghci:problem; + + This difference in results should not come as a surprise: + just look at the signatures of the execution functions. + + &mtComposition.ghci:runWriterT; + + Our WriterT-on-Maybe stack has + Maybe as the underlying monad, so + runWriterT must give us back a result of + type Maybe. In our test case, we only get to see + the log of what happened if nothing actually went wrong! + + Stacking monad transformers is analogous to composing + functions. We are not surprised when we change the order in + which we apply functions and thus get different results, and so + it is with monad transformers, too. + + + + Putting monads and monad transformers into + perspective + + It's useful to step back from details for a few moments, and + look at the strengths and weaknesses of programming with monads + and monad transformers. + + Probably the biggest irritation of working with monads is + that a monad's type constructor often prevents us from using + pure code. Many useful pure functions need monadic + counterparts. + + &monadProblems.ghci:filter; + + However, the standard libraries don't always provide monadic + versions of pure functions. + + &monadProblems.ghci:zip; + + hunk ./examples/ch17/MTComposition.hs 1 +{-- snippet problem --} +{-# LANGUAGE FlexibleContexts #-} +import Control.Monad.Writer +import MaybeT + +problem :: MonadWriter [String] m => m () +problem = do + tell ["this is where i fail"] + fail "oops" +{-- /snippet problem --} + +{-- snippet types --} +type A = WriterT [String] Maybe + +type B = MaybeT (Writer [String]) + +a :: A () +a = problem + +b :: B () +b = problem +{-- /snippet types --} hunk ./examples/ch17/MaybeT.hs 73 +instance (Monoid w, MonadWriter w m) => MonadWriter w (MaybeT m) where + tell = lift . tell + listen m = MaybeT $ do + (result,log) <- listen (runMaybeT m) + case result of + Nothing -> return Nothing + Just value -> return (Just (value,log)) + pass m = MaybeT $ do + result <- runMaybeT m + case result of + Nothing -> return Nothing + Just (value,log) -> pass (return (Just value,log)) + hunk ./examples/ch17/mtComposition.ghci 1 +:load MTComposition + +--# problem +runWriterT a +runWriter $ runMaybeT b + +--# runWriterT +:t runWriterT +:t runWriter . runMaybeT hunk ./meta/assignments.txt 19 -DONS 17. Monad transformers +BOS 17. Monad transformers (DONE) hunk ./meta/assignments.txt 27 -BOS 24. GUI programming: gtk2hs +JG 24. GUI programming: gtk2hs }