Written by Michael Snoyman | 6/27/17 3:52 AM

This is a debugging story told completely out of order. In order to understand the ultimate bug, why it seemed to occur arbitrarily, and the ultimate resolution, there's lots of backstory to cover. If you're already deeply familiar with the inner workings of the monad-control package, you can probably look at a demonstration of the bad instance and move on. Otherwise, prepare for a fun ride!

As usual, if you want to play along, we're going to be using Stack's
script interpreter feature. Just
save the snippets contents to a file and run with ```
stack
filename.hs
```

. (It works with any snippet that begins with
`#!/usr/bin/env stack`

.)

Oh, and also: the confusion that this blog post demonstrates is one of the reasons why I strongly recommend sticking to a `ReaderT env IO`

monad transformer stack.

Let's start with some broken code (my favorite kind). It uses the
`StateT`

transformer and a function which may throw a runtime
exception.

#!/usr/bin/env stack -- stack --resolver lts-8.12 script import Control.Monad.State.Strict import Control.Exception import Data.Typeable data OddException = OddException !Int -- great name :) deriving (Show, Typeable) instance Exception OddException mayThrow :: StateT Int IO Int mayThrow = do x <- get if odd x then lift $ throwIO $ OddException x else do put $! x + 1 return $ x `div` 2 main :: IO () main = runStateT (replicateM 2 mayThrow) 0 >>= print

Our problem is that we'd like to be able to recover from a thrown
exception. Easy enough we think, we'll just use
`Control.Exception.try`

to attempt to run the `mayThrow`

action. Unfortunately, if I wrap up `mayThrow`

with a `try`

, I get
this highly informative error message:

```
Main.hs:21:19: error:
• Couldn't match type ‘IO’ with ‘StateT Integer IO’
Expected type: StateT Integer IO ()
Actual type: IO ()
• In the first argument of ‘runStateT’, namely
‘(replicateM 2 (try mayThrow))’
In the first argument of ‘(>>=)’, namely
‘runStateT (replicateM 2 (try mayThrow)) 0’
In the expression:
runStateT (replicateM 2 (try mayThrow)) 0 >>= print
```

Oh, that makes sense: `try`

is specialized to `IO`

, and our function
is `StateT Int IO`

. Our first instinct is probably to keep throwing
`lift`

calls into our program until it compiles, since `lift`

seems to
always fix monad transformer compilation errors. However, try as you
might, you'll never succeed. To understand why, let's look at the
(slightly specialized) type signature for `try`

:

try :: IO a -> IO (Either OddException a)

If I apply `lift`

to this, I could end up with:

try :: IO a -> StateT Int IO (Either OddException a)

But there's no way to use `lift`

to modify the type of the `IO a`

input. This is generally the case with the `lift`

and `liftIO`

functions: they can deal with monad values that are the *output* of a
function, but not the *input* to the function. (More precisely: the
functions are covariant and work on values in positive positions. We'd
need something contravariant to work on vlaues in negative
positions. You can
read more on this nomenclature
in another blog post.)

Huh, I guess we're stuck. But then I remember that `StateT`

is just
defined as ```
newtype StateT s m a = StateT { runStateT :: s -> m
(a,s)}
```

. So maybe I can write a version of `try`

that works for a
`StateT`

using the internals of the type.

tryStateT :: StateT Int IO a -> StateT Int IO (Either OddException a) tryStateT (StateT f) = StateT $ \s0 -> do eres <- try (f s0) return $ case eres of Left e -> (Left e, s0) Right (a, s1) -> (Right a, s1)

Go ahead and plug that into our previous example, and you should get the desired output:

`([Right 0,Left (OddException 1)],1)`

Let's break down in nauseating detail what that `tryStateT`

function
did:

- Unwrap the
`StateT`

data constructor from the provided action to get a function`f :: Int -> IO (a, Int)`

- Construct a new
`StateT`

value on the right hand side by using the`StateT`

data constructor, and capturing the initial state in the value`s0 :: Int`

. - Pass
`s0`

to`f`

to get an action`IO :: (a, Int)`

, which will give the result and the new, updated state. - Wrap
`f s0`

with`try`

to allow us to detect and recover from a runtime exception. `eres`

has type`Either OddException (a, Int)`

, and we pattern match on it.- If we receive a
`Right`

/success value, we simply wrap up the`a`

value in a`Right`

constructor together with the updated state. - If we receive a
`Left`

/exception value, we wrap it up the exception with a`Left`

. However, we need to return*some*new state. Since we have no such state available to us from the action, we return the only thing we can: the initial`s0`

state value.

**Lesson learned** We can use `try`

in a `StateT`

with some
difficulty, but we need to be aware of what happens to our monadic
state.

It turns out that it's trivial to implement the `try`

function in
terms of `catch`

, and the `catch`

function in terms of `try`

, at least
when sticking to the `IO`

-specialized versions:

try' :: Exception e => IO a -> IO (Either e a) try' action = (Right <$> action) `catch` (return . Left) catch' :: Exception e => IO a -> (e -> IO a) -> IO a catch' action onExc = do eres <- try action case eres of Left e -> onExc e Right a -> return a

