# Developing Web Apps with Haskell and Yesod, Second Edition (2015)

### Part IV. Appendices

### Appendix A. monad-control

monad-control is used in a few places within Yesod, most notably to ensure proper exception handling within Persistent. It is a general-purpose package to extend standard functionality in monad transformers.

**Overview**

One of the powerful, and sometimes confusing, features in Haskell is monad transformers. They allow you to take different pieces of functionality—such as mutable state, error handling, or logging—and compose them easily. Though I swore I’d never write a monad tutorial, I’m going to employ a painful analogy here: monads are like onions. (Monads are *not* like cakes.) By that, I mean *layers*.

We have the core monad, also known as the innermost or bottom monad. On top of this core, we add layers, each adding a new feature and spreading outward/upward. As a motivating example, let’s consider an ErrorT transformer stacked on top of the IO monad:

**newtypeErrorT** e m a **=ErrorT** { runErrorT **::**m (**Either** e a) }

**typeMyStack=ErrorTMyErrorIO**

Now pay close attention here: ErrorT is just a simple newtype around an Either wrapped in a monad. Getting rid of the newtype, we have:

**typeErrorTUnwrapped** e m a **=**m (**Either** e a)

At some point, we’ll need to actually perform some I/O inside our MyStack. If we went with the unwrapped approach, it would be trivial, as there would be no ErrorT constructor in the way. However, we need that newtype wrapper for a whole bunch of type reasons I won’t go into here (this isn’t a monad transformer tutorial, after all). So the solution is the MonadTrans typeclass:

**classMonadTrans** t **where**

lift **::Monad** m **=>**m a **->**t m a

I’ll admit, the first time I saw that type signature my response was stunned confusion, and incredulity that it actually meant anything. But looking at an instance helps a bit:

**instance** (**Error** e) **=>MonadTrans** (**ErrorT** e) **where**

lift m **=ErrorT** $ **do**

a **<-**m

return (**Right** a)

All we’re doing is wrapping the inside of the IO with a Right value, and then applying our newtype wrapper. This allows us to take an action that lives in IO and “lift” it to the outer/upper monad.

But now to the point at hand. This works very well for simple functions. For example:

sayHi **::IO** ()

sayHi **=**putStrLn "Hello"

sayHiError **::ErrorTMyErrorIO** ()

sayHiError **=**lift $ putStrLn "Hello"

But let’s take something slightly more complicated, like a callback:

withMyFile **::** (**Handle->IO** a) **->IO** a

withMyFile **=**withFile "test.txt" **WriteMode**

sayHi **::Handle->IO** ()

sayHi handle **=**hPutStrLn handle "Hi there"

useMyFile **::IO** ()

useMyFile **=**withMyFile sayHi

So far so good, right? Now let’s say that we need a version of sayHi that has access to the Error monad:

sayHiError **::Handle->ErrorTMyErrorIO** ()

sayHiError handle **=do**

lift $ hPutStrLn handle "Hi there, error!"

throwError **MyError**

We would like to write a function that combines withMyFile and sayHiError. Unfortunately, GHC doesn’t like this very much:

useMyFileErrorBad **::ErrorTMyErrorIO** ()

useMyFileErrorBad **=**withMyFile sayHiError

**Couldn't** match expected **type** `**ErrorTMyErrorIO** ()'

