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 together 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:

newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
type MyStack = ErrorT MyError IO

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:

type ErrorTUnwrapped e m a = m (Either e a)

At some point, we’ll need to actually perform some IO inside our MyStack. If we went with the unwrapped approach, it would be trivial, since 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:

class MonadTrans 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 :: ErrorT MyError IO ()
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 -> ErrorT MyError IO ()
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 :: ErrorT MyError IO ()
useMyFileErrorBad = withMyFile sayHiError
    Couldn't match expected type `ErrorT MyError IO ()'
                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,” there wasn’t anything wrong with this action.

Now this intuitively makes sense: since 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, 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 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. The Writer 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’d 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 bi-directional translation, doesn’t it?

Well, not quite. 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 :: ErrorT MyError IO ()
useMyFileError1 =
    let unwrapped :: Handle -> IO (Either MyError ())
        unwrapped handle = runErrorT $ sayHiError handle
        applied :: IO (Either MyError ())
        applied = withMyFile unwrapped
        rewrapped :: ErrorT MyError IO ()
        rewrapped = ErrorT applied
     in rewrapped

This is the crucial point of this whole article, 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. So 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 straight-forward solution in monad-peel. And for efficiency, in monad-control, Bas van Dijk uses CPS (continuation passing style) and existential types.

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:

type Run t = forall n o b. (Monad n, Monad o, Monad (t o)) => t n b -> n (t o b)

That’s incredibly dense, let’s talk it out. The only “input” datatype 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 left hand 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.

Now might be a good time to get a beer.

Alright, now we’re getting somewhere. If we had access to one of those Run functions, we could use it to peel off the ErrorT on our sayHiError function and pass it to withMyFile. With the magic of undefined, we can play such a game:

errorRun :: Run (ErrorT MyError)
errorRun = undefined
useMyFileError2 :: IO (ErrorT MyError Identity ())
useMyFileError2 =
    let afterRun :: Handle -> IO (ErrorT MyError Identity ())
        afterRun handle = errorRun $ sayHiError handle
        applied :: IO (ErrorT MyError Identity ())
        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:

class MonadTrans 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 => ErrorT MyError IO (ErrorT MyError m ())
useMyFileError3 =
    liftControl inside
  where
    inside :: Monad m => Run (ErrorT MyError) -> IO (ErrorT MyError m ())
    inside run = withMyFile $ helper run
    helper :: Monad m
           => Run (ErrorT MyError) -> Handle -> IO (ErrorT MyError m ())
    helper run handle = run (sayHiError handle :: ErrorT MyError IO ())

Close, but not exactly what I had in mind. What’s up with the double monads? Well, let’s start at the end: 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’d 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 applying withMyFile. 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 a ErrorT MyError stuck on the front.

Well, 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 :: ErrorT MyError IO ()
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:

useMyFileError5 :: ErrorT MyError IO ()
useMyFileError5 =
    control inside
  where
    inside :: Monad m => Run (ErrorT MyError) -> IO (ErrorT MyError m ())
    inside run = withMyFile $ helper run
    helper :: Monad m
           => Run (ErrorT MyError) -> Handle -> IO (ErrorT MyError m ())
    helper run handle = run (sayHiError handle :: ErrorT MyError IO ())

And just to make it a little shorter:

useMyFileError6 :: ErrorT MyError IO ()
useMyFileError6 = control $ \run -> withMyFile $ run . sayHiError

MonadControlIO

The MonadTrans class provides the lift method, which allows you to lift an action one level in the stack. There is also the MonadIO class that 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 corrolary to Run:

type RunInBase 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 a value of the entire stack, 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 (ErrorT MyError IO) IO = forall b. ErrorT MyError IO b -> IO (ErrorT MyError IO 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.

class MonadIO m => MonadControlIO m where
    liftControlIO :: (RunInBase m IO -> IO a) -> m a

Simply put, liftControlIO takes a function which 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 :: ErrorT MyError IO ()
useMyFileError7 = controlIO $ \run -> withMyFile $ run . sayHiError

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

sayHiCrazy :: Handle -> ReaderT Int (StateT Double (ErrorT MyError IO)) ()
sayHiCrazy handle = liftIO $ hPutStrLn handle "Madness!"
useMyFileCrazy :: ReaderT Int (StateT Double (ErrorT MyError IO)) ()
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 :: ErrorT MyError IO a
                 -> ErrorT MyError IO b
                 -> ErrorT MyError IO 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 :: (Ptr Double -> ErrorT MyError IO b)
            -> ErrorT MyError IO 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: 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 the answer is that, 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:[quote]

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 -> ErrorT MyError IO () -> ErrorT MyError IO ()
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 -> ErrorT MyError IO (a, b))
           -> ErrorT MyError IO 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