It turns out that by just changing the type signatures and replacing
`try`

with `tryStateT`

, we can do the same thing for `StateT`

:

catchStateT :: Exception e => StateT Int IO a -> (e -> StateT Int IO a) -> StateT Int IO a catchStateT action onExc = do eres <- tryStateT action case eres of Left e -> onExc e Right a -> return a

**NOTE** Pay close attention to that type signature, and think about
how monadic state is being shuttled through this function.

Well, if we can implement `catchStateT`

in terms of `tryStateT`

,
surely we can implement it directly as well. Let's do the most
straightforward thing I can think of (or at least the thing that
continues my narrative here):

catchStateT :: Exception e => StateT Int IO a -> (e -> IO a) -> StateT Int IO a catchStateT (StateT action) onExc = StateT $ \s0 -> action s0 `catch` \e -> do a <- onExc e return (a, s0)

Here, we're basing our implementation on top of the `catch`

function
instead of the `try`

function. We do the same unwrap-the-StateT,
capture-the-s0 trick we did before. Now, in the lambda we've created
for the `catch`

call, we pass the `e`

exception value to the
user-supplied `onExc`

function, and then like `tryStateT`

wrap up the
result in a tuple with the initial `s0`

.

Who noticed the difference in type signature? Instead of ```
e -> StateT
Int IO a
```

, our `onExc`

handler has type `e -> IO a`

. I told you to pay
attention to how the monadic states were being shuttled around; let's
analyze it:

- In the first function, we use
`tryStateT`

, which as we mentioned will reconstitute the original`s0`

state when it returns. If the action succeeded, nothing else happens. But in the exception case, that original`s0`

is now passed into the`onExc`

function, and the final monadic state returned will be the result of the`onExc`

function. - In the second function, we never give the
`onExc`

function a chance to play with monadic state, since it just lives in`IO`

. So we always return the original state at the end if an exception occurred.

Which behavior is best? I think most people would argue that the first
function is better: it's more general in allowing `onExc`

to access
and modify the monadic state, and there's not really any chance for
confusion. Fair enough, I'll buy that argument (that I just made on
behalf of all of my readers).

**Bonus exercise** Modify this implementation of `catchStateT`

to have
the same type signature as the original one.

This is fun, let's keep reimplementing functions from
`Control.Exception`

! This time, let's do `finally`

, which will ensure
that some action (usually a cleanup action) is run after an initial
action, regardless of whether an exception was thrown.

finallyStateT :: StateT Int IO a -> IO b -> StateT Int IO a finallyStateT (StateT action) cleanup = StateT $ \s0 -> action s0 `finally` cleanup

That was really easy. Ehh, but one problem: look at that type
signature! We just agreed (or I agreed for you) that in the case of
`catch`

, it was better to have the second argument *also* live in
`StateT Int IO`

. Here, our argument lives in `IO`

. Let's fix that:

finallyStateT :: StateT Int IO a -> StateT Int IO b -> StateT Int IO a finallyStateT (StateT action) (StateT cleanup) = StateT $ \s0 -> action s0 `finally` cleanup s0

Huh, also pretty simple. Let's analyze the monadic state behavior
here: our cleanup action is given the initial state, regardless of the
result of `action s0`

. That means that, even if the action succeeded,
we'll ignore the updated state. Furthermore, because `finally`

ignores
the result of the second argument, we will ignore any updated monadic
state. Want to see what I mean? Try this out:

#!/usr/bin/env stack -- stack --resolver lts-8.12 script import Control.Exception import Control.Monad.State.Strict finallyStateT :: StateT Int IO a -> StateT Int IO b -> StateT Int IO a finallyStateT (StateT action) (StateT cleanup) = StateT $ \s0 -> action s0 `finally` cleanup s0 action :: StateT Int IO () action = modify (+ 1) cleanup :: StateT Int IO () cleanup = do get >>= lift . print modify (+ 2) main :: IO () main = execStateT (action `finallyStateT` cleanup) 0 >>= print

You may expect the output of this to be the numbers 1 and 3, but in
fact the output is 0 and 1: `cleanup`

looks at the initial state value
of 0, and its `+ 2`

modification is thrown away. So can we implement a
version of our function that keeps the state? Sure (slightly
simplified to avoid async exception/mask noise):

finallyStateT :: StateT Int IO a -> StateT Int IO b -> StateT Int IO a finallyStateT (StateT action) (StateT cleanup) = StateT $ \s0 -> do (a, s1) <- action s0 `onException` cleanup s0 (_b, s2) <- cleanup s1 return (a, s2)

This has the expected output of 1 and 3. Looking at how it works: we
follow our same tricks, and pass in `s0`

to `action`

. If an exception
is thrown there, we once again pass in `s0`

to `cleanup`

and ignore
its updated state (since we have no choice). However, in the success
case, we now pass in the *updated* state (`s1`

) to `cleanup`

