diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2011-2017, Mikhail Vorozhtsov
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+  this list of conditions and the following disclaimer.
+- Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the distribution.
+- Neither the names of the copyright owners nor the names of the
+  contributors may be used to endorse or promote products derived
+  from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/monad-finally.cabal b/monad-finally.cabal
new file mode 100644
--- /dev/null
+++ b/monad-finally.cabal
@@ -0,0 +1,43 @@
+Name: monad-finally
+Version: 0.1
+Category: Control
+Stability: experimental
+Synopsis: Guard monadic computations with cleanup actions
+Description:
+  This package provides a generalized version of @Control.Exception.finally@.
+  The cleanup action is run not only on successful termination of the main
+  computation and on errors, but on any control flow disruption (e.g.
+  @mzero@, short-circuiting) that causes the main computation to not produce
+  a result.
+
+Homepage: https://github.com/mvv/monad-finally
+Bug-Reports: https://github.com/mvv/monad-finally/issues
+
+Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+Copyright: 2011-2017 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
+License: BSD3
+License-File: LICENSE
+
+Tested-With: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
+
+Cabal-Version: >= 1.6.0
+Build-Type: Simple
+
+Source-Repository head
+  Type: git
+  Location: https://github.com/mvv/monad-finally.git
+
+Library
+  Build-Depends: base >= 4.4 && < 5
+  Build-Depends: transformers        >= 0.2
+               , transformers-compat >= 0.5
+               , transformers-base   >= 0.4
+               , transformers-abort  >= 0.6
+               , monad-abort-fd      >= 0.6
+               , monad-control       >= 1.0
+  Hs-Source-Dirs: src
+  GHC-Options: -Wall
+  Exposed-Modules:
+    Control.Monad.Finally
+    Control.Monad.Exception
diff --git a/src/Control/Monad/Exception.hs b/src/Control/Monad/Exception.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Exception.hs
@@ -0,0 +1,285 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | A generalization of "Control.Exception" from the 'IO' monad to
+-- 'MonadRecover' 'SomeException'.
+module Control.Monad.Exception
+  (
+  -- * Throwing exceptions
+    exception
+  , throw
+  , throwIO
+  , ioError
+  , throwTo
+  -- * Catching exceptions
+  , catch
+  , handle
+  , catchJust
+  , handleJust
+  , Handler(..)
+  , catches
+  , handles
+  , try
+  , tryJust
+  , evaluateIO
+  -- * Asynchronous exception control
+  , MonadMask(..)
+  , liftGetMaskingState
+  , liftWithMaskingState
+  , mask
+  , mask_
+  , uninterruptibleMask
+  , uninterruptibleMask_
+  , interruptible
+  , allowInterrupt
+  , module Control.Monad.Finally
+  , module Control.Exception
+  ) where
+
+#if !MIN_VERSION_base(4,6,0)
+import Prelude hiding (catch)
+#else
+import Prelude hiding (ioError)
+#endif
+import Data.Monoid (Monoid)
+import Control.Applicative (Applicative, (<$>))
+import Control.Monad (join, liftM)
+import Control.Monad.Base
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Control (MonadTransControl(..))
+import Control.Monad.Trans.Abort hiding (abort, recover)
+import Control.Monad.Trans.Finish
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.List
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Reader
+import qualified Control.Monad.Trans.State.Lazy as L
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Writer.Lazy as L
+import qualified Control.Monad.Trans.Writer.Strict as S
+import qualified Control.Monad.Trans.RWS.Lazy as L
+import qualified Control.Monad.Trans.RWS.Strict as S
+import Control.Monad.Abort.Class
+import Control.Monad.Finally
+import Control.Concurrent (ThreadId)
+import Control.Exception hiding (
+  evaluate, throw, throwIO, ioError, throwTo, catch, catchJust, handle,
+  handleJust, Handler(..), catches, try, tryJust, finally, onException,
+#if !MIN_VERSION_base(4,7,0)
+  block, unblock, blocked,
+#endif
+  getMaskingState, mask, mask_, uninterruptibleMask, uninterruptibleMask_,
+#if MIN_VERSION_base(4,9,0)
+  interruptible,
+#endif
+  allowInterrupt, bracket, bracket_, bracketOnError)
+import qualified Control.Exception as E
+import GHC.Base (maskAsyncExceptions#, maskUninterruptible#,
+                 unmaskAsyncExceptions#)
+import GHC.IO (IO(..))
+
+-- | Throw an exception from pure code.
+exception ∷ Exception e ⇒ e → α
+exception = E.throw
+{-# INLINE exception #-}
+
+-- | Throw an exception from monadic code. An alias for
+-- @'abort' . 'toException'@.
+throw ∷ (MonadAbort SomeException μ, Exception e) ⇒ e → μ α
+throw = abort . toException
+{-# INLINE throw #-}
+
+-- | Thow an exception from the 'IO' monad.
+throwIO ∷ (MonadBase IO μ, Exception e) ⇒ e → μ α
+throwIO = liftBase . E.throwIO
+{-# INLINE throwIO #-}
+
+-- | Raise an 'IOError' in the 'IO' monad.
+ioError ∷ MonadBase IO μ ⇒ IOError → μ α
+ioError = liftBase . E.ioError
+{-# INLINE ioError #-}
+
+-- | Raise an exception in the target thread. See 'E.throwTo'.
+throwTo ∷ (MonadBase IO μ, Exception e) ⇒ ThreadId → e → μ ()
+throwTo = fmap liftBase . E.throwTo
+{-# INLINE throwTo #-}
+
+-- | Recover from the specified type of exceptions.
+catch ∷ (MonadRecover SomeException μ, Exception e) ⇒ μ α → (e → μ α) → μ α
+catch m h = recover m $ \e → maybe (throw e) h (fromException e)
+{-# INLINE catch #-}
+
+-- | An alias for @'flip' 'catch'@.
+handle ∷ (MonadRecover SomeException μ, Exception e) ⇒ (e → μ α) → μ α → μ α
+handle = flip catch
+{-# INLINE handle #-}
+
+-- | Recover from exceptions that satisfy the provided predicate.
+catchJust ∷ (MonadRecover SomeException μ, Exception e)
+          ⇒ (e → Maybe β) -- ^ Exception predicate
+          → μ α           -- ^ Main computation
+          → (β → μ α)     -- ^ Exception handler
+          → μ α
+catchJust f m h = catch m $ \e → maybe (throw e) h $ f e
+{-# INLINE catchJust #-}
+
+-- | An alias for @'flip' . 'catchJust'@.
+handleJust ∷ (MonadRecover SomeException μ, Exception e)
+           ⇒ (e → Maybe β) → (β → μ α) → μ α → μ α
+handleJust = flip . catchJust
+{-# INLINE handleJust #-}
+
+-- | Exception handler.
+data Handler μ α = ∀ e . Exception e ⇒ Handler (e → μ α)
+
+instance Functor μ ⇒ Functor (Handler μ) where
+  fmap f (Handler h) = Handler (fmap f . h)
+  {-# INLINE fmap #-}
+
+-- | Recover from exceptions by sequentually trying to apply the provided
+-- handlers.
+catches ∷ MonadRecover SomeException μ ⇒ μ α → [Handler μ α] → μ α
+catches m = recover m . hl
+  where hl [] e = abort e
+        hl (Handler h : hs) e = maybe (hl hs e) h $ fromException e
+
+-- | An alias for @'flip' 'catches'@.
+handles ∷ MonadRecover SomeException μ ⇒ [Handler μ α] → μ α → μ α
+handles = flip catches
+{-# INLINE handles #-}
+
+-- | Recover from exceptions of the spesified type, wrapping them into
+-- 'Left'.
+try ∷ (MonadRecover SomeException μ, Exception e) ⇒ μ α → μ (Either e α)
+try m = catch (Right <$> m) (return . Left)
+{-# INLINE try #-}
+
+-- | Recover from exceptions that satisfy the provided predicate, wrapping
+-- them into 'Left'.
+tryJust ∷ (MonadRecover SomeException μ, Exception e)
+        ⇒ (e → Maybe β) -- ^ Exception predicate
+        → μ α           -- ^ Main compuration
+        → μ (Either β α)
+tryJust h m = catch (Right <$> m) $ \e →
+  maybe (throw e) (return . Left) (h e)
+{-# INLINE tryJust #-}
+
+-- | Evalute the argument to weak head normal form.
+evaluateIO ∷ MonadBase IO μ ⇒ α → μ α
+evaluateIO = liftBase . E.evaluate
+{-# INLINE evaluateIO #-}
+
+-- | A class of monads that support masking of asynchronous exceptions.
+class (Applicative μ, Monad μ) ⇒ MonadMask μ where
+  -- | Get the current masking state.
+  getMaskingState ∷ μ MaskingState
+  default getMaskingState ∷ (MonadMask η, MonadTrans t, μ ~ t η)
+                          ⇒ μ MaskingState
+  getMaskingState = liftGetMaskingState
+  {-# INLINE getMaskingState #-}
+  -- | Run the provided computation with the specified 'MaskingState'.
+  withMaskingState ∷ MaskingState → μ α → μ α
+  default withMaskingState ∷ (MonadMask η, MonadTransControl t, μ ~ t η)
+                           ⇒ MaskingState → μ α → μ α
+  withMaskingState = liftWithMaskingState
+  {-# INLINE withMaskingState #-}
+
+-- | Lift 'getMaskingState' through a monad transformer.
+liftGetMaskingState ∷ (MonadMask μ, MonadTrans t) ⇒ t μ MaskingState
+liftGetMaskingState = lift getMaskingState
+{-# INLINE liftGetMaskingState #-}
+
+-- | Lift 'withMaskingState' through a monad transformer.
+liftWithMaskingState ∷ (MonadTransControl t, MonadMask μ, Monad (t μ))
+                     ⇒ MaskingState → t μ α → t μ α
+liftWithMaskingState ms m =
+  join $ liftM (restoreT . return) $ liftWith $ \run →
+    withMaskingState ms (run m)
+{-# INLINE liftWithMaskingState #-}
+
+instance MonadMask IO where
+  getMaskingState = E.getMaskingState
+  withMaskingState Unmasked (IO io) = IO $ unmaskAsyncExceptions# io
+  withMaskingState MaskedInterruptible (IO io) = IO $ maskAsyncExceptions# io
+  withMaskingState MaskedUninterruptible (IO io) = IO $ maskUninterruptible# io
+
+instance MonadMask μ ⇒ MonadMask (MaybeT μ)
+instance MonadMask μ ⇒ MonadMask (ListT μ)
+instance MonadMask μ ⇒ MonadMask (AbortT e μ)
+instance MonadMask μ ⇒ MonadMask (FinishT β μ)
+instance (MonadMask μ, Error e) ⇒ MonadMask (ErrorT e μ)
+instance MonadMask μ ⇒ MonadMask (ExceptT e μ)
+instance MonadMask μ ⇒ MonadMask (ReaderT r μ)
+instance MonadMask μ ⇒ MonadMask (L.StateT s μ)
+instance MonadMask μ ⇒ MonadMask (S.StateT s μ)
+instance (MonadMask μ, Monoid w) ⇒ MonadMask (L.WriterT w μ)
+instance (MonadMask μ, Monoid w) ⇒ MonadMask (S.WriterT w μ)
+instance (MonadMask μ, Monoid w) ⇒ MonadMask (L.RWST r w s μ)
+instance (MonadMask μ, Monoid w) ⇒ MonadMask (S.RWST r w s μ)
+
+-- | Prevents asynchronous exceptions from being raised within the provided
+-- computation. Blocking operations can still be interrupted. Supplies the
+-- computation with @'withMaskingState' s@, where @s@ is the current masking
+-- state.
+mask ∷ ∀ μ α . MonadMask μ
+     ⇒ ((∀ η β . MonadMask η ⇒ η β → η β) → μ α) → μ α
+mask f = getMaskingState >>= \case
+  Unmasked →
+    withMaskingState MaskedInterruptible $ f (withMaskingState Unmasked)
+  MaskedInterruptible →
+    f (withMaskingState MaskedInterruptible)
+  MaskedUninterruptible →
+    f (withMaskingState MaskedUninterruptible)
+ 
+-- | An alias for @'mask' . 'const'@.
+mask_ ∷ ∀ μ α . MonadMask μ ⇒ μ α → μ α
+mask_ = mask . const
+{-# INLINE mask_ #-}
+
+-- | Prevents asynchronous exceptions from being raised within the provided
+-- computation. Also prevents blocking operations from being interrupted.
+-- Supplies the computation with @'withMaskingState' s@, where @s@ is the
+-- current masking state.
+uninterruptibleMask ∷ MonadMask μ
+                    ⇒ ((∀ η β . MonadMask η ⇒ η β → η β) → μ α) → μ α
+uninterruptibleMask f = getMaskingState >>= \case
+  Unmasked →
+    withMaskingState MaskedUninterruptible $ f (withMaskingState Unmasked)
+  MaskedInterruptible →
+    withMaskingState MaskedUninterruptible $
+      f (withMaskingState MaskedInterruptible)
+  MaskedUninterruptible →
+    f (withMaskingState MaskedUninterruptible)
+
+-- | An alias for @'uninterruptibleMask' . 'const'@.
+uninterruptibleMask_ ∷ MonadMask μ ⇒ μ α → μ α
+uninterruptibleMask_ = uninterruptibleMask . const
+{-# INLINE uninterruptibleMask_ #-}
+
+-- | Allow asynchronous exceptions to be raised within the provided
+-- computation, even if the current masking state is 'MaskedInterruptible'
+-- (but not in 'MaskedUninterruptible' state).
+interruptible ∷ MonadMask μ ⇒ μ α → μ α
+interruptible m = getMaskingState >>= \case
+  Unmasked → m
+  MaskedInterruptible → withMaskingState Unmasked m
+  MaskedUninterruptible → m
+
+-- | An alias for @'interruptible' ('return' ())@.
+allowInterrupt ∷ MonadMask μ ⇒ μ ()
+allowInterrupt = interruptible $ return ()
+{-# INLINE allowInterrupt #-}
diff --git a/src/Control/Monad/Finally.hs b/src/Control/Monad/Finally.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Finally.hs
@@ -0,0 +1,301 @@
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
+-- | Guarding monadic computations with cleanup actions.
+module Control.Monad.Finally
+  ( MonadFinally(..)
+  , chainCleanups
+  , finallyMany
+  , onEscape
+  , onEscapeMany
+  , bracket_
+  , bracketOnEscape
+  ) where
+
+#if !MIN_VERSION_base(4,8,0)
+import Prelude hiding (mapM, forM)
+#endif
+import Data.Functor.Identity
+import Data.Monoid (Monoid(..))
+import Data.Traversable (mapM, forM)
+import Control.Applicative (Applicative(..), (<$>), (<$))
+import Control.Monad (join)
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Reader
+import qualified Control.Monad.Trans.State.Lazy as L
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Writer.Lazy as LW
+import qualified Control.Monad.Trans.Writer.Strict as SW
+import qualified Control.Monad.Trans.RWS.Lazy as L
+import qualified Control.Monad.Trans.RWS.Strict as S
+import Control.Monad.Trans.Abort
+import Control.Monad.Trans.Finish
+import qualified Control.Exception as E
+
+-- | Class of monads that support guarding computations with cleanup actions.
+class (Applicative μ, Monad μ) ⇒ MonadFinally μ where
+#if __GLASGOW_HASKELL__ >= 707
+  {-# MINIMAL finally' | bracket' #-}
+#endif
+  -- | @'finally'' m f@ runs computation @m@ and then
+  --
+  -- 1. runs @f ('Just' x)@ if @m@ produced a result @x@. The result of that is
+  -- returned alongside with @x@.
+  -- 2. runs @f 'Nothing'@ otherwise.
+  finally' ∷ μ α → (Maybe α → μ β) → μ (α, β)
+  finally' m f = bracket' (return ()) (const f) (const m)
+  -- | A simplified version of 'finally'' in which the cleanup action
+  -- does not care about the result of the main computation. The default
+  -- implementation is
+  --
+  -- @
+  --     'finally' m = 'fmap' 'fst' . 'finally'' m . 'const'
+  -- @
+  finally  ∷ μ α → μ β → μ α
+  finally m = fmap fst . finally' m . const
+  -- | Safely acquire a resource and use it in a computation, releasing it
+  -- even when the computation does not produce a result.
+  bracket' ∷ μ r                 -- ^ Acquire resource
+           → (r → Maybe α → μ β) -- ^ Release resource
+           → (r → μ α)           -- ^ Main computation
+           → μ (α, β)
+  bracket' acquire release m = do
+    r ← acquire
+    finally' (m r) (release r)
+  -- | A simplified version of 'bracket'' in which the releasing action
+  -- does not care about the result of the main computation. The default
+  -- implementation is
+  --
+  -- @
+  --     'bracket' acquire release =
+  --       'fmap' 'fst' . 'bracket'' acquire ('const' . release)
+  -- @
+  bracket ∷ μ r → (r → μ β) → (r → μ α) → μ α
+  bracket acquire release = fmap fst . bracket' acquire (const . release)
+
+instance MonadFinally Identity where
+  finally' m f = do
+    mr ← m
+    return (mr, runIdentity $ f $ Just mr)
+
+instance MonadFinally IO where
+  finally' m f = E.mask $ \restore → do
+    mr ← restore m `E.onException` f Nothing
+    fr ← f $ Just mr
+    return (mr, fr)
+  bracket' acquire release m = E.mask $ \restore → do
+    ar ← acquire
+    mr ← restore (m ar) `E.onException` release ar Nothing
+    rr ← release ar $ Just mr
+    return (mr, rr)
+
+instance MonadFinally μ ⇒ MonadFinally (MaybeT μ) where
+  finally' m f = MaybeT $ do
+    (mr, fr) ← finally' (runMaybeT m) (runMaybeT . f . join)
+    return $ (,) <$> mr <*> fr
+  bracket' acquire release m = MaybeT $ do
+    (mr, rr) ← bracket' (runMaybeT acquire)
+                        (\case
+                           Just ar → runMaybeT . release ar . join
+                           Nothing → const (return Nothing))
+                        (fmap join . mapM (runMaybeT . m))
+    return $ (,) <$> mr <*> rr
+
+justRight ∷ Maybe (Either e α) → Maybe α
+justRight (Just (Right a)) = Just a
+justRight _                = Nothing
+
+instance MonadFinally μ ⇒ MonadFinally (AbortT e μ) where
+  finally' m f = AbortT $ do
+    (mr, fr) ← finally' (runAbortT m) (runAbortT . f . justRight)
+    return $ (,) <$> mr <*> fr
+  bracket' acquire release m = AbortT $ do
+    (mr, rr) ← bracket' (runAbortT acquire)
+                        (\case
+                          Right ar → runAbortT . release ar . justRight
+                          Left e → const (return (Left e)))
+                        (fmap join . mapM (runAbortT . m))
+    return $ (,) <$> mr <*> rr
+
+instance MonadFinally μ ⇒ MonadFinally (FinishT β μ) where
+  finally' m f = FinishT $ do
+    (mr, fr) ← finally' (runFinishT m) (runFinishT . f . justRight)
+    return $ (,) <$> mr <*> fr
+  bracket' acquire release m = FinishT $ do
+    (mr, rr) ← bracket' (runFinishT acquire)
+                        (\case
+                          Right ar → runFinishT . release ar . justRight
+                          Left e → const (return (Left e)))
+                        (fmap join . mapM (runFinishT . m))
+    return $ (,) <$> mr <*> rr
+
+instance (MonadFinally μ, Error e) ⇒ MonadFinally (ErrorT e μ) where
+  finally' m f = ErrorT $ do
+    (mr, fr) ← finally' (runErrorT m) (runErrorT . f . justRight)
+    return $ (,) <$> mr <*> fr
+  bracket' acquire release m = ErrorT $ do
+    (mr, rr) ← bracket' (runErrorT acquire)
+                        (\case
+                          Right ar → runErrorT . release ar . justRight
+                          Left e → const (return (Left e)))
+                        (fmap join . mapM (runErrorT . m))
+    return $ (,) <$> mr <*> rr
+
+instance MonadFinally μ ⇒ MonadFinally (ExceptT e μ) where
+  finally' m f = ExceptT $ do
+    (mr, fr) ← finally' (runExceptT m) (runExceptT . f . justRight)
+    return $ (,) <$> mr <*> fr
+  bracket' acquire release m = ExceptT $ do
+    (mr, rr) ← bracket' (runExceptT acquire)
+                        (\case
+                          Right ar → runExceptT . release ar . justRight
+                          Left e → const (return (Left e)))
+                        (fmap join . mapM (runExceptT . m))
+    return $ (,) <$> mr <*> rr
+
+instance MonadFinally μ ⇒ MonadFinally (ReaderT r μ) where
+  finally' m f = ReaderT $ \r →
+    finally' (runReaderT m r) ((`runReaderT` r) . f)
+  bracket' acquire release m = ReaderT $ \r →
+    bracket' (runReaderT acquire r)
+             (fmap (`runReaderT` r) . release)
+             ((`runReaderT` r) . m)
+
+instance MonadFinally μ ⇒ MonadFinally (L.StateT s μ) where
+  finally' m f = L.StateT $ \s → do
+    ~(~(mr, _), ~(fr, s'')) ← finally' (L.runStateT m s) $ \case
+      Just ~(a, s') → L.runStateT (f $ Just a) s'
+      Nothing       → L.runStateT (f Nothing) s
+    return ((mr, fr), s'')
+  bracket' acquire release m = L.StateT $ \s → do
+    ~(~(mr, _), ~(fr, s'')) ←
+      bracket' (L.runStateT acquire s)
+               (\ ~(ar, s') → \case
+                  Just ~(mr, s'') → L.runStateT (release ar (Just mr)) s''
+                  Nothing         → L.runStateT (release ar Nothing) s')
+               (\ ~(ar, s') → L.runStateT (m ar) s')
+    return ((mr, fr), s'')
+
+instance MonadFinally μ ⇒ MonadFinally (S.StateT s μ) where
+  finally' m f = S.StateT $ \s → do
+    ((mr, _), (fr, s''')) ← finally' (S.runStateT m s) $ \case
+      Just (a, s') → S.runStateT (f $ Just a) s'
+      Nothing      → S.runStateT (f Nothing) s
+    return ((mr, fr), s''')
+  bracket' acquire release m = S.StateT $ \s → do
+    ((mr, _), (fr, s''')) ←
+      bracket' (S.runStateT acquire s)
+               (\(ar, s') → \case
+                  Just ~(mr, s'') → S.runStateT (release ar (Just mr)) s''
+                  Nothing         → S.runStateT (release ar Nothing) s')
+               (\(ar, s') → S.runStateT (m ar) s')
+    return ((mr, fr), s''')
+
+instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (LW.WriterT w μ) where
+  finally' m f = LW.WriterT $ do
+    ~(~(mr, w), ~(fr, w')) ← finally' (LW.runWriterT m) $
+      LW.runWriterT . f . fmap fst
+    return ((mr, fr), w `mappend` w')
+  bracket' acquire release m = LW.WriterT $ do
+    ~(~(mr, w), ~(fr, w')) ←
+      bracket' (LW.runWriterT acquire)
+               (\ ~(ar, _) → \case
+                  Just ~(mr, _) → LW.runWriterT (release ar (Just mr))
+                  Nothing → LW.runWriterT (release ar Nothing))
+               (\ ~(ar, aw) → LW.runWriterT (LW.tell aw >> m ar))
+    return ((mr, fr), w `mappend` w')
+
+instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (SW.WriterT w μ) where
+  finally' m f = SW.WriterT $ do
+    ((mr, w), (fr, w')) ← finally' (SW.runWriterT m) $ \mbr → case mbr of
+      Just (a, _) → SW.runWriterT $ f $ Just a
+      Nothing     → SW.runWriterT $ f Nothing
+    return ((mr, fr), w `mappend` w')
+  bracket' acquire release m = SW.WriterT $ do
+    ((mr, w), (fr, w')) ←
+      bracket' (SW.runWriterT acquire)
+               (\(ar, _) → \case
+                  Just (mr, _) → SW.runWriterT (release ar (Just mr))
+                  Nothing → SW.runWriterT (release ar Nothing))
+               (\(ar, aw) → SW.runWriterT (SW.tell aw >> m ar))
+    return ((mr, fr), w `mappend` w')
+
+instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (L.RWST r w s μ) where
+  finally' m f = L.RWST $ \r s → do
+    ~(~(mr, _, w), ~(fr, s'', w')) ← finally' (L.runRWST m r s) $ \case
+      Just ~(mr, s', _) → L.runRWST (f $ Just mr) r s'
+      Nothing → L.runRWST (f Nothing) r s
+    return ((mr, fr), s'', w `mappend` w')
+  bracket' acquire release m = L.RWST $ \r s → do
+    ~(~(mr, _, w), ~(fr, s''', w')) ←
+      bracket' (L.runRWST acquire r s)
+               (\ ~(ar, s', _) → \case 
+                  Just ~(mr, s'', _) → L.runRWST (release ar $ Just mr) r s''
+                  Nothing → L.runRWST (release ar Nothing) r s')
+               (\ ~(ar, s', aw) → L.runRWST (L.tell aw >> m ar) r s')
+    return ((mr, fr), s''', w `mappend` w')
+
+instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (S.RWST r w s μ) where
+  finally' m f = S.RWST $ \r s → do
+    ((mr, _, w), (fr, s'', w')) ← finally' (S.runRWST m r s) $ \case
+      Just (a, s', _) → S.runRWST (f $ Just a) r s'
+      Nothing         → S.runRWST (f Nothing) r s
+    return ((mr, fr), s'', w `mappend` w')
+  bracket' acquire release m = S.RWST $ \r s → do
+    ((mr, _, w), (fr, s''', w')) ←
+      bracket' (S.runRWST acquire r s)
+               (\(ar, s', _) → \case 
+                  Just (mr, s'', _) → S.runRWST (release ar $ Just mr) r s''
+                  Nothing → S.runRWST (release ar Nothing) r s')
+               (\(ar, s', aw) → S.runRWST (S.tell aw >> m ar) r s')
+    return ((mr, fr), s''', w `mappend` w')
+
+-- | Run the provided list of cleanup actions sequentually, attempting to run
+-- the next action even if the previous one did not produce a result.
+chainCleanups ∷ MonadFinally μ ⇒ [μ α] → μ ()
+chainCleanups []       = return ()
+chainCleanups (m : ms) = finally (() <$ m) $ chainCleanups ms
+
+-- | A variant of 'finally' that combines multiple cleanup actions with
+-- 'chainCleanups'.
+finallyMany ∷ MonadFinally μ ⇒ μ α → [μ β] → μ α
+finallyMany m = finally m . chainCleanups
+{-# INLINE finallyMany #-}
+
+-- | @'onEscape' m c@ runs computation @m@ and then, if it did not produce
+-- a result, runs computation @c@.
+onEscape ∷ MonadFinally μ ⇒ μ α → μ β → μ α
+onEscape m f = fmap fst $ finally' m $ maybe (() <$ f) (const $ return ())
+{-# INLINE onEscape #-}
+
+-- | A variant of `onEscape` that combines multiple cleanup actions with
+-- 'chainCleanups'.
+onEscapeMany ∷ MonadFinally μ ⇒ μ α → [μ β] → μ α
+onEscapeMany m = onEscape m . chainCleanups
+
+-- | A variant of 'bracket' where acquired value is not needed (e.g. using
+-- a static resource).
+bracket_ ∷ MonadFinally μ
+         ⇒ μ r -- ^ Acquire resource
+         → μ β -- ^ Release resource
+         → μ α -- ^ Main computation
+         → μ α
+bracket_ acquire release = bracket acquire (const release) . const
+{-# INLINE bracket_ #-}
+
+-- | A variant of 'bracket' that releases the acquired resource only when
+-- the main computation does not produce a value.
+bracketOnEscape ∷ MonadFinally μ
+                ⇒ μ r       -- ^ Acquire resource
+                → (r → μ β) -- ^ Release resource
+                → (r → μ α) -- ^ Main computation
+                → μ α
+bracketOnEscape acquire release = fmap fst . bracket' acquire release'
+  where release' _  (Just _) = return Nothing
+        release' ar Nothing  = Just <$> release ar