diff --git a/Control/Exception/Control.hs b/Control/Exception/Control.hs
new file mode 100644
--- /dev/null
+++ b/Control/Exception/Control.hs
@@ -0,0 +1,303 @@
+{-# LANGUAGE CPP, UnicodeSyntax, NoImplicitPrelude, ExistentialQuantification #-}
+
+#if MIN_VERSION_base(4,3,0)
+{-# LANGUAGE RankNTypes #-} -- for mask
+#endif
+
+{- |
+Module      :  Control.Exception.Control
+Copyright   :  Bas van Dijk, Anders Kaseorg
+License     :  BSD-style
+
+Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>
+Stability   :  experimental
+Portability :  non-portable (extended exceptions)
+
+This is a wrapped version of @Control.Exception@ with types generalized
+from @IO@ to all monads in 'MonadControlIO'.
+-}
+
+module Control.Exception.Control
+    ( module Control.Exception
+
+      -- * Throwing exceptions
+    , throwIO, ioError
+
+      -- * Catching exceptions
+      -- ** The @catch@ functions
+    , catch, catches, Handler(..), catchJust
+
+      -- ** The @handle@ functions
+    , handle, handleJust
+
+      -- ** The @try@ functions
+    , try, tryJust
+
+      -- ** The @evaluate@ function
+    , evaluate
+
+      -- * Asynchronous Exceptions
+      -- ** Asynchronous exception control
+      -- |The following functions allow a thread to control delivery of
+      -- asynchronous exceptions during a critical region.
+#if MIN_VERSION_base(4,3,0)
+    , mask, mask_
+    , uninterruptibleMask, uninterruptibleMask_
+    , getMaskingState
+#else
+    , block, unblock
+#endif
+    , blocked
+
+      -- * Utilities
+    , bracket, bracket_, bracketOnError
+    , finally, onException
+    ) where
+
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+-- from base:
+import Data.Function   ( ($) )
+import Data.Either     ( Either(Left, Right) )
+import Data.Maybe      ( Maybe )
+import Data.Bool       ( Bool )
+import Control.Monad   ( Monad, (>>=), return, liftM )
+import System.IO.Error ( IOError )
+
+#if __GLASGOW_HASKELL__ < 700
+import Control.Monad   ( fail )
+#endif
+
+-- from base-unicode-symbols:
+import Data.Function.Unicode ( (∘) )
+
+-- from transformers:
+import Control.Monad.IO.Class ( MonadIO, liftIO )
+
+import Control.Exception hiding
+    ( throwIO, ioError
+    , catch, catches, Handler(..), catchJust
+    , handle, handleJust
+    , try, tryJust
+    , evaluate
+#if MIN_VERSION_base(4,3,0)
+    , mask, mask_
+    , uninterruptibleMask, uninterruptibleMask_
+    , getMaskingState
+#else
+    , block, unblock
+#endif
+    , blocked
+    , bracket, bracket_, bracketOnError
+    , finally, onException
+    )
+import qualified Control.Exception as E
+
+-- from monad-control (this package):
+import Control.Monad.IO.Control ( MonadControlIO
+                                , controlIO
+                                , liftIOOp_
+                                )
+
+
+--------------------------------------------------------------------------------
+-- * Throwing exceptions
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.throwIO'.
+throwIO ∷ (MonadIO m, Exception e) ⇒ e → m a
+throwIO = liftIO ∘ E.throwIO
+
+-- |Generalized version of 'E.ioError'.
+ioError ∷ MonadIO m ⇒ IOError → m a
+ioError = liftIO ∘ E.ioError
+
+
+--------------------------------------------------------------------------------
+-- * Catching exceptions
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.catch'.
+catch ∷ (MonadControlIO m, Exception e)
+      ⇒ m a       -- ^ The computation to run
+      → (e → m a) -- ^ Handler to invoke if an exception is raised
+      → m a
+catch a handler = controlIO $ \runInIO →
+                    E.catch (runInIO a)
+                            (\e → runInIO $ handler e)
+
+-- |Generalized version of 'E.catches'.
+catches ∷ MonadControlIO m ⇒ m a → [Handler m a] → m a
+catches a handlers = controlIO $ \runInIO →
+                       E.catches (runInIO a)
+                                 [ E.Handler $ \e → runInIO $ handler e
+                                 | Handler handler ← handlers
+                                 ]
+
+-- |Generalized version of 'E.Handler'.
+data Handler m a = ∀ e. Exception e ⇒ Handler (e → m a)
+
+-- |Generalized version of 'E.catchJust'.
+catchJust ∷ (MonadControlIO m, Exception e)
+          ⇒ (e → Maybe b) -- ^ Predicate to select exceptions
+          → m a           -- ^ Computation to run
+          → (b → m a)     -- ^ Handler
+          → m a
+catchJust p a handler = controlIO $ \runInIO →
+                          E.catchJust p
+                                      (runInIO a)
+                                      (\e → runInIO (handler e))
+
+
+--------------------------------------------------------------------------------
+--  ** The @handle@ functions
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.handle'.
+handle ∷ (MonadControlIO m, Exception e) ⇒ (e → m a) → m a → m a
+handle handler a = controlIO  $ \runInIO →
+                     E.handle (\e → runInIO (handler e))
+                              (runInIO a)
+
+-- |Generalized version of 'E.handleJust'.
+handleJust ∷ (MonadControlIO m, Exception e)
+           ⇒ (e → Maybe b) → (b → m a) → m a → m a
+handleJust p handler a = controlIO $ \runInIO →
+                           E.handleJust p (\e → runInIO (handler e))
+                                          (runInIO a)
+
+sequenceEither ∷ Monad m ⇒ Either e (m a) → m (Either e a)
+sequenceEither (Left e)  = return $ Left e
+sequenceEither (Right m) = liftM Right m
+
+
+--------------------------------------------------------------------------------
+-- ** The @try@ functions
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.try'.
+try ∷ (MonadControlIO m, Exception e) ⇒ m a → m (Either e a)
+try = liftIOOp_ (liftM sequenceEither ∘ E.try)
+
+-- |Generalized version of 'E.tryJust'.
+tryJust ∷ (MonadControlIO m, Exception e) ⇒
+           (e → Maybe b) → m a → m (Either b a)
+tryJust p = liftIOOp_ (liftM sequenceEither ∘ E.tryJust p)
+
+
+--------------------------------------------------------------------------------
+-- ** The @evaluate@ function
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.evaluate'.
+evaluate ∷ MonadIO m ⇒ a → m a
+evaluate = liftIO ∘ E.evaluate
+
+
+--------------------------------------------------------------------------------
+-- ** Asynchronous exception control
+--------------------------------------------------------------------------------
+
+#if MIN_VERSION_base(4,3,0)
+-- |Generalized version of 'E.mask'.
+mask ∷ MonadControlIO m ⇒ ((∀ a. m a → m a) → m b) → m b
+mask f = controlIO $ \runInIO →
+           E.mask $ \restore →
+             runInIO $ f $ liftIOOp_ restore
+
+-- |Generalized version of 'E.mask_'.
+mask_ ∷ MonadControlIO m ⇒ m a → m a
+mask_ = liftIOOp_ E.mask_
+
+-- |Generalized version of 'E.uninterruptibleMask'.
+uninterruptibleMask ∷ MonadControlIO m ⇒ ((∀ a. m a → m a) → m b) → m b
+uninterruptibleMask f = controlIO $ \runInIO →
+                          E.uninterruptibleMask $ \restore →
+                            runInIO $ f $ liftIOOp_ restore
+
+-- |Generalized version of 'E.uninterruptibleMask_'.
+uninterruptibleMask_ ∷ MonadControlIO m ⇒ m a → m a
+uninterruptibleMask_ = liftIOOp_ E.uninterruptibleMask_
+
+-- |Generalized version of 'E.getMaskingState'.
+getMaskingState ∷ MonadIO m ⇒ m MaskingState
+getMaskingState = liftIO E.getMaskingState
+#else
+-- |Generalized version of 'E.block'.
+block ∷ MonadControlIO m ⇒ m a → m a
+block = liftIOOp_ E.block
+
+-- |Generalized version of 'E.unblock'.
+unblock ∷ MonadControlIO m ⇒ m a → m a
+unblock = liftIOOp_ E.unblock
+#endif
+
+-- | Generalized version of 'E.blocked'.
+-- returns @True@ if asynchronous exceptions are blocked in the
+-- current thread.
+blocked ∷ MonadIO m ⇒ m Bool
+blocked = liftIO E.blocked
+
+
+--------------------------------------------------------------------------------
+-- * Utilities
+--------------------------------------------------------------------------------
+
+-- |Generalized version of 'E.bracket'.  Note, any monadic side
+-- effects in @m@ of the \"release\" computation will be discarded; it
+-- is run only for its side effects in @IO@.
+bracket ∷ MonadControlIO m
+        ⇒ m a       -- ^ computation to run first (\"acquire resource\")
+        → (a → m b) -- ^ computation to run last (\"release resource\")
+        → (a → m c) -- ^ computation to run in-between
+        → m c
+bracket before after thing = controlIO $ \runInIO →
+                               E.bracket (runInIO before)
+                                         (\m → runInIO $ m >>= after)
+                                         (\m → runInIO $ m >>= thing)
+
+-- |Generalized version of 'E.bracket_'.  Note, any monadic side
+-- effects in @m@ of /both/ the \"acquire\" and \"release\"
+-- computations will be discarded.  To keep the monadic side effects
+-- of the \"acquire\" computation, use 'bracket' with constant
+-- functions instead.
+bracket_ ∷ MonadControlIO m ⇒ m a → m b → m c → m c
+bracket_ before after thing = controlIO $ \runInIO →
+                                E.bracket_ (runInIO before)
+                                           (runInIO after)
+                                           (runInIO thing)
+
+-- |Generalized version of 'E.bracketOnError'.  Note, any monadic side
+-- effects in @m@ of the \"release\" computation will be discarded.
+bracketOnError ∷ MonadControlIO m
+               ⇒ m a       -- ^ computation to run first (\"acquire resource\")
+               → (a → m b) -- ^ computation to run last (\"release resource\")
+               → (a → m c) -- ^ computation to run in-between
+               → m c
+bracketOnError before after thing = controlIO $ \runInIO →
+                                      E.bracketOnError (runInIO before)
+                                                       (\m → runInIO $ m >>= after)
+                                                       (\m → runInIO $ m >>= thing)
+
+-- |Generalized version of 'E.finally'.  Note, any monadic side
+-- effects in @m@ of the \"afterward\" computation will be discarded.
+finally ∷ MonadControlIO m
+        ⇒ m a -- ^ computation to run first
+        → m b -- ^ computation to run afterward (even if an exception was raised)
+        → m a
+finally a sequel = controlIO $ \runInIO →
+                     E.finally (runInIO a)
+                               (runInIO sequel)
+
+-- |Generalized version of 'E.onException'.  Note, any monadic side
+-- effects in @m@ of the \"afterward\" computation will be discarded.
+onException ∷ MonadControlIO m ⇒ m a → m b → m a
+onException m what = controlIO $ \runInIO →
+                       E.onException (runInIO m)
+                                     (runInIO what)
+
+
+-- The End ---------------------------------------------------------------------
diff --git a/Control/Monad/IO/Control.hs b/Control/Monad/IO/Control.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/IO/Control.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, RankNTypes #-}
+
+{- |
+Module      :  Control.Monad.IO.Control
+Copyright   :  © Bas van Dijk, Anders Kaseorg, 2011
+License     :  BSD-style
+
+Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>
+Stability   :  experimental
+Portability :  Requires RankNTypes
+
+This module defines the class 'MonadControlIO' of 'IO'-based monads into
+which control operations on 'IO' (such as exception catching; see
+"Control.Exception.Control") can be lifted.
+
+'liftIOOp' and 'liftIOOp_' enable convenient lifting of two common
+special cases of control operation types.
+-}
+
+module Control.Monad.IO.Control
+    ( MonadControlIO(..)
+    , controlIO
+
+    , liftIOOp
+    , liftIOOp_
+    ) where
+
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+-- from base:
+import Data.Function ( ($) )
+import Data.Monoid   ( Monoid )
+import System.IO     ( IO )
+import Control.Monad ( join )
+
+-- from base-unicode-symbols:
+import Data.Function.Unicode ( (∘) )
+
+-- from transformers:
+import Control.Monad.IO.Class       ( MonadIO )
+
+import Control.Monad.Trans.Identity ( IdentityT )
+import Control.Monad.Trans.List     ( ListT )
+import Control.Monad.Trans.Maybe    ( MaybeT )
+import Control.Monad.Trans.Error    ( ErrorT, Error )
+import Control.Monad.Trans.Reader   ( ReaderT )
+import Control.Monad.Trans.State    ( StateT )
+import Control.Monad.Trans.Writer   ( WriterT )
+import Control.Monad.Trans.RWS      ( RWST )
+
+import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )
+import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
+import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST )
+
+-- from monad-control (this package):
+import Control.Monad.Trans.Control ( idLiftControl
+                                   , liftLiftControlBase
+                                   , RunInBase
+                                   )
+
+
+--------------------------------------------------------------------------------
+-- MonadControlIO
+--------------------------------------------------------------------------------
+
+-- |@MonadControlIO@ is the class of 'IO'-based monads supporting an
+-- extra operation 'liftControlIO', enabling control operations on 'IO' to be
+-- lifted into the monad.
+class MonadIO m ⇒ MonadControlIO m where
+  -- |@liftControlIO@ is a version of @liftControl@ that operates through an
+  -- arbitrary stack of monad transformers directly to an inner 'IO'
+  -- (analagously to how 'liftIO' is a version of @lift@).  So it can
+  -- be used to lift control operations on 'IO' into any
+  -- monad in 'MonadControlIO'.  For example:
+  --
+  -- @
+  -- foo :: 'IO' a -> 'IO' a
+  -- foo' :: 'MonadControlIO' m => m a -> m a
+  -- foo' a = 'controlIO' $ \runInIO ->    -- runInIO :: m a -> 'IO' (m a)
+  --            foo $ runInIO a         -- uses foo :: 'IO' (m a) -> 'IO' (m a)
+  -- @
+  liftControlIO ∷ (RunInBase m IO → IO b) → m b
+
+-- | An often used composition: @controlIO = 'join' . 'liftControlIO'@
+controlIO ∷ MonadControlIO m ⇒ (RunInBase m IO → IO (m b)) → m b
+controlIO = join ∘ liftControlIO
+
+
+--------------------------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------------------------
+
+instance MonadControlIO IO where
+    liftControlIO = idLiftControl
+
+instance MonadControlIO m ⇒ MonadControlIO (IdentityT m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance MonadControlIO m ⇒ MonadControlIO (ListT m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance MonadControlIO m ⇒ MonadControlIO (MaybeT m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance (Error e, MonadControlIO m) ⇒ MonadControlIO (ErrorT e m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance MonadControlIO m ⇒ MonadControlIO (ReaderT r m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance MonadControlIO m ⇒ MonadControlIO (StateT s m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance MonadControlIO m ⇒ MonadControlIO (Strict.StateT s m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance (Monoid w, MonadControlIO m) ⇒ MonadControlIO (WriterT w m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance (Monoid w, MonadControlIO m) ⇒ MonadControlIO (Strict.WriterT w m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance (Monoid w, MonadControlIO m) ⇒ MonadControlIO (RWST r w s m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+instance (Monoid w, MonadControlIO m) ⇒ MonadControlIO (Strict.RWST r w s m) where
+    liftControlIO = liftLiftControlBase liftControlIO
+
+
+--------------------------------------------------------------------------------
+-- Convenient lifting of two common special cases of control operation types
+--------------------------------------------------------------------------------
+
+-- |@liftIOOp@ is a particular application of 'liftControlIO' that allows
+-- lifting control operations of type @(a -> 'IO' b) -> 'IO' b@
+-- (e.g. @alloca@, @withMVar v@) to
+-- @'MonadControlIO' m => (a -> m b) -> m b@.
+--
+-- @liftIOOp f = \\g -> 'controlIO' $ \runInIO -> f $ runInIO . g@
+
+liftIOOp ∷ MonadControlIO m
+         ⇒ ((a → IO (m b)) → IO (m c))
+         → (a → m b) → m c
+liftIOOp f = \g → controlIO $ \runInIO → f $ runInIO ∘ g
+
+-- |@liftIOOp_@ is a particular application of 'liftControlIO' that allows
+-- lifting control operations of type @'IO' a -> 'IO' a@
+-- (e.g. @block@) to @'MonadControlIO' m => m a -> m a@.
+--
+-- @liftIOOp_ f = \\m -> 'controlIO' $ \runInIO -> f $ runInIO m@
+liftIOOp_ ∷ MonadControlIO m
+          ⇒ (IO (m a) → IO (m b))
+          → m a → m b
+liftIOOp_ f = \m → controlIO $ \runInIO → f $ runInIO m
+
+
+-- The End ---------------------------------------------------------------------
diff --git a/Control/Monad/Trans/Control.hs b/Control/Monad/Trans/Control.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Trans/Control.hs
@@ -0,0 +1,228 @@
+{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, RankNTypes #-}
+
+{- |
+Module      :  Control.Monad.Trans.Control
+Copyright   :  Bas van Dijk, Anders Kaseorg
+License     :  BSD-style
+
+Maintainer  :  Bas van Dijk <v.dijk.bas@gmail.com>
+Stability   :  experimental
+Portability :  Requires RankNTypes
+
+This module defines the class 'MonadTransControl' of monad transformers
+through which control operations can be lifted.  Instances are
+included for all the standard monad transformers from the
+@transformers@ library except @ContT@.
+
+'idLiftControl' and 'liftLiftControlBase' are provided to assist creation of
+@MonadControlIO@-like classes (see "Control.Monad.IO.Control") based on core
+monads other than 'IO'.
+-}
+
+module Control.Monad.Trans.Control
+    ( -- * MonadTransControl
+      MonadTransControl(..)
+    , Run
+    , control
+
+      -- * Lifting
+    , idLiftControl
+    , RunInBase
+    , liftLiftControlBase
+    ) where
+
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+-- from base:
+import Data.Function ( ($) )
+import Data.Monoid   ( Monoid, mempty )
+import Control.Monad ( Monad, join, return, liftM )
+
+-- from base-unicode-symbols:
+import Data.Function.Unicode ( (∘) )
+
+-- from transformers:
+import Control.Monad.Trans.Class    ( MonadTrans, lift )
+
+import Control.Monad.Trans.Identity ( IdentityT(IdentityT), runIdentityT )
+import Control.Monad.Trans.List     ( ListT    (ListT),     runListT )
+import Control.Monad.Trans.Maybe    ( MaybeT   (MaybeT),    runMaybeT )
+import Control.Monad.Trans.Error    ( ErrorT   (ErrorT),    runErrorT, Error )
+import Control.Monad.Trans.Reader   ( ReaderT  (ReaderT),   runReaderT )
+import Control.Monad.Trans.State    ( StateT   (StateT),    runStateT )
+import Control.Monad.Trans.Writer   ( WriterT  (WriterT),   runWriterT )
+import Control.Monad.Trans.RWS      ( RWST     (RWST),      runRWST )
+
+import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   (RWST),    runRWST )
+import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT (StateT),  runStateT )
+import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT(WriterT), runWriterT )
+
+
+--------------------------------------------------------------------------------
+-- MonadTransControl
+--------------------------------------------------------------------------------
+
+-- |@MonadTransControl@ is the class of monad transformers supporting an
+-- extra operation 'liftControl', enabling control operations (functions that
+-- use monadic actions as input instead of just output) to be lifted
+-- through the transformer.
+class MonadTrans t ⇒ MonadTransControl t where
+  -- |@liftControl@ is used to peel off the outer layer of a transformed
+  -- monadic action, allowing an transformed action @t m a@ to be
+  -- treated as a base action @m b@.
+  --
+  -- More precisely, @liftControl@ captures the monadic state of @t@ at the
+  -- point where it is bound (in @t n@), yielding a function of type
+  -- @'Run' t n o = t n a -> n (t o a)@
+  -- this function runs a transformed monadic action @t n a@
+  -- in the base monad @n@ using the captured state, and leaves the
+  -- result @t o a@ in the monad @n@ after all side effects in @n@
+  -- have occurred.
+  --
+  -- This can be used to lift control operations with types such as
+  -- @M a -> M a@ into the transformed monad @t M@:
+  --
+  -- @
+  -- instance Monad M
+  -- foo :: M a -> M a
+  -- foo' :: ('MonadTransControl' t, 'Monad' (t M)) => t M a -> t M a
+  -- foo' a = 'control' $ \run ->    -- run :: t M a -> M (t M a)
+  --            foo $ run a       -- uses foo :: M (t M a) -> M (t M a)
+  -- @
+  --
+  -- @liftControl@ is typically used with @m == n == o@, but is required to
+  -- be polymorphic for greater type safety: for example, this type
+  -- ensures that the result of running the action in @m@ has no
+  -- remaining side effects in @m@.
+  liftControl ∷ (Monad m, Monad n, Monad o) ⇒ (Run t n o → m a) → t m a
+
+type Run t n o = ∀ b. t n b → n (t o b)
+
+-- | An often used composition: @control = 'join' . 'liftControl'@
+control ∷ (Monad n, Monad m, Monad o, Monad (t m), MonadTransControl t)
+        ⇒ (Run t n o → m (t m a)) → t m a
+control = join ∘ liftControl
+
+
+--------------------------------------------------------------------------------
+-- Instances
+--------------------------------------------------------------------------------
+
+instance MonadTransControl IdentityT where
+    liftControl f = IdentityT $ f run
+        where
+          run t = liftM return (runIdentityT t)
+
+instance Error e ⇒
+         MonadTransControl (ErrorT e) where liftControl = liftControlNoState ErrorT runErrorT
+instance MonadTransControl ListT      where liftControl = liftControlNoState ListT  runListT
+instance MonadTransControl MaybeT     where liftControl = liftControlNoState MaybeT runMaybeT
+
+liftControlNoState ∷ (Monad m, Monad n, Monad o, Monad f)
+                   ⇒ (∀ a p. p (f a) → t p a)
+                   → (∀ a. t m a → m (f a))
+                   → (Run t m o → n b) → t n b
+liftControlNoState mkT runT = \f → mkT $ liftM return $ f run
+    where
+      run = liftM (mkT ∘ return) ∘ runT
+
+instance MonadTransControl (ReaderT r) where
+    liftControl f =
+        ReaderT $ \r →
+          let run t = liftM return (runReaderT t r)
+          in f run
+
+instance MonadTransControl (StateT s) where
+    liftControl f =
+        StateT $ \s →
+          let run t = liftM (\(x, s') → StateT $ \_ → return (x, s'))
+                            (runStateT t s)
+          in liftM (\x → (x, s)) (f run)
+
+instance MonadTransControl (Strict.StateT s) where
+    liftControl f =
+        Strict.StateT $ \s →
+          let run t = liftM (\(x, s') → Strict.StateT $ \_ → return (x, s'))
+                            (Strict.runStateT t s)
+          in liftM (\x → (x, s)) (f run)
+
+instance Monoid w ⇒ MonadTransControl (WriterT w) where
+    liftControl f = WriterT $ liftM (\x → (x, mempty)) (f run)
+        where
+          run t = liftM (WriterT ∘ return) (runWriterT t)
+
+instance Monoid w ⇒ MonadTransControl (Strict.WriterT w) where
+    liftControl f = Strict.WriterT $ liftM (\x → (x, mempty)) (f run)
+        where
+          run t = liftM (Strict.WriterT ∘ return) (Strict.runWriterT t)
+
+instance Monoid w ⇒ MonadTransControl (RWST r w s) where
+    liftControl f =
+        RWST $ \r s →
+          let run t = liftM (\(x, s', w) → RWST $ \_ _ → return (x, s', w))
+                            (runRWST t r s)
+          in liftM (\x → (x, s, mempty)) (f run)
+
+instance Monoid w ⇒ MonadTransControl (Strict.RWST r w s) where
+    liftControl f =
+        Strict.RWST $ \r s →
+          let run t = liftM (\(x, s', w) → Strict.RWST $ \_ _ → return (x, s', w))
+                            (Strict.runRWST t r s)
+          in liftM (\x → (x, s, mempty)) (f run)
+
+
+--------------------------------------------------------------------------------
+-- Lifting
+--------------------------------------------------------------------------------
+
+-- |@idLiftControl@ acts as the \"identity\" 'liftControl' operation from a monad
+-- @m@ to itself.
+--
+-- @idLiftControl f = f $ liftM return@
+--
+-- It serves as the base case for a class like @MonadControlIO@, which
+-- allows control operations in some base monad (here @IO@) to be
+-- lifted through arbitrary stacks of zero or more monad transformers
+-- in one call.  For example, "Control.Monad.IO.Control" defines
+--
+-- @
+-- class MonadIO m => MonadControlIO m where
+--     liftControlIO :: (RunInBase m IO -> IO b) -> m b
+-- @
+--
+-- @
+-- instance MonadControlIO IO where
+--     liftControlIO = idLiftControl
+-- @
+idLiftControl ∷ Monad m ⇒ ((∀ b. m b → m (m b)) → m a) → m a
+idLiftControl f = f $ liftM return
+
+type RunInBase m base = ∀ b. m b → base (m b)
+
+-- |@liftLiftControlBase@ is used to compose two 'liftControl' operations:
+-- the outer provided by a 'MonadTransControl' instance,
+-- and the inner provided as the argument.
+--
+-- It satisfies @'liftLiftControlBase' 'idLiftControl' == 'liftControl'@.
+--
+-- It serves as the induction step of a @MonadControlIO@-like class.  For
+-- example, "Control.Monad.IO.Control" defines
+--
+-- @
+-- instance MonadControlIO m => MonadControlIO (StateT s m) where
+--     liftControlIO = liftLiftControlBase liftControlIO
+-- @
+--
+-- using the 'MonadTransControl' instance of @'StateT' s@.
+liftLiftControlBase ∷ (MonadTransControl t, Monad base, Monad m, Monad (t m))
+                    ⇒ ((RunInBase m     base → base a) →   m a) -- ^ @liftControlBase@ operation
+                    → ((RunInBase (t m) base → base a) → t m a)
+liftLiftControlBase lftCtrlBase = \f → liftControl $ \run →
+                                         lftCtrlBase $ \runInBase →
+                                           f $ liftM (join ∘ lift) ∘ runInBase ∘ run
+
+
+-- The End ---------------------------------------------------------------------
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+Copyright © 2010, Bas van Dijk, Anders Kaseorg
+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 name of the author nor the names of other 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
+HOLDER 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,62 @@
+#! /usr/bin/env runhaskell
+
+{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}
+
+module Main (main) where
+
+
+-------------------------------------------------------------------------------
+-- Imports
+-------------------------------------------------------------------------------
+
+-- from base
+import Control.Monad       ( (>>), return )
+import Data.Bool           ( Bool )
+import System.Cmd          ( system )
+import System.FilePath     ( (</>) )
+import System.IO           ( IO )
+
+-- from cabal
+import Distribution.Simple ( defaultMainWithHooks
+                           , simpleUserHooks
+                           , UserHooks(runTests, haddockHook)
+                           , Args
+                           )
+
+import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
+import Distribution.Simple.Program        ( userSpecifyArgs )
+import Distribution.Simple.Setup          ( HaddockFlags )
+import Distribution.PackageDescription    ( PackageDescription(..) )
+
+
+-------------------------------------------------------------------------------
+-- Cabal setup program with support for 'cabal test' and
+-- which sets the CPP define '__HADDOCK __' when haddock is run.
+-------------------------------------------------------------------------------
+
+main ∷ IO ()
+main = defaultMainWithHooks hooks
+  where
+    hooks = simpleUserHooks
+            { runTests    = runTests'
+            , haddockHook = haddockHook'
+            }
+
+-- Run a 'test' binary that gets built when configured with '-ftest'.
+runTests' ∷ Args → Bool → PackageDescription → LocalBuildInfo → IO ()
+runTests' _ _ _ _ = system testcmd >> return ()
+  where testcmd = "."
+                  </> "dist"
+                  </> "build"
+                  </> "test-monad-control"
+                  </> "test-monad-control"
+
+-- Define __HADDOCK__ for CPP when running haddock.
+haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO ()
+haddockHook' pkg lbi =
+  haddockHook simpleUserHooks pkg (lbi { withPrograms = p })
+  where
+    p = userSpecifyArgs "haddock" ["--optghc=-D__HADDOCK__"] (withPrograms lbi)
+
+
+-- The End ---------------------------------------------------------------------
diff --git a/monad-control.cabal b/monad-control.cabal
new file mode 100644
--- /dev/null
+++ b/monad-control.cabal
@@ -0,0 +1,84 @@
+Name:                monad-control
+Version:             0.1
+Synopsis:            Lift control operations, like exception catching, through monad transformers
+Description:
+  This package defines the type class @MonadControlIO@, a subset of
+  @MonadIO@ into which generic control operations such as @catch@ can
+  be lifted from @IO@.  Instances are based on monad transformers in
+  @MonadTransControl@, which includes all standard monad transformers
+  in the @transformers@ library except @ContT@.  For convenience, it
+  provides a wrapped version of @Control.Exception@ with types
+  generalized from @IO@ to all monads in @MonadControlIO@.
+  .
+  Note that this package is a rewrite of Anders Kaseorg's @monad-peel@ library.
+  The main difference is that this package provides CPS style
+  operators and exploits the @RankNTypes@ language extension to
+  simplify most definitions.
+  .
+  The package includes a copy of the @monad-peel@ testsuite written by Anders Kaseorg.
+  The tests can be performed by using @cabal test@.
+  .
+  The following @critertion@ based benchmark shows that @monad-control@ is about
+  2 times faster than @monad-peel@:
+  .
+  <http://code.haskell.org/~basvandijk/code/bench-monad-peel-control>
+
+License:             BSD3
+License-file:        LICENSE
+Author:              Bas van Dijk, Anders Kaseorg
+Maintainer:          Bas van Dijk <v.dijk.bas@gmail.com>
+Copyright:           (c) 2011 Bas van Dijk, Anders Kaseorg
+Category:            Control
+Build-type:          Custom
+Cabal-version:       >= 1.6
+
+--------------------------------------------------------------------------------
+
+source-repository head
+  type:     darcs
+  location: http://code.haskell.org/~basvandijk/code/monad-control
+
+--------------------------------------------------------------------------------
+
+flag test
+  description: Build the testing suite
+  default:     False
+
+flag hpc
+  description: Enable program coverage on test executable
+  default:     False
+
+--------------------------------------------------------------------------------
+
+Library
+  Exposed-modules: Control.Monad.Trans.Control
+                   Control.Monad.IO.Control
+                   Control.Exception.Control
+
+  Build-depends: base                 >= 3     && < 4.4
+               , base-unicode-symbols >= 0.1.1 && < 0.3
+               , transformers         >= 0.2   && < 0.3
+
+  Ghc-options: -Wall
+
+--------------------------------------------------------------------------------
+
+executable test-monad-control
+  main-is: test.hs
+
+  ghc-options: -Wall
+
+  if flag(test)
+    build-depends: base                 >= 3     && < 4.4
+                 , base-unicode-symbols >= 0.1.1 && < 0.3
+                 , HUnit                >= 1.2.2 && < 1.3
+                 , test-framework       >= 0.2.4 && < 0.4
+                 , test-framework-hunit >= 0.2.4 && < 0.3
+    buildable: True
+  else
+    buildable: False
+
+  if flag(hpc)
+    ghc-options: -fhpc
+
+--------------------------------------------------------------------------------
diff --git a/test.hs b/test.hs
new file mode 100644
--- /dev/null
+++ b/test.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- from base:
+import Prelude hiding (catch)
+import Data.IORef
+import Data.Maybe
+import Data.Typeable (Typeable)
+
+-- from transformers:
+import Control.Monad.IO.Class (liftIO)
+
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.List
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Writer
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.State
+import qualified Control.Monad.Trans.RWS as RWS
+
+-- from monad-control (this package):
+import Control.Exception.Control
+import Control.Monad.IO.Control (MonadControlIO)
+
+-- from test-framework:
+import Test.Framework (defaultMain, testGroup, Test)
+
+ -- from test-framework-hunit:
+import Test.Framework.Providers.HUnit
+
+-- from hunit:
+import Test.HUnit hiding (Test)
+
+
+main :: IO ()
+main = defaultMain
+    [ testSuite "IdentityT" runIdentityT
+    , testSuite "ListT" $ fmap head . runListT
+    , testSuite "MaybeT" $ fmap fromJust . runMaybeT
+    , testSuite "ReaderT" $ flip runReaderT "reader state"
+    , testSuite "WriterT" runWriterT'
+    , testSuite "ErrorT" runErrorT'
+    , testSuite "StateT" $ flip evalStateT "state state"
+    , testSuite "RWST" $ \m -> runRWST' m "RWS in" "RWS state"
+    , testCase "ErrorT throwError" case_throwError
+    , testCase "WriterT tell" case_tell
+    ]
+  where
+    runWriterT' :: Functor m => WriterT [Int] m a -> m a
+    runWriterT' = fmap fst . runWriterT
+    runErrorT' :: Functor m => ErrorT String m () -> m ()
+    runErrorT' = fmap (either (const ()) id) . runErrorT
+    runRWST' :: (Monad m, Functor m) => RWS.RWST r [Int] s m a -> r -> s -> m a
+    runRWST' m r s = fmap fst $ RWS.evalRWST m r s
+
+testSuite :: MonadControlIO m => String -> (m () -> IO ()) -> Test
+testSuite s run = testGroup s
+    [ testCase "finally" $ case_finally run
+    , testCase "catch" $ case_catch run
+    , testCase "bracket" $ case_bracket run
+    , testCase "bracket_" $ case_bracket_ run
+    , testCase "onException" $ case_onException run
+    ]
+
+ignore :: IO () -> IO ()
+ignore x =
+    catch x go
+  where
+    go :: SomeException -> IO ()
+    go _ = return ()
+
+data Exc = Exc
+    deriving (Show, Typeable)
+instance Exception Exc
+
+one :: Int
+one = 1
+
+case_finally :: MonadControlIO m => (m () -> IO ()) -> Assertion
+case_finally run = do
+    i <- newIORef one
+    ignore
+        (run $ (do
+            liftIO $ writeIORef i 2
+            error "error") `finally` (liftIO $ writeIORef i 3))
+    j <- readIORef i
+    j @?= 3
+
+case_catch :: MonadControlIO m => (m () -> IO ()) -> Assertion
+case_catch run = do
+    i <- newIORef one
+    run $ (do
+        liftIO $ writeIORef i 2
+        throw Exc) `catch` (\Exc -> liftIO $ writeIORef i 3)
+    j <- readIORef i
+    j @?= 3
+
+case_bracket :: MonadControlIO m => (m () -> IO ()) -> Assertion
+case_bracket run = do
+    i <- newIORef one
+    ignore $ run $ bracket
+        (liftIO $ writeIORef i 2)
+        (\() -> liftIO $ writeIORef i 4)
+        (\() -> liftIO $ writeIORef i 3)
+    j <- readIORef i
+    j @?= 4
+
+case_bracket_ :: MonadControlIO m => (m () -> IO ()) -> Assertion
+case_bracket_ run = do
+    i <- newIORef one
+    ignore $ run $ bracket_
+        (liftIO $ writeIORef i 2)
+        (liftIO $ writeIORef i 4)
+        (liftIO $ writeIORef i 3)
+    j <- readIORef i
+    j @?= 4
+
+case_onException :: MonadControlIO m => (m () -> IO ()) -> Assertion
+case_onException run = do
+    i <- newIORef one
+    ignore $ run $ onException
+        (liftIO (writeIORef i 2) >> error "ignored")
+        (liftIO $ writeIORef i 3)
+    j <- readIORef i
+    j @?= 3
+    ignore $ run $ onException
+        (liftIO $ writeIORef i 4)
+        (liftIO $ writeIORef i 5)
+    k <- readIORef i
+    k @?= 4
+
+case_throwError :: Assertion
+case_throwError = do
+    i <- newIORef one
+    Left "throwError" <- runErrorT $
+        (liftIO (writeIORef i 2) >> throwError "throwError")
+        `finally`
+        (liftIO $ writeIORef i 3)
+    j <- readIORef i
+    j @?= 3
+
+case_tell :: Assertion
+case_tell = do
+    i <- newIORef one
+    ((), w) <- runWriterT $ bracket_
+        (liftIO (writeIORef i 2) >> tell [1 :: Int])
+        (liftIO (writeIORef i 4) >> tell [3])
+        (liftIO (writeIORef i 3) >> tell [2])
+    j <- readIORef i
+    j @?= 4
+    w @?= [2]
+
+    ((), w') <- runWriterT $ bracket
+        (liftIO (writeIORef i 5) >> tell [5 :: Int])
+        (const $ liftIO (writeIORef i 7) >> tell [7])
+        (const $ liftIO (writeIORef i 6) >> tell [6])
+    j' <- readIORef i
+    j' @?= 7
+    w' @?= [5, 6]