. And
finally, our resulting state is the result of `cleanup`

(`s2`

) instead
of the `s1`

produced by `action`

.

We have three different implementations of `finallyStateT`

and two
different type signatures. Let's compare them:

- The first one (the
`IO`

version) has the advantage that its type tells us*exactly*what's happening: the cleanup has no access to the state at all. However, you can argue like we did with`catchStateT`

that this is limiting and not what people would expect the type signature to be. - The second one (use the initial state for
`cleanup`

and then throw away its modified state) has the advantage that it's logically consistent: whether`cleanup`

is called from a success or exception code path, it does the exact same thing. On the other hand, you can argue that it is surprising behavior that state updates that*can*be preserved are being thrown away. - The third one (keep the state) has the reversed arguments of the second one.

So unlike `catchStateT`

, I would argue that there's not nearly as
clear a winner with `finallyStateT`

. Each approach has its relative
merits.

One final point that seems almost not worth mentioning (hint: epic
foreshadowment incoming). The first version (`IO`

specialized) has an
additional benefit of being ever-so-slightly more efficient than the
other two, since it doesn't need to deal with the additional monadic
state in `cleanup`

. With a simple monad transformer like `StateT`

this
performance difference is hardly even worth thinking about. However,
if we were in a tight inner loop, and our monad stack was
significantly more complicated, you could imagine a case where the
performance difference was significant.

It's great that we understand `StateT`

so well, but can we do anything
for other transformers? It turns out that, yes, we can for many
transformers. (An exception is continuation-based transformers, which
you can read a bit about in passing in
my ResourceT blog post from last week.)
Let's look at a few other examples of `finally`

:

import Control.Exception import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.Except import Data.Monoid finallyWriterT :: Monoid w => WriterT w IO a -> WriterT w IO b -> WriterT w IO a finallyWriterT (WriterT action) (WriterT cleanup) = WriterT $ do (a, w1) <- action `onException` cleanup (_b, w2) <- cleanup return (a, w1 <> w2) finallyReaderT :: ReaderT r IO a -> ReaderT r IO b -> ReaderT r IO a finallyReaderT (ReaderT action) (ReaderT cleanup) = ReaderT $ \r -> do a <- action r `onException` cleanup r _b <- cleanup r return a finallyExceptT :: ExceptT e IO a -> ExceptT e IO b -> ExceptT e IO a finallyExceptT (ExceptT action) (ExceptT cleanup) = ExceptT $ do ea <- action `onException` cleanup eb <- cleanup return $ case (ea, eb) of (Left e, _) -> Left e (Right _a, Left e) -> Left e (Right a, Right _b) -> Right a

The `WriterT`

case is very similar to the `StateT`

case, except (1)
there's no initial state `s0`

to contend with, and (2) instead of
receiving an updated `s2`

state from `cleanup`

, we need to monoidally
combine the `w1`

and `w2`

values. The `ReaderT`

case is *also* very
similar to `StateT`

, but in the opposite way: we receive an immutable
environment `r`

which is passed into all functions, but there is no
updated state. To put this in other words: `WriterT`

has no *context*
but has *mutable monadic state*, whereas `ReaderT`

has a context but
no mutable monadic state. `StateT`

, by contrast, has both. (This is
important to understand, so reread it a few times to get comfortable
with the concept.)

The `ExceptT`

case is interesting: it has no context (like `WriterT`

),
but it *does* have mutable monadic state, just not like `StateT`

and
`WriterT`

. Instead of returning an extra value with each result (as a
product), `ExceptT`

returns either a result value or an `e`

value (as
a sum). The `case`

expression at the end of `finallyExceptT`

is very
informative: we need to figure out how to combine the various monadic
states together. Our implementation here says that if `action`

returns
`e`

, we take that result. Otherwise, if `cleanup`

fails, we take
*that* value. And if they both return `Right`

values, then we use
`action`

's result. But there are at least two other valid choices:

- Prefer
`cleanup`

's`e`

value to`action`

's`e`

value, if both are available. - Completely ignore the
`e`

value returned by`cleanup`

, and just use`action`

's result.

There's also a fourth, invalid option: if `action`

returns a `Left`

,
return that immediately and don't call `cleanup`

. This has been a
perenniel source of bugs in many libraries dealing with exceptions in
monad transformers like `ErrorT`

, `ExceptT`

, and `EitherT`

. This
invalidates the contract of `finally`

, namely that `cleanup`

will
always be run. I've seen some arguments for why this can make sense,
but I consider it nothing more than a buggy implementation.

And finally, like with `StateT`

, we could avoid all of these questions
for `ExceptT`

if we just modify our type signature to use `IO b`

for
`cleanup`

:

finallyExceptT :: ExceptT e IO a -> IO b -> ExceptT e IO a finallyExceptT (ExceptT action) cleanup = ExceptT $ do ea <- action `onException` cleanup _b <- cleanup return ea

So our takeaway: we can implement `finally`

for various monad
transformers. In some cases this leads to questions of semantics, just
like with `StateT`