with actual **type** `**IO** ()'

Why does this happen, and how can we work around it?

**Intuition**

Let’s try and develop an external intuition of what’s happening here. The ErrorT monad transformer adds extra functionality to the IO monad. We’ve defined a way to “tack on” that extra functionality to normal IO actions: we add that Right constructor and wrap it all in ErrorT. Wrapping in Right is our way of saying “it went OK”; i.e., there wasn’t anything wrong with this action.

Now this intuitively makes sense: because the IO monad doesn’t have the concept of returning a MyError when something goes wrong, it will always succeed in the lifting phase. (Note: This has *nothing* to do with runtime exceptions, so don’t even think about them.) What we have is a guaranteed one-directional translation up the monad stack.

Let’s take another example: the Reader monad. A Reader has access to some extra piece of data that’s floating around. Whatever is running in the inner monad doesn’t know about that extra piece of information. So how would you do a lift? You just ignore that extra information. TheWriter monad? Don’t write anything. State? Don’t change anything. I’m seeing a pattern here.

But now let’s try and go in the opposite direction: I have something in a Reader, and I’d like to run it in the base monad (e.g., IO). Well… that’s not going to work, is it? I need that extra piece of information; I’m relying on it, and it’s not there. There’s simply no way to go in the opposite direction without providing that extra value.

Or is there? If you remember, we pointed out earlier that ErrorT is just a simple wrapper around the inner monad. In other words, if I have errorValue :: ErrorT MyError IO MyValue, I can apply runErrorT and get a value of type IO (Either MyError MyValue). The looks quite a bit like bidirectional translation, doesn’t it?

Well, not exactly. We originally had an ErrorT MyError IO monad, with a value of type MyValue. Now we have a monad of type IO with a value of type Either MyError MyValue. So, this process has in fact changed the value, while the lifting process leaves it the same.

But still, with a little fancy footwork we can unwrap the ErrorT, do some processing, and then wrap it back up again:

useMyFileError1 **::ErrorTMyErrorIO** ()

useMyFileError1 **=**

**let** unwrapped **::Handle->IO** (**EitherMyError** ())

unwrapped handle **=**runErrorT $ sayHiError handle

applied **::IO** (**EitherMyError** ())

applied **=**withMyFile unwrapped

rewrapped **::ErrorTMyErrorIO** ()

rewrapped **=ErrorT** applied

**in** rewrapped

This is the crucial point of this whole discussion, so look closely. We first unwrap our monad. This means that, to the outside world, it’s now just a plain old IO value. Internally, we’ve stored all the information from our ErrorT transformer. Now that we have a plain old IO, we can easily pass it off to withMyFile. withMyFile takes in the internal state and passes it back out unchanged. Finally, we wrap everything back up into our original ErrorT.

This is the entire pattern of monad-control. We embed the extra features of our monad transformer inside the value. Once in the value, the type system ignores it and focuses on the inner monad. When we’re done playing around with that inner monad, we can pull our state back out and reconstruct our original monad stack.

**Types**

I purposely started with the ErrorT transformer, as it is one of the simplest for this inversion mechanism. Unfortunately, others are a bit more complicated. Take, for instance, ReaderT. It is defined as newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }. If we apply runReaderT to it, we get a function that returns a monadic value. We’re going to need some extra machinery to deal with all that stuff. And this is when we leave Kansas behind.

There are a few approaches to solving these problems. In the past, I implemented a solution using type families in the neither package. Anders Kaseorg implemented a much more straightforward solution in monad-peel. And for efficiency, in monad-control, Bas van Dijk uses CPS (continuation passing style) and existential types.

**NOTE**

The code taken from monad-control actually applies to version 0.2. 0.3 changed things just a bit, by making the state explicit with an associated type and generalizing MonadControlIO to MonadBaseControl, but the concepts are still the same.

The first type we’re going to look at is the following:

**typeRun** t **=**forall n o b. (**Monad** n, **Monad** o, **Monad** (t o)) **=>**t n b **->**n (t o b)

That’s incredibly dense, so let’s talk it out. The only “input” data type to this thing is t, a monad transformer. A Run is a function that will then work with *any* combination of types n, o, and b (that’s what the forall means). n and o are both monads, while b is a simple value contained by them.

The lefthand side of the Run function, t n b, is our monad transformer wrapped around the n monad and holding a b value. So, for example, that could be a MyTrans FirstMonad MyValue. It then returns a value with the transformer “popped” inside, with a brand new monad at its core. In other words, FirstMonad (MyTrans NewMonad MyValue).

That might sound pretty scary at first, but it actually isn’t as foreign as you’d think: this is essentially what we did with ErrorT. We started with ErrorT on the outside, wrapping around IO, and ended up with an IO by itself containing an Either. Well guess what: another way to represent an Either is ErrorT MyError Identity. So essentially, we pulled the IO to the outside and plunked an Identity in its place. We’re doing the same thing in a Run—pulling the FirstMonad outside and replacing it with a NewMonad:

errorRun **::Run** (**ErrorTMyError**)

errorRun **=**undefined

useMyFileError2 **::IO** (**ErrorTMyErrorIdentity** ())

useMyFileError2 **=**

**let** afterRun **::Handle->IO** (**ErrorTMyErrorIdentity** ())

afterRun handle **=**errorRun $ sayHiError handle

applied **::IO** (**ErrorTMyErrorIdentity** ())

applied **=**withMyFile afterRun

**in** applied

This looks eerily similar to our previous example. In fact, errorRun is acting almost identically to runErrorT. However, we’re still left with two problems: we don’t know where to get that errorRun value from, and we still need to restructure the original ErrorT after we’re done.

**MonadTransControl**

Obviously, in the specific case we have before us we could use our knowledge of the ErrorT transformer to beat the types into submission and create our Run function manually. But what we *really* want is a general solution for many transformers. At this point, you know we need a typeclass.

So let’s review what we need: access to a Run function, and some way to restructure our original transformer after the fact. And thus was born MonadTransControl, with its single method liftControl:

**classMonadTrans** t **=>MonadTransControl** t **where**

liftControl **::Monad** m **=>** (**Run** t **->**m a) **->**t m a

Let’s look at this closely. liftControl takes a function (the one we’ll be writing). That function is provided with a Run function, and must return a value in some monad (m). liftControl will then take the result of that function and reinstate the original transformer on top of everything:

useMyFileError3 **::Monad** m **=>ErrorTMyErrorIO** (**ErrorTMyError** m ())

useMyFileError3 **=**

liftControl inside

**where**

inside **::Monad** m **=>Run** (**ErrorTMyError**) **->IO** (**ErrorTMyError** m ())

inside run **=**withMyFile $ helper run

helper **::Monad** m

**=>Run** (**ErrorTMyError**) **->Handle->IO** (**ErrorTMyError** m ())

helper run handle **=**run (sayHiError handle **::ErrorTMyErrorIO** ())

Close, but not exactly what I had in mind. What’s up with the double monads? Well, let’s start at the end. The sayHiError handle returns a value of type ErrorT MyError IO (). This we knew already; no surprises. What might be a little surprising (it got me, at least) is the next two steps.

First, we apply run to that value. Like we discussed before, the result is that the IO inner monad is popped to the outside, to be replaced by some arbitrary monad (represented by m here). So we end up with an IO (ErrorT MyError m ()). OK… we then get the same result after applyingwithMyFile. Not surprising.

The last step took me a long time to understand correctly. Remember how we said that we reconstruct the original transformer? Well, so we do: by plopping it right on top of everything else we have. So our end result is the previous type—IO (ErrorT MyError m ())—with an ErrorT MyError stuck on the front.

That seems just about utterly worthless, right? Well, almost. But don’t forget, that m can be any monad, including IO. If we treat it that way, we get ErrorT MyError IO (ErrorT MyError IO ()). That looks a lot like m (m a), and we want just plain old m a. Fortunately, now we’re in luck:

useMyFileError4 **::ErrorTMyErrorIO** ()

useMyFileError4 **=**join useMyFileError3

And it turns out that this usage is so common, that Bas had mercy on us and defined a helper function:

control **::** (**Monad** m, **Monad** (t m), **MonadTransControl** t)

**=>** (**Run** t **->**m (t m a)) **->**t m a

control **=**join . liftControl

So all we need to write is the following:

useMyFileError5 **::ErrorTMyErrorIO** ()

useMyFileError5 **=**

control inside

**where**

inside **::Monad** m **=>Run** (**ErrorTMyError**) **->IO** (**ErrorTMyError** m ())

inside run **=**withMyFile $ helper run

helper **::Monad** m

**=>Run** (**ErrorTMyError**) **->Handle->IO** (**ErrorTMyError** m ())

helper run handle **=**run (sayHiError handle **::ErrorTMyErrorIO** ())

And just to make it a little shorter:

useMyFileError6 **::ErrorTMyErrorIO** ()

useMyFileError6 **=**control $ \run **->**withMyFile $ run . sayHiError

**MonadControlIO**

The MonadTrans class provides the lift method, which allows us to lift an action one level in the stack. There is also the MonadIO class: this provides liftIO, which lifts an IO action as far in the stack as desired. We have the same breakdown in monad-control. But first, we need a corollary to Run:

**typeRunInBase** m base **=**forall b. m b **->**base (m b)

Instead of dealing with a transformer, we’re dealing with two monads. base is the underlying monad, and m is a stack built on top of it. RunInBase is a function that takes the entire stack as a value, pops out that base, and puts in on the outside. Unlike in the Run type, we don’t replace it with an arbitrary monad, but with the original one. To use some more concrete types:

**RunInBase** (**ErrorTMyErrorIO**) **IO=**forall b. **ErrorTMyErrorIO** b

**->IO** (**ErrorTMyErrorIO** b)

This should look fairly similar to what we’ve been looking at so far; the only difference is that we want to deal with a specific inner monad. Our MonadControlIO class is really just an extension of MonadControlTrans using this RunInBase:

**classMonadIO** m **=>MonadControlIO** m **where**

liftControlIO **::** (**RunInBase** m **IO->IO** a) **->**m a

Simply put, liftControlIO takes a function that receives a RunInBase. That RunInBase can be used to strip down our monad to just an IO, and then liftControlIO builds everything back up again. And like MonadControlTrans, it comes with a helper function:

controlIO **::MonadControlIO** m **=>** (**RunInBase** m **IO->IO** (m a)) **->**m a

controlIO **=**join . liftControlIO

We can easily rewrite our previous example with it:

useMyFileError7 **::ErrorTMyErrorIO** ()

useMyFileError7 **=**controlIO $ \run **->**withMyFile $ run . sayHiError

And as an advantage, it easily scales to multiple transformers:

sayHiCrazy **::Handle->ReaderTInt** (**StateTDouble** (**ErrorTMyErrorIO**)) ()

sayHiCrazy handle **=**liftIO $ hPutStrLn handle "Madness!"

useMyFileCrazy **::ReaderTInt** (**StateTDouble** (**ErrorTMyErrorIO**)) ()

useMyFileCrazy **=**controlIO $ \run **->**withMyFile $ run . sayHiCrazy

**Real-Life Examples**

Let’s solve some real-life problems with this code. Probably the biggest motivating use case is exception handling in a transformer stack. For example, let’s say that we want to automatically run some cleanup code when an exception is thrown. If this were normal IO code, we’d use:

onException **::** **IO** a **->** **IO** b **->** **IO** a

But if we’re in the ErrorT monad, we can’t pass in either the action or the cleanup. In comes controlIO to the rescue:

onExceptionError **::ErrorTMyErrorIO** a

**->ErrorTMyErrorIO** b

**->ErrorTMyErrorIO** a

onExceptionError action after **=**controlIO $ \run **->**

run action `onException` run after

Let’s say we need to allocate some memory to store a Double in. In the IO monad, we could just use the alloca function. Once again, our solution is simple:

allocaError **::** (**PtrDouble->ErrorTMyErrorIO** b)

**->ErrorTMyErrorIO** b

allocaError f **=**controlIO $ \run **->**alloca $ run . f

**Lost State**

Let’s rewind a bit to our onExceptionError. It uses onException under the surface, which has a type signature of IO a -> IO b -> IO a. Let me ask you something: what happened to the b in the output? Well, it was thoroughly ignored. But that seems to cause us a bit of a problem. After all, we store our transformer state information in the value of the inner monad. If we ignore it, we’re essentially ignoring the monadic side effects as well!

And yes, this does happen with monad-control. Certain functions will drop some of the monadic side effects. This is put best by Bas, in the comments on the relevant functions:

*Note, any monadic side effects in **m** of the “release” computation will be discarded; it is run only for its side effects in **IO**.*

In practice, monad-control will usually be doing the right thing for you, but you need to be aware that some side effects may disappear.

**More Complicated Cases**

In order to make our tricks work so far, we’ve needed to have functions that give us full access to play around with their values. Sometimes, this isn’t the case. Take, for instance:

addMVarFinalizer **::** **MVar** a **->** **IO** () **->** **IO** ()

In this case, we are required to have no value inside our finalizer function. Intuitively, the first thing we should notice is that there will be no way to capture our monadic side effects. So how do we get something like this to compile? Well, we need to explicitly tell it to drop all of its state-holding information:

addMVarFinalizerError **::MVar** a **->ErrorTMyErrorIO** () **->ErrorTMyErrorIO** ()

addMVarFinalizerError mvar f **=**controlIO $ \run **->**

return $ liftIO $ addMVarFinalizer mvar (run f >> return ())

Another case from the same module is:

modifyMVar **::** **MVar** a **->** (a **->** **IO** (a, b)) **->** **IO** b

Here, we have a restriction on the return type in the second argument: it must be a tuple of the value passed to that function and the final return value. Unfortunately, I can’t see a way of writing a little wrapper around modifyMVar to make it work for ErrorT. Instead, in this case, I copied the definition of modifyMVar and modified it:

modifyMVar **::MVar** a

**->** (a **->ErrorTMyErrorIO** (a, b))

**->ErrorTMyErrorIO** b

modifyMVar m io **=**

**Control**.**Exception**.**Control**.mask $ \restore **->do**

a **<-** liftIO $ takeMVar m

(a',b) **<-**restore (io a) `onExceptionError` liftIO (putMVar m a)

liftIO $ putMVar m a'

return b