. And all of these transformers fall into a pattern
of optionally capturing some initial context, and optionally shuttling
around some monadic state.

(And no, I haven't forgotten that the title of this blog post talks
about `bracket`

. We're getting there, ever so slowly. I hope I've
piqued your curiosity.)

It's wonderful that we can implement all of these functions that take
monad transformers as arguments. But do any of us actually want to go
off and implement `catch`

, `try`

, `finally`

, `forkIO`

, `timeout`

, and
a dozen other functions for every possible monad transformer stack
imagineable? I doubt it. So just as we have `MonadTrans`

and `MonadIO`

for dealing with transformers in output/positive position, we can
construct some kind of typeclass that handles the two concepts we
mentioned above: capture the context, and deal with the monadic state.

Let's start by playing with this for just `StateT`

.

#!/usr/bin/env stack -- stack --resolver lts-8.12 script {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Exception import Control.Monad.State.Strict type Run s = forall b. StateT s IO b -> IO (b, s) capture :: forall s a. (Run s -> IO a) -> StateT s IO a capture withRun = StateT $ \s0 -> do let run :: Run s run (StateT f) = f s0 a <- withRun run return (a, s0) restoreState :: (a, s) -> StateT s IO a restoreState stateAndResult = StateT $ \_s0 -> return stateAndResult finally1 :: StateT s IO a -> IO b -> StateT s IO a finally1 action cleanup = do x <- capture $ \run -> run action `finally` cleanup restoreState x finally2 :: StateT s IO a -> StateT s IO b -> StateT s IO a finally2 action cleanup = do x <- capture $ \run -> run action `finally` run cleanup restoreState x -- Not async exception safe! finally3 :: StateT s IO a -> StateT s IO b -> StateT s IO a finally3 action cleanup = do x <- capture $ \run -> run action `onException` run cleanup a <- restoreState x _b <- cleanup return a main :: IO () main = do flip evalStateT () $ lift (putStrLn "here1") `finally1` putStrLn "here2" flip evalStateT () $ lift (putStrLn "here3") `finally2` lift (putStrLn "here4") flip evalStateT () $ lift (putStrLn "here5") `finally2` lift (putStrLn "here6")

That's a lot, let's step through it slowly:

type Run s = forall b. StateT s IO b -> IO (b, s)

This is a helper type to make the following bit simpler. It represents
the concept of capturing the initial state in a general manner. Given
an action living in our transformer, it turns an action in our base
monad, returning the entire monadic state with the return value (i.e.,
`(b, s)`

instead of just `b`

). This allows use to define our `capture`

function:

capture :: forall s a. (Run s -> IO a) -> StateT s IO a capture withRun = StateT $ \s0 -> do let run :: Run s run (StateT f) = f s0 a <- withRun run return (a, s0)

This function says "you give me some function that needs to be able to
run monadic actions with the initial context, and I'll give it that
initial context running function (`Run s`

)." The implementation isn't
too bad: we just capture the `s0`

, create a `run`

function out of it,
pass that into the user-provided argument, and then return the result
with the original state.

Now we need some way to update the monadic state based on a result
value. We call it `restoreState`

:

restoreState :: (a, s) -> StateT s IO a restoreState stateAndResult = StateT $ \_s0 -> return stateAndResult

Pretty simple too: we ignore our original monadic state and replace it
with the state contained in the argument. Next we use these two
functions to implement three versions of `finally`

. The first two are
able to reuse the `finally`

from `Control.Exception`

. However, both of
them suffer from the inability to retain monadic state. Our third
implementation fixes that, at the cost of having to reimplement the
logic of `finally`

. And as my comment there mentions, our
implementation is not in fact async exception safe.

So all of our original trade-offs apply from our initial `StateT`

discussion, but now there's an additional downside to option 3: it's
significantly more complicated to implement correctly.

Alright, we've established that it's possible to capture this idea for
`StateT`

. Let's generalize to a typeclass. We'll need three
components:

- A capture function. We'll call it
`liftIOWith`

, to match nomenclature in monad-control. - A restore function, which we'll call
`restoreM`

. - An
*associated type*(type family) to represent what the monadic state for the given monad stack is.

We end up with:

type RunInIO m = forall b. m b -> IO (StM m b) class MonadIO m => MonadIOControl m where type StM m a liftIOWith :: (RunInIO m -> IO a) -> m a restoreM :: StM m a -> m a

Let's write an instance for `IO`

:

instance MonadIOControl IO where type StM IO a = a liftIOWith withRun = withRun id restoreM = return

The `type StM IO a = a`

says that, for an `IO`

action returning `a`

,
the full monadic state is just `a`

. In other words, there is no
additional monadic state hanging around. That's good, as we know that
there isn't. `liftIOWith`

is able to just use `id`

as the `RunInIO`

function, since you can run an `IO`

action in `IO`

directly. And
finally, since there is no monadic state to update, `restoreM`

just
wraps up the result value in `IO`

via `return`

. (More foreshadowment:
what this instance is supposed to look like is actually at the core of
the bug this blog post will eventually talk about.)

Alright, let's implement this instance for `StateT s IO`

:

instance MonadIOControl (StateT s IO) where type StM (StateT s IO) a = (a, s) liftIOWith withRun = StateT $ \s0 -> do a <- withRun $ \(StateT f) -> f s0 return (a, s0) restoreM stateAndResult = StateT $ \_s0 -> return stateAndResult

This is basically identical to the functions we defined above, so I
won't dwell on it here. But here's an interesting observation: the
same way we define `MonadIO`

instance as ```
instance MonadIO m =>
MonadIO (StateT s m)
```

, it would be great to do the same thing for
`MonadIOControl`

. And, in fact, we can do just that!

instance MonadIOControl m => MonadIOControl (StateT s m) where type StM (StateT s m) a = StM m (a, s) liftIOWith withRun = StateT $ \s0 -> do a <- liftIOWith $ \run -> withRun $ \(StateT f) -> run $ f s0 return (a, s0) restoreM x = StateT $ \_s0 -> restoreM x

We use the underlying monad's `liftIOWith`

and `restoreM`

functions
within our own definitions, and thereby get context and state passed
up and down the stack as needed. Alright, let's go ahead and do this
for all of the transformers we've been discussing:

#!/usr/bin/env stack -- stack --resolver lts-8.12 script {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} import Control.Exception import Control.Monad.State.Strict import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.Except import Data.Monoid import Data.IORef type RunInIO m = forall b. m b -> IO (StM m b) class MonadIO m => MonadIOControl m where type StM m a liftIOWith :: (RunInIO m -> IO a) -> m a restoreM :: StM m a -> m a instance MonadIOControl IO where type StM IO a = a liftIOWith withRun = withRun id restoreM = return instance MonadIOControl m => MonadIOControl (StateT s m) where type StM (StateT s m) a = StM m (a, s) liftIOWith withRun = StateT $ \s0 -> do a <- liftIOWith $ \run -> withRun $ \(StateT f) -> run $ f s0 return (a, s0) restoreM x = StateT $ \_s0 -> restoreM x instance (MonadIOControl m, Monoid w) => MonadIOControl (WriterT w m) where type StM (WriterT w m) a = StM m (a, w) liftIOWith withRun = WriterT $ do a <- liftIOWith $ \run -> withRun $ \(WriterT f) -> run f return (a, mempty) restoreM x = WriterT $ restoreM x instance MonadIOControl m => MonadIOControl (ReaderT r m) where type StM (ReaderT r m) a = StM m a liftIOWith withRun = ReaderT $ \r -> liftIOWith $ \run -> withRun $ \(ReaderT f) -> run $ f r restoreM x = ReaderT $ \r -> restoreM x instance MonadIOControl m => MonadIOControl (ExceptT e m) where type StM (ExceptT e m) a = StM m (Either e a) liftIOWith withRun = ExceptT $ do a <- liftIOWith $ \run -> withRun $ \(ExceptT f) -> run f return $ Right a restoreM x = ExceptT $ restoreM x control :: MonadIOControl m => (RunInIO m -> IO (StM m a)) -> m a control f = do x <- liftIOWith f restoreM x checkControl :: MonadIOControl m => m () checkControl = control $ \run -> do ref <- newIORef (0 :: Int) let ensureIs :: MonadIO m => Int -> m () ensureIs expected = liftIO $ do putStrLn $ "ensureIs " ++ show expected curr <- atomicModifyIORef ref $ \curr -> (curr + 1, curr) unless (curr == expected) $ error $ show ("curr /= expected", curr, expected) ensureIs 0 Control.Exception.mask $ \restore -> do ensureIs 1 res <- restore (ensureIs 2 >> run (ensureIs 3) `finally` ensureIs 4) ensureIs 5 return res main :: IO () main = do checkControl runStateT checkControl () >>= print runWriterT checkControl >>= (print :: ((), ()) -> IO ()) runReaderT checkControl () runExceptT checkControl >>= (print :: Either () () -> IO ())

I encourage you to inspect each of the instances above and make sure
you're comfortable with their implementation. I've added a function
here, `checkControl`

, as a basic sanity check of our
implementation. We start with the `control`

helper function, which
runs some action with a `RunInIO`

argument, and then restores the
monadic state. Then we use this function in `checkControl`

to ensure
that a series of actions are all run in the correct order. As you can
see, all of our test monads pass (again, *foreshadowment*).

The real monad-control package looks pretty similar to this, except:

- Instead of
`MonadIOControl`

, which is hard-coded to using`IO`

as a base monad, it provides a`MonadBaseControl`

typeclass, which allows arbitrary base monads (like`ST`

or`STM`

). - Just as
`MonadBaseControl`

is an analogue of`MonadIO`

, the package provides`MonadTransControl`

as an analogue of`MonadTrans`

, allowing you to unwrap one layer in a monad stack.

With all of this exposition out of the way—likely the longest exposition I've ever written in any blog post—we can start dealing with the actual bug. I'll show you the full context eventually, but I was asked to help debug a function that looked something like this:

fileLen1 :: (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen1 fp = runResourceT $ runConduit $ sourceFile fp .| lengthCE

This is fairly common in Conduit code. We're going to use
`sourceFile`

, which needs to allocate some resources. Since we can't
safely allocate resources from within a Conduit pipeline, we start off
with `runResourceT`

to allow Conduit to register cleanup
actions. (This combination is so common that we have a helper function
`runConduitRes = runResourceT . runConduit`

.)

Unfortunately, this innocuous-looking like of code was generating an error message:

`Control.Monad.Trans.Resource.register': The mutable state is being accessed after cleanup. Please contact the maintainers.`

The "Please contact the maintainers." line should probably be removed from the resourcet package; it was from back in a time when we thought this bug was most likely to indicate an implementation bug within resourcet. That's no longer the case... which hopefully this debugging adventure will help demonstrate.

Anyway, as last week's blog post on ResourceT explained,
`runResourceT`

creates a mutable variable to hold a list of cleanup
actions, allows the inner action to register cleanup values into that
mutable variable, and then when `runResourceT`

is exiting, it calls
all those cleanup actions. And as a last sanity check, it replaces the
value inside that mutable variable with a special value indicating
that the state has already been closed, and it is therefore invalid to
register further cleanup actions.

In well-behaved code, the structure of our `runResourceT`

function
should prevent the mutable state from being accessible after it's
closed, though I mention some cases last week that could cause that to
happen (specifically, misuse of concurrency and the `transPipe`

function). However, after thoroughly exploring the codebase, I could
find no indication that either of these common bugs had occurred.

Internally, `runResourceT`

is essentially a `bracket`

call, using the
`createInternalState`

function to allocate the mutable variable, and
`closeInternalState`

to clean it up. So I figured I could get a bit
more information about this bug by using the `bracket`

function from
`Control.Exception.Lifted`

and implementing:

fileLen2 :: (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen2 fp = Lifted.bracket createInternalState closeInternalState $ runInternalState $ runConduit $ sourceFile fp .| lengthCE

Much to my chagrin, the bug disappeared! Suddenly the code worked
perfectly. Beginning to question my sanity, I decided to look at the
implementation of `runResourceT`

, and found this:

runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a runResourceT (ResourceT r) = control $ \run -> do istate <- createInternalState E.mask $ \restore -> do res <- restore (run (r istate)) `E.onException` stateCleanup ReleaseException istate stateCleanup ReleaseNormal istate return res

Ignoring the fact that we differentiate between exception and normal
cleanup in the `stateCleanup`

function, I was struck by one question:
why did I decide to implement this with `control`

in a manual,
error-prone way instead of using the `bracket`

function directly? I
began to worry that there was a bug in this implementation leading to
all of the problems.

However, after reading through this implementation many times, I
convinced myself that it was, in fact, correct. And then I realized
why I had done it this way. Both `createInternalState`

and
`stateCleanup`

are functions that can live in `IO`

directly, without
any need of a monad transformer state. The only function that needed
the monad transformer logic was that contained in the `ResourceT`

itself.

If you remember our discussion above, there were two major advantages
of the implementation of `finally`

which relied upon `IO`

for the
cleanup function instead of using the monad transformer state:

- It was much more explicit about how monadic state was going to be handled.
- It gave a slight performance advantage.

With the downside being that the type signature wasn't quite what people normally expected. Well, that downside didn't apply in my case: I was working on an internal function in a library, so I was free to ignore what a user-friendly API would look like. The advantage of explicitness around monadic state certainly appealed in a library that was so sensitive to getting things right. And given how widely used this function is, and the deep monadic stacks it was sometimes used it, any performance advantage was worth pursuing.

Alright, I felt good about the fact that `runResourceT`

was
implemented correctly. Just to make sure I wasn't crazy, I
reimplemented `fileLen`

to use an explicit `control`

instead of
`Lifted.bracket`

, and the bug reappeared:

-- I'm ignoring async exception safety. This needs mask. fileLen3 :: forall m. (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen3 fp = control $ \run -> do istate <- createInternalState res <- run (runInternalState inner istate) `onException` closeInternalState istate closeInternalState istate return res where inner :: ResourceT m Int inner = runConduit $ sourceFile fp .| lengthCE

And as one final sanity check, I implemented `fileLen4`

to use the
generalized style of `bracket`

, where the allocation and cleanup
functions live in the monad stack instead of just `IO`

, and as
expected the bug disappeared again. (Actually, I didn't really do
this. I'm doing it now for the purpose of this blog post.)

fileLen4 :: forall m. (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen4 fp = control $ \run -> bracket (run createInternalState) (\st -> run $ restoreM st >>= closeInternalState) (\st -> run $ restoreM st >>= runInternalState inner) where inner :: ResourceT m Int inner = runConduit $ sourceFile fp .| lengthCE

Whew, OK! So it turns out that my blog post title was correct: this
*is* a tale of two brackets. And somehow, one of them triggers a bug,
and one of them doesn't. But I still didn't know quite how that
happened.

Another member of the team tracked down the ultimate problem to a
datatype that looked like this (though not actually named `Bad`

, that
would have been too obvious):

newtype Bad a = Bad { runBad :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadBase IO) instance MonadBaseControl IO Bad where type StM Bad a = IO a liftBaseWith withRun = Bad $ withRun $ return . runBad restoreM = Bad

That's the kind of code that can easily pass a code review without
anyone noticing a thing. With all of the context from this blog post,
you may be able to understand why I've called this type `Bad`

. Go
ahead and give it a few moments to try and figure it out.

OK, ready to see how this plays out? The `StM Bad a`

associated type
is supposed to contain the result value of the underlying monad,
together with any state introduced by this monad. Since we just have a
newtype around `IO`

, there should be no monadic state, and we should
just have `a`

. However, we've *actually* defined it as `IO a`

, which
means "my monadic state for a value `a`

is an `IO`

action which will
return an `a`

." The implementation of `liftBaseWith`

and `restoreM`

are simply in line with making the types work out.

Let's look at `fileLen3`

understanding that this is the instance in
question. I'm also going to expand the `control`

function to make it
easier to see what's happening.

res <- liftBaseWith $ \run -> do istate <- createInternalState res <- run (runInternalState inner istate) `onException` closeInternalState istate closeInternalState istate return res restoreM res

If we play it a little loose with newtype wrappers, we can substitute
in the implementations of `liftBaseWith`

and `restoreM`

to get:

res <- Bad $ do let run = return . runBad istate <- createInternalState res <- run (runInternalState inner istate) `onException` closeInternalState istate closeInternalState istate return res Bad res

Let's go ahead and substitute in our `run`

function in the one place
it's used:

res <- Bad $ do istate <- createInternalState res <- return (runBad (runInternalState inner istate)) `onException` closeInternalState istate closeInternalState istate return res Bad res

If you look at the code `return x `onException` foo`

, it's pretty
easy to establish that `return`

itself will never throw an exception
in `IO`

, and therefore the `onException`

it useless. In other words,
the code is equivalent to just `return x`

. So again substituting:

res <- Bad $ do istate <- createInternalState res <- return (runBad (runInternalState inner istate)) closeInternalState istate return res Bad res

And since `foo <- return x`

is just `let foo = x`

, we can turn this
into:

res <- Bad $ do istate <- createInternalState closeInternalState istate return (runBad (runInternalState inner istate)) Bad res

And then:

Bad $ do istate <- createInternalState closeInternalState istate Bad (runBad (runInternalState inner istate))

And finally, just to drive the point home:

istate <- Bad createInternalState Bad $ closeInternalState istate runInternalState inner istate

So who wants to take a guess why the mutable variable was closed
before we ever tried to register? Because *that's exactly what our
MonadBaseControl instance said!* The problem is that instead of our
monadic state just being some value, it was the

`closeInternalState`

. Oops.Now let's try to understand why `fileLen4`

worked, despite the broken
`MonadBaseControl`

instance. Again, starting with the original code
after replacing `control`

with `liftBaseWith`

and `restoreM`

:

res <- liftBaseWith $ \run -> bracket (run createInternalState) (\st -> run $ restoreM st >>= closeInternalState) (\st -> run $ restoreM st >>= runInternalState inner) restoreM res

This turns into:

res <- Bad $ bracket (return $ runBad createInternalState) (\st -> return $ runBad $ Bad st >>= closeInternalState) (\st -> return $ runBad $ Bad st >>= runInternalState inner) Bad res

Since this case is a bit more involved than the previous one, let's
strip off the noise of `Bad`

and `runBad`

calls, since they're just
wrapping/unwrapping a newtype:

res <- bracket (return createInternalState) (\st -> return $ st >>= closeInternalState) (\st -> return $ st >>= runInternalState inner) res

To decompose this mess, let's look at the actual implementation of
`bracket`

from `base`

:

bracket before after thing = mask $ \restore -> do a <- before r <- restore (thing a) `onException` after a _ <- after a return r

We're going to ignore async exceptions for now, and therefore just
mentally delete the `mask $ \restore`

bit. We end up with:

res <- do a <- return createInternalState r <- return (a >>= runInternalState inner) `onException` return (a >>= closeInternalState) _ <- return (a >>= closeInternalState) return r res

As above, we know that our `return x `onException` foo`

will never
actually trigger the exception case. Also, `a <- return x`

is the same
as `let a = x`

. So we can simplify to:

res <- do let a = createInternalState let r = a >>= runInternalState inner _ <- return (a >>= closeInternalState) return r res

Also, `_ <- return x`

has absolutely no impact at all, so we can
delete that line (and any mention of `closeInternalState`

):

res <- do let a = createInternalState let r = a >>= runInternalState inner return r res

And then with a few more simply conversions, we end up with:

createInternalState >>= runInternalState inner

No wonder this code "worked": it never bothered trying to clean up!
This could have easily led to complete leaking of resources in the
application. Only the fact that our `runResourceT`

function thankfully
stressed the code in a different way did we reveal the problem.

It's certainly possible to define a correct newtype wrapper around
`IO`

:

newtype Good a = Good { runGood :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadBase IO) instance MonadBaseControl IO Good where type StM Good a = a liftBaseWith withRun = Good $ withRun runGood restoreM = Good . return

Unfortunately we can't simply use `GeneralizedNewtypeDeriving`

to make
this instance due to the associated type family. But the explicitness
here helps us understand what we did wrong before. Note that our ```
type
StM Good a
```

is just `a`

, not `IO a`

. We then implement the helper
functions in terms of that. If you go through the same substitution
exercise I did above, you'll see that—instead of passing around
values which contain the actions to actually perform—our
`fileLen3`

and `fileLen4`

functions will be performing the actions at
the appropriate time.

I'm including the full test program at the end of this post for you to play with.

So that blog post was certainly all over the place. I hope the primary
thing you take away from it is a deeper understanding of how monad
transformer stacks interact with operations in the base monad, and how
monad-control works in general. In particular, next time you call
`finally`

on some five-layer-deep stack, maybe you'll think twice
about the implication of calling `modify`

or `tell`

in your cleanup
function.

Another possible takeaway you may have is "Haskell's crazy
complicated, this bug could happen to anyone, and it's almost
undetectable." It turns out that there's a really simple workaround
for that: stick to standard monad transformers whenever
possible. monad-control is a phenomonal library, but I don't think
most people should ever have to interact with it directly. Like async
exceptions and `unsafePerformIO`

, there are parts of our library
ecosystem that require them, but you should stick to higher-level
libraries that hide that insanity from you, the same way we use
higher-level languages to avoid having to write assembly.

Finally, having to think about all of the monadic state stuff in my
code gives me a headache. It's possible for us to have a library like
`lifted-base`

, but which constrains functions to only taking one
argument in the `m`

monad and the rest in `IO`

to avoid the
multiple-state stuff. However, my preferred solution is to avoid
wherever possible monad transformers that introduce monadic state, and
stick to `ReaderT`

like things for the majority of my
application. (Yes, this is another pitch for my
ReaderT design pattern.)

#!/usr/bin/env stack -- stack --resolver lts-8.12 script {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Control.Exception.Safe import qualified Control.Exception.Lifted as Lifted import Conduit newtype Bad a = Bad { runBad :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadBase IO) instance MonadBaseControl IO Bad where type StM Bad a = IO a liftBaseWith withRun = Bad $ withRun $ return . runBad restoreM = Bad newtype Good a = Good { runGood :: IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadBase IO) instance MonadBaseControl IO Good where type StM Good a = a liftBaseWith withRun = Good $ withRun runGood restoreM = Good . return fileLen1 :: (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen1 fp = runResourceT $ runConduit $ sourceFile fp .| lengthCE fileLen2 :: (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen2 fp = Lifted.bracket createInternalState closeInternalState $ runInternalState $ runConduit $ sourceFile fp .| lengthCE -- I'm ignoring async exception safety. This needs mask. fileLen3 :: forall m. (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen3 fp = control $ \run -> do istate <- createInternalState res <- run (runInternalState inner istate) `onException` closeInternalState istate closeInternalState istate return res where inner :: ResourceT m Int inner = runConduit $ sourceFile fp .| lengthCE fileLen4 :: forall m. (MonadThrow m, MonadBaseControl IO m, MonadIO m) => FilePath -> m Int fileLen4 fp = control $ \run -> bracket (run createInternalState) (\st -> run $ restoreM st >>= closeInternalState) (\st -> run $ restoreM st >>= runInternalState inner) where inner :: ResourceT m Int inner = runConduit $ sourceFile fp .| lengthCE main :: IO () main = do putStrLn "fileLen1" tryAny (fileLen1 "/usr/share/dict/words") >>= print tryAny (runBad (fileLen1 "/usr/share/dict/words")) >>= print tryAny (runGood (fileLen1 "/usr/share/dict/words")) >>= print putStrLn "fileLen2" tryAny (fileLen2 "/usr/share/dict/words") >>= print tryAny (runBad (fileLen2 "/usr/share/dict/words")) >>= print tryAny (runGood (fileLen2 "/usr/share/dict/words")) >>= print putStrLn "fileLen3" tryAny (fileLen3 "/usr/share/dict/words") >>= print tryAny (runBad (fileLen3 "/usr/share/dict/words")) >>= print tryAny (runGood (fileLen3 "/usr/share/dict/words")) >>= print putStrLn "fileLen4" tryAny (fileLen4 "/usr/share/dict/words") >>= print tryAny (runBad (fileLen4 "/usr/share/dict/words")) >>= print tryAny (runGood (fileLen4 "/usr/share/dict/words")) >>= print

**Bonus exercise** Take the `checkControl`

function I provided above,
and use it in the `Good`

and `Bad`

monads. See what the result is, and
if you can understand why that's the case.