monad-control 0.2.0.3 → 0.3

raw patch · 8 files changed

+365/−980 lines, 8 filesdep +transformers-basedep −HUnitdep −test-frameworkdep −test-framework-hunitdep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers-base

Dependencies removed: HUnit, test-framework, test-framework-hunit

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Control/Exception/Control.hs +0/−362
• Control/Monad/IO/Control.hs +0/−180
• Control/Monad/Trans/Control.hs +329/−184
• NEWS +8/−0
• README.markdown +1/−3
• Setup.hs +2/−44
• monad-control.cabal +25/−48
• test.hs +0/−159

@@ -1,362 +0,0 @@-{-# 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--#if !MIN_VERSION_base(4,4,0)-    , blocked-#endif-      -- * Brackets-    , bracket, bracket_, bracketOnError--      -- * Utilities-    , finally, onException-    ) where-------------------------------------------------------------------------------------- Imports------------------------------------------------------------------------------------- from base:-import Data.Function   ( ($) )-import Data.Either     ( Either(Left, Right), either )-import Data.Maybe      ( Maybe )-import Control.Monad   ( Monad, (>>=), return, liftM )-import System.IO.Error ( IOError )--#if MIN_VERSION_base(4,3,0) || defined (__HADDOCK__)-import System.IO       ( IO )-#endif--#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-#if !MIN_VERSION_base(4,4,0)-    , blocked-#endif-    , bracket, bracket_, bracketOnError-    , finally, onException-    )-import qualified Control.Exception as E--#if !MIN_VERSION_base(4,4,0)-import Data.Bool ( Bool )-#endif---- from monad-control (this package):-import Control.Monad.IO.Control ( MonadControlIO-                                , controlIO-                                , liftIOOp_-                                )-#if MIN_VERSION_base(4,3,0) || defined (__HADDOCK__)-import Control.Monad.IO.Control ( liftIOOp )-#endif------------------------------------------------------------------------------------- * Throwing exceptions------------------------------------------------------------------------------------- |Generalized version of 'E.throwIO'.-throwIO ∷ (MonadIO m, Exception e) ⇒ e → m α-throwIO = liftIO ∘ E.throwIO---- |Generalized version of 'E.ioError'.-ioError ∷ MonadIO m ⇒ IOError → m α-ioError = liftIO ∘ E.ioError-------------------------------------------------------------------------------------- * Catching exceptions------------------------------------------------------------------------------------- |Generalized version of 'E.catch'.-{-# INLINABLE catch #-}-catch ∷ (MonadControlIO m, Exception e)-      ⇒ m α       -- ^ The computation to run-      → (e → m α) -- ^ Handler to invoke if an exception is raised-      → m α-catch a handler = controlIO $ \runInIO →-                    E.catch (runInIO a)-                            (\e → runInIO $ handler e)---- |Generalized version of 'E.catches'.-{-# INLINABLE catches #-}-catches ∷ MonadControlIO m ⇒ m α → [Handler m α] → m α-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 α = ∀ e. Exception e ⇒ Handler (e → m α)---- |Generalized version of 'E.catchJust'.-{-# INLINABLE catchJust #-}-catchJust ∷ (MonadControlIO m, Exception e)-          ⇒ (e → Maybe β) -- ^ Predicate to select exceptions-          → m α           -- ^ Computation to run-          → (β → m α)     -- ^ Handler-          → m α-catchJust p a handler = controlIO $ \runInIO →-                          E.catchJust p-                                      (runInIO a)-                                      (\e → runInIO (handler e))--------------------------------------------------------------------------------------  ** The @handle@ functions------------------------------------------------------------------------------------- |Generalized version of 'E.handle'.-{-# INLINABLE handle #-}-handle ∷ (MonadControlIO m, Exception e) ⇒ (e → m α) → m α → m α-handle handler a = controlIO  $ \runInIO →-                     E.handle (\e → runInIO (handler e))-                              (runInIO a)---- |Generalized version of 'E.handleJust'.-{-# INLINABLE handleJust #-}-handleJust ∷ (MonadControlIO m, Exception e)-           ⇒ (e → Maybe β) → (β → m α) → m α → m α-handleJust p handler a = controlIO $ \runInIO →-                           E.handleJust p (\e → runInIO (handler e))-                                          (runInIO a)-------------------------------------------------------------------------------------- ** The @try@ functions-----------------------------------------------------------------------------------sequenceEither ∷ Monad m ⇒ Either e (m α) → m (Either e α)-sequenceEither = either (return ∘ Left) (liftM Right)---- |Generalized version of 'E.try'.-{-# INLINABLE try #-}-try ∷ (MonadControlIO m, Exception e) ⇒ m α → m (Either e α)-try = liftIOOp_ (liftM sequenceEither ∘ E.try)---- |Generalized version of 'E.tryJust'.-{-# INLINABLE tryJust #-}-tryJust ∷ (MonadControlIO m, Exception e) ⇒-           (e → Maybe β) → m α → m (Either β α)-tryJust p = liftIOOp_ (liftM sequenceEither ∘ E.tryJust p)-------------------------------------------------------------------------------------- ** The @evaluate@ function------------------------------------------------------------------------------------- |Generalized version of 'E.evaluate'.-evaluate ∷ MonadIO m ⇒ α → m α-evaluate = liftIO ∘ E.evaluate-------------------------------------------------------------------------------------- ** Asynchronous exception control-----------------------------------------------------------------------------------#if MIN_VERSION_base(4,3,0)--- |Generalized version of 'E.mask'.-{-# INLINABLE mask #-}-mask ∷ MonadControlIO m ⇒ ((∀ α. m α → m α) → m β) → m β-mask = liftIOOp E.mask ∘ liftRestore--liftRestore ∷ MonadControlIO m-            ⇒ ((∀ α.  m α →  m α) → β)-            → ((∀ α. IO α → IO α) → β)-liftRestore f restore = f $ liftIOOp_ restore---- |Generalized version of 'E.mask_'.-{-# INLINABLE mask_ #-}-mask_ ∷ MonadControlIO m ⇒ m α → m α-mask_ = liftIOOp_ E.mask_---- |Generalized version of 'E.uninterruptibleMask'.-{-# INLINABLE uninterruptibleMask #-}-uninterruptibleMask ∷ MonadControlIO m ⇒ ((∀ α. m α → m α) → m β) → m β-uninterruptibleMask = liftIOOp E.uninterruptibleMask ∘ liftRestore---- |Generalized version of 'E.uninterruptibleMask_'.-{-# INLINABLE uninterruptibleMask_ #-}-uninterruptibleMask_ ∷ MonadControlIO m ⇒ m α → m α-uninterruptibleMask_ = liftIOOp_ E.uninterruptibleMask_---- |Generalized version of 'E.getMaskingState'.-getMaskingState ∷ MonadIO m ⇒ m MaskingState-getMaskingState = liftIO E.getMaskingState-#else--- |Generalized version of 'E.block'.-{-# INLINABLE block #-}-block ∷ MonadControlIO m ⇒ m α → m α-block = liftIOOp_ E.block---- |Generalized version of 'E.unblock'.-{-# INLINABLE unblock #-}-unblock ∷ MonadControlIO m ⇒ m α → m α-unblock = liftIOOp_ E.unblock-#endif--#if !MIN_VERSION_base(4,4,0)--- | 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-#endif-------------------------------------------------------------------------------------- * Brackets------------------------------------------------------------------------------------- |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@.------ Note that when your @acquire@ and @release@ computations are of type 'IO'--- it will be more efficient to write:------ @'liftIOOp' ('E.bracket' acquire release)@-{-# INLINABLE bracket #-}-bracket ∷ MonadControlIO m-        ⇒ m α       -- ^ computation to run first (\"acquire resource\")-        → (α → m β) -- ^ computation to run last (\"release resource\")-        → (α → m γ) -- ^ computation to run in-between-        → m γ-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.------ Note that when your @acquire@ and @release@ computations are of type 'IO'--- it will be more efficient to write:------ @'liftIOOp_' ('E.bracket_' acquire release)@-{-# INLINABLE bracket_ #-}-bracket_ ∷ MonadControlIO m-         ⇒ m α -- ^ computation to run first (\"acquire resource\")-         → m β -- ^ computation to run last (\"release resource\")-         → m γ -- ^ computation to run in-between-         → m γ-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.------ Note that when your @acquire@ and @release@ computations are of type 'IO'--- it will be more efficient to write:------ @'liftIOOp' ('E.bracketOnError' acquire release)@-{-# INLINABLE bracketOnError #-}-bracketOnError ∷ MonadControlIO m-               ⇒ m α       -- ^ computation to run first (\"acquire resource\")-               → (α → m β) -- ^ computation to run last (\"release resource\")-               → (α → m γ) -- ^ computation to run in-between-               → m γ-bracketOnError before after thing = controlIO $ \runInIO →-                                      E.bracketOnError (runInIO before)-                                                       (\m → runInIO $ m >>= after)-                                                       (\m → runInIO $ m >>= thing)-------------------------------------------------------------------------------------- * Utilities------------------------------------------------------------------------------------- |Generalized version of 'E.finally'.  Note, any monadic side--- effects in @m@ of the \"afterward\" computation will be discarded.-{-# INLINABLE finally #-}-finally ∷ MonadControlIO m-        ⇒ m α -- ^ computation to run first-        → m β -- ^ computation to run afterward (even if an exception was raised)-        → m α-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.-{-# INLINABLE onException #-}-onException ∷ MonadControlIO m ⇒ m α → m β → m α-onException m what = controlIO $ \runInIO →-                       E.onException (runInIO m)-                                     (runInIO what)----- The End ---------------------------------------------------------------------

@@ -1,180 +0,0 @@-{-# 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)-  @--  Instances should satisfy similar laws as the 'MonadIO' laws:--  @liftControlIO . const . return = return@--  @liftControlIO (const (m >>= f)) = liftControlIO (const m) >>= liftControlIO . const . f@--  Additionally instances should satisfy:--  @'controlIO' $ \\runInIO -> runInIO m = m@-  -}-  liftControlIO ∷ (RunInBase m IO → IO α) → m α---- | An often used composition: @controlIO = 'join' . 'liftControlIO'@-{-# INLINABLE controlIO #-}-controlIO ∷ MonadControlIO m ⇒ (RunInBase m IO → IO (m α)) → m α-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@--}-{-# INLINABLE liftIOOp #-}-liftIOOp ∷ MonadControlIO m-         ⇒ ((α → IO (m β)) → IO (m γ))-         → ((α →     m β)  →     m γ)-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@--}-{-# INLINABLE liftIOOp_ #-}-liftIOOp_ ∷ MonadControlIO m-          ⇒ (IO (m α) → IO (m β))-          → (    m α →      m β)-liftIOOp_ f = \m → controlIO $ \runInIO → f $ runInIO m----- The End ---------------------------------------------------------------------

@@ -1,4 +1,12 @@-{-# LANGUAGE UnicodeSyntax, NoImplicitPrelude, RankNTypes #-}+{-# LANGUAGE CPP+           , UnicodeSyntax+           , NoImplicitPrelude+           , RankNTypes+           , TypeFamilies+           , FunctionalDependencies+           , FlexibleInstances+           , UndecidableInstances+  #-}  {- | Module      :  Control.Monad.Trans.Control@@ -7,28 +15,29 @@  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'.+(TODO: It would be nicer if the associated /data types/ 'StT' and 'StM' were+associated /type synonyms/ instead. This would simplify a lot of code and could+make some definitions more efficient because there'll be no need to wrap the+monadic state in a data type. Unfortunately GHC has a bug which prevents this:+<http://hackage.haskell.org/trac/ghc/ticket/5595>. I will switch to associated+type synonyms when that bug is fixed.) -}  module Control.Monad.Trans.Control-    ( -- * MonadTransControl-      MonadTransControl(..)-    , Run+    ( MonadTransControl(..), Run+    , MonadBaseControl (..), RunInBase++      -- * Defaults for MonadBaseControl+      -- $defaults+    , ComposeSt, defaultLiftBaseWith, defaultRestoreM++      -- * Utility functions     , control -      -- * Lifting-    , idLiftControl-    , RunInBase-    , liftLiftControlBase+    , liftBaseOp, liftBaseOp_++    , liftBaseDiscard     ) where  @@ -37,15 +46,23 @@ --------------------------------------------------------------------------------  -- from base:-import Data.Function ( ($) )+import Data.Function ( ($), const ) import Data.Monoid   ( Monoid, mempty )-import Control.Monad ( Monad, join, return, liftM )+import Control.Monad ( Monad, (>>=), return, liftM, void ) +import System.IO                       ( IO )+import GHC.Conc.Sync                   ( STM )+import Data.Maybe                      ( Maybe )+import Data.Either                     ( Either )++import           Control.Monad.ST.Lazy             ( ST )+import qualified Control.Monad.ST.Strict as Strict ( ST )+ -- from base-unicode-symbols: import Data.Function.Unicode ( (∘) )  -- from transformers:-import Control.Monad.Trans.Class    ( MonadTrans, lift )+import Control.Monad.Trans.Class    ( MonadTrans )  import Control.Monad.Trans.Identity ( IdentityT(IdentityT), runIdentityT ) import Control.Monad.Trans.List     ( ListT    (ListT),     runListT )@@ -60,216 +77,344 @@ import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT (StateT),  runStateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT(WriterT), runWriterT ) +import Data.Functor.Identity ( Identity ) +-- from transformers-base:+import Control.Monad.Base ( MonadBase )++ ----------------------------------------------------------------------------------- MonadTransControl+-- MonadTransControl type class -------------------------------------------------------------------------------- -{-|-@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 a@.--  More precisely, @liftControl@ captures the monadic state of @t@ at the-  point where it is bound (in @t m@), yielding a function of type:--  @'Run' t = forall n o b. (Monad n, Monad o) => t n b -> n (t o b)@--  This function runs a transformed monadic action @t n b@-  in the inner monad @n@ using the captured state, and leaves the-  result @t o b@ 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)-  @--  Instances should satisfy similar laws as the 'MonadTrans' laws:--  @liftControl . const . return = return@--  @liftControl (const (m >>= f)) = liftControl (const m) >>= liftControl . const . f@--  Additionally instances should satisfy:+  -- | Monadic state of @t@.+  data StT t ∷ * → * -  @'control' $ \\run -> run t = t@-  -}-  liftControl ∷ Monad m ⇒ (Run t → m α) → t m α+  -- | @liftWith@ is similar to 'lift' in that it lifts a computation from+  -- the argument monad to the constructed monad.+  --+  -- Instances should satisfy similar laws as the 'MonadTrans' laws:+  --+  -- @liftWith . const . return = return@+  --+  -- @liftWith (const (m >>= f)) = liftWith (const m) >>= liftWith . const . f@+  --+  -- The difference with 'lift' is that before lifting the @m@ computation+  -- @liftWith@ captures the state of @t@. It then provides the @m@+  -- computation with a 'Run' function that allows running @t n@ computations in+  -- @n@ (for all @n@) on the captured state.+  liftWith ∷ Monad m ⇒ (Run t → m α) → t m α -type Run t = ∀ n o β-           . (Monad n, Monad o, Monad (t o))-           ⇒ t n β → n (t o β)+  -- | Construct a @t@ computation from the monadic state of @t@ that is+  -- returned from a 'Run' function.+  --+  -- Instances should satisfy:+  --+  -- @liftWith (\\run -> run t) >>= restoreT . return = t@+  restoreT ∷ Monad m ⇒ m (StT t α) → t m α --- | An often used composition: @control = 'join' . 'liftControl'@-control ∷ (Monad m, Monad (t m), MonadTransControl t)-        ⇒ (Run t → m (t m α)) → t m α-control = join ∘ liftControl+-- | A function that runs a transformed monad @t n@ on the monadic state that+-- was captured by 'liftWith'+--+-- A @Run t@ function yields a computation in @n@ that returns the monadic state+-- of @t@. This state can later be used to restore a @t@ computation using+-- 'restoreT'.+type Run t = ∀ n β. Monad n ⇒ t n β → n (StT t β)   ----------------------------------------------------------------------------------- Instances+-- MonadTransControl instances --------------------------------------------------------------------------------  instance MonadTransControl IdentityT where-    liftControl f = IdentityT $ f run-        where-          run t = liftM return (runIdentityT t)+    newtype StT IdentityT α = StId {unStId ∷ α}+    liftWith f = IdentityT $ f $ liftM StId ∘ runIdentityT+    restoreT = IdentityT ∘ liftM unStId+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-} -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+instance MonadTransControl MaybeT where+    newtype StT MaybeT α = StMaybe {unStMaybe ∷ Maybe α}+    liftWith f = MaybeT $ liftM return $ f $ liftM StMaybe ∘ runMaybeT+    restoreT = MaybeT ∘ liftM unStMaybe+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-} -liftControlNoState ∷ (Monad m, Monad f)-                   ⇒ (∀ p β. p (f β) → t p β)-                   → (∀ n β. t n β → n (f β))-                   → ((Run t → m α) → t m α)-liftControlNoState mkT runT = \f → mkT $ liftM return $ f $-                                     liftM (mkT ∘ return) ∘ runT+instance Error e ⇒ MonadTransControl (ErrorT e) where+    newtype StT (ErrorT e) α = StError {unStError ∷ Either e α}+    liftWith f = ErrorT $ liftM return $ f $ liftM StError ∘ runErrorT+    restoreT = ErrorT ∘ liftM unStError+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-} +instance MonadTransControl ListT where+    newtype StT ListT α = StList {unStList ∷ [α]}+    liftWith f = ListT $ liftM return $ f $ liftM StList ∘ runListT+    restoreT = ListT ∘ liftM unStList+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}+ instance MonadTransControl (ReaderT r) where-    liftControl f =-        ReaderT $ \r →-          let run t = liftM return (runReaderT t r)-          in f run+    newtype StT (ReaderT r) α = StReader {unStReader ∷ α}+    liftWith f = ReaderT $ \r → f $ \t → liftM StReader $ runReaderT t r+    restoreT = ReaderT ∘ const ∘ liftM unStReader+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  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)+    newtype StT (StateT s) α = StState {unStState ∷ (α, s)}+    liftWith f = StateT $ \s →+                   liftM (\x → (x, s))+                         (f $ \t → liftM StState $ runStateT t s)+    restoreT = StateT ∘ const ∘ liftM unStState+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  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)+    newtype StT (Strict.StateT s) α = StState' {unStState' ∷  (α, s)}+    liftWith f = Strict.StateT $ \s →+                   liftM (\x → (x, s))+                         (f $ \t → liftM StState' $ Strict.runStateT t s)+    restoreT = Strict.StateT ∘ const ∘ liftM unStState'+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  instance Monoid w ⇒ MonadTransControl (WriterT w) where-    liftControl f = WriterT $ liftM (\x → (x, mempty)) (f run)-        where-          run t = liftM (\ ~(x, w) → WriterT $ return (x, w))-                        (runWriterT t)+    newtype StT (WriterT w) α = StWriter {unStWriter ∷ (α, w)}+    liftWith f = WriterT $ liftM (\x → (x, mempty))+                                 (f $ liftM StWriter ∘ runWriterT)+    restoreT = WriterT ∘ liftM unStWriter+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  instance Monoid w ⇒ MonadTransControl (Strict.WriterT w) where-    liftControl f = Strict.WriterT $ liftM (\x → (x, mempty)) (f run)-        where-          run t = liftM (\(x, w) → Strict.WriterT $ return (x, w))-                        (Strict.runWriterT t)+    newtype StT (Strict.WriterT w) α = StWriter' {unStWriter' ∷ (α, w)}+    liftWith f = Strict.WriterT $ liftM (\x → (x, mempty))+                                        (f $ liftM StWriter' ∘ Strict.runWriterT)+    restoreT = Strict.WriterT ∘ liftM unStWriter'+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  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)+    newtype StT (RWST r w s) α = StRWS {unStRWS ∷ (α, s, w)}+    liftWith f = RWST $ \r s → liftM (\x → (x, s, mempty))+                                     (f $ \t → liftM StRWS $ runRWST t r s)+    restoreT mSt = RWST $ \_ _ → liftM unStRWS mSt+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}  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)+    newtype StT (Strict.RWST r w s) α = StRWS' {unStRWS' ∷  (α, s, w)}+    liftWith f =+        Strict.RWST $ \r s → liftM (\x → (x, s, mempty))+                                   (f $ \t → liftM StRWS' $ Strict.runRWST t r s)+    restoreT mSt = Strict.RWST $ \_ _ → liftM unStRWS' mSt+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}   ----------------------------------------------------------------------------------- Lifting+-- MonadBaseControl type class -------------------------------------------------------------------------------- -{-|-@idLiftControl@ acts as the \"identity\" 'liftControl' operation from a monad-@m@ to itself.+class MonadBase b m ⇒ MonadBaseControl b m | m → b where+    -- | Monadic state of @m@.+    data StM m ∷ * → * -@idLiftControl f = f $ liftM return@+    -- | @liftBaseWith@ is similar to 'liftIO' and 'liftBase' in that it+    -- lifts a base computation to the constructed monad.+    --+    -- Instances should satisfy similar laws as the 'MonadIO' and 'MonadBase' laws:+    --+    -- @liftBaseWith . const . return = return@+    --+    -- @liftBaseWith (const (m >>= f)) = liftBaseWith (const m) >>= liftBaseWith . const . f@+    --+    -- The difference with 'liftBase' is that before lifting the base computation+    -- @liftBaseWith@ captures the state of @m@. It then provides the base+    -- computation with a 'RunInBase' function that allows running @m@+    -- computations in the base monad on the captured state.+    liftBaseWith ∷ (RunInBase m b → b α) → m α -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:+    -- | Construct a @m@ computation from the monadic state of @m@ that is+    -- returned from a 'RunInBase' function.+    --+    -- Instances should satisfy:+    --+    -- @liftBaseWith (\\runInBase -> runInBase m) >>= restoreM = m@+    restoreM ∷ StM m α → m α -@-class MonadIO m => MonadControlIO m where-    liftControlIO :: (RunInBase m IO -> IO b) -> m b-@+-- | A function that runs a @m@ computation on the monadic state that was+-- captured by 'liftBaseWith'+--+-- A @RunInBase m@ function yields a computation in the base monad of @m@ that+-- returns the monadic state of @m@. This state can later be used to restore the+-- @m@ computation using 'restoreM'.+type RunInBase m b = ∀ α. m α → b (StM m α) -@-instance MonadControlIO IO where-    liftControlIO = idLiftControl-@--}-idLiftControl ∷ Monad m ⇒ (RunInBase m m → m α) → m α-idLiftControl f = f $ liftM return -type RunInBase m base = ∀ β. m β → base (m β)+--------------------------------------------------------------------------------+-- MonadBaseControl instances for all monads in the base library+-------------------------------------------------------------------------------- -{-|-@liftLiftControlBase@ is used to compose two 'liftControl' operations:-the outer provided by a 'MonadTransControl' instance,-and the inner provided as the argument.+#define BASE(M, ST)                       \+instance MonadBaseControl (M) (M) where { \+    newtype StM (M) α = ST α;             \+    liftBaseWith f = f $ liftM ST;        \+    restoreM (ST x) = return x;           \+    {-# INLINE liftBaseWith #-};          \+    {-# INLINE restoreM #-}} -It satisfies @'liftLiftControlBase' 'idLiftControl' = 'liftControl'@.+BASE(IO,          StIO)+BASE(Strict.ST s, StSTS)+BASE(       ST s, StST)+BASE(STM,         StSTM)+BASE(Maybe,       St)+BASE(Either e,    StE)+BASE([],          StL)+BASE((→) r,       StF)+BASE(Identity,    StI)+#undef BASE -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-@+--------------------------------------------------------------------------------+-- Defaults for MonadBaseControl+-------------------------------------------------------------------------------- -using the 'MonadTransControl' instance of @'StateT' s@.+-- $defaults+--+-- Note that by using the following default definitions it's easy to make a+-- monad transformer @T@ an instance of 'MonadBaseControl':+--+-- @+-- instance MonadBaseControl b m => MonadBaseControl b (T m) where+--     newtype StM (T m) a = StMT {unStMT :: 'ComposeSt' T m a}+--     liftBaseWith = 'defaultLiftBaseWith' StMT+--     restoreM     = 'defaultRestoreM'   unStMT+-- @+--+-- Defining an instance for a base monad @B@ is equally straightforward:+--+-- @+-- instance MonadBaseControl B B where+--     newtype StM B a = StMB {unStMB :: a}+--     liftBaseWith f  = f $ liftM  StMB+--     restoreM        = return . unStMB+-- @ -The following shows the recursive structure of 'liftControlIO' applied to a-stack of three monad transformers with IO as the base monad: @t1 (t2 (t3 IO)) a@:+-- | Handy type synonym that composes the monadic states of @t@ and @m@.+--+-- It can be used to define the 'StM' for new 'MonadBaseControl' instances.+type ComposeSt t m α = StM m (StT t α) -@-liftControlIO- =- 'liftLiftControlBase' $-   'liftLiftControlBase' $-     'liftLiftControlBase' $-       'idLiftControl'-  =-   \\f -> 'liftControl' $ \\run1 ->     -- Capture state of t1, run1 :: 'Run' t1-           'liftControl' $ \\run2 ->   -- Capture state of t2, run2 :: 'Run' t2-             'liftControl' $ \\run3 -> -- Capture state of t3, run3 :: 'Run' t3-               let run :: 'RunInBase' (t1 (t2 (t3 IO))) IO-                   run = -- Restore state-                         'liftM' ('join' . 'lift') -- :: IO (           t2 (t3 IO) (t1 (t2 (t3 IO)) a))   -> IO (                       t1 (t2 (t3 IO)) a)-                       . 'liftM' ('join' . 'lift') -- :: IO (    t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a)))  -> IO (           t2 (t3 IO) (t1 (t2 (t3 IO)) a))-                         -- Identity conversion-                       . 'liftM' ('join' . 'lift') -- :: IO (IO (t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a)))) -> IO (    t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a)))-                       . 'liftM' 'return'        -- :: IO (    t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a)))  -> IO (IO (t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a))))-                         -- Run     (computation to run:)                              (inner monad:) (restore computation:)-                       . run3 -- ::         t3 IO  (t2 (t3 IO) (t1 (t2 (t3 IO)) a)) ->        IO      (t3 IO (t2 (t3 IO) (t1 (t2 (t3 IO)) a)))-                       . run2 -- ::     t2 (t3 IO)             (t1 (t2 (t3 IO)) a)  ->     t3 IO             (t2 (t3 IO) (t1 (t2 (t3 IO)) a))-                       . run1 -- :: t1 (t2 (t3 IO))                             a   -> t2 (t3 IO)                        (t1 (t2 (t3 IO)) a)-               in f run-@--}-liftLiftControlBase ∷ (MonadTransControl t, Monad (t m), Monad m, Monad base)-                    ⇒ ((RunInBase m     base → base α) →   m α) -- ^ @liftControlBase@ operation-                    → ((RunInBase (t m) base → base α) → t m α)-liftLiftControlBase lftCtrlBase = \f → liftControl $ \run1 →-                                         lftCtrlBase $ \runInBase →-                                           let run = liftM (join ∘ lift) ∘ runInBase ∘ run1-                                           in f run+-- | Default defintion for the 'liftBaseWith' method.+--+-- Note that it composes a 'liftWith' of @t@ with a 'liftBaseWith' of @m@ to+-- give a 'liftBaseWith' of @t m@:+--+-- @+-- defaultLiftBaseWith stM = \\f -> 'liftWith' $ \\run ->+--                                   'liftBaseWith' $ \\runInBase ->+--                                     f $ liftM stM . runInBase . run+-- @+defaultLiftBaseWith ∷ (MonadTransControl t, MonadBaseControl b m)+                    ⇒ (∀ β. ComposeSt t m β → StM (t m) β) -- ^ 'StM' constructor+                    → ((RunInBase (t m) b  → b α) → t m α)+defaultLiftBaseWith stM = \f → liftWith $ \run →+                                 liftBaseWith $ \runInBase →+                                   f $ liftM stM ∘ runInBase ∘ run+{-# INLINE defaultLiftBaseWith #-} +-- | Default definition for the 'restoreM' method.+--+-- Note that: @defaultRestoreM unStM = 'restoreT' . 'restoreM' . unStM@+defaultRestoreM ∷ (MonadTransControl t, MonadBaseControl b m)+                ⇒ (StM (t m) α → ComposeSt t m α)  -- ^ 'StM' deconstructor+                → (StM (t m) α → t m α)+defaultRestoreM unStM = restoreT ∘ restoreM ∘ unStM+{-# INLINE defaultRestoreM #-} --- The End ---------------------------------------------------------------------++--------------------------------------------------------------------------------+-- MonadBaseControl transformer instances+--------------------------------------------------------------------------------++#define BODY(T, ST, unST) {                              \+    newtype StM (T m) α = ST {unST ∷ ComposeSt (T) m α}; \+    liftBaseWith = defaultLiftBaseWith ST;               \+    restoreM     = defaultRestoreM   unST;               \+    {-# INLINE liftBaseWith #-};                         \+    {-# INLINE restoreM #-}}++#define TRANS(         T, ST, unST) \+  instance (     MonadBaseControl b m) ⇒ MonadBaseControl b (T m) where BODY(T, ST, unST)+#define TRANS_CTX(CTX, T, ST, unST) \+  instance (CTX, MonadBaseControl b m) ⇒ MonadBaseControl b (T m) where BODY(T, ST, unST)++TRANS(IdentityT,       StMId,     unStMId)+TRANS(MaybeT,          StMMaybe,  unStMMaybe)+TRANS(ListT,           StMList,   unStMList)+TRANS(ReaderT r,       StMReader, unStMReader)+TRANS(Strict.StateT s, StMStateS, unStMStateS)+TRANS(       StateT s, StMState,  unStMState)++TRANS_CTX(Error e,         ErrorT e,   StMError,   unStMError)+TRANS_CTX(Monoid w, Strict.WriterT w,  StMWriterS, unStMWriterS)+TRANS_CTX(Monoid w,        WriterT w,  StMWriter,  unStMWriter)+TRANS_CTX(Monoid w, Strict.RWST r w s, StMRWSS,    unStMRWSS)+TRANS_CTX(Monoid w,        RWST r w s, StMRWS,     unStMRWS)+++--------------------------------------------------------------------------------+-- * Utility functions+--------------------------------------------------------------------------------++-- | An often used composition: @control f = 'liftBaseWith' f >>= 'restoreM'@+control ∷ MonadBaseControl b m ⇒ (RunInBase m b → b (StM m α)) → m α+control f = liftBaseWith f >>= restoreM+{-# INLINE control #-}++-- | @liftBaseOp@ is a particular application of 'liftBaseWith' that allows+-- lifting control operations of type:+--+-- @((a -> b c) -> b c)@ to: @('MonadBaseControl' b m => (a -> m c) -> m c)@.+--+-- For example:+--+-- @liftBaseOp alloca :: 'MonadBaseControl' 'IO' m => (Ptr a -> m c) -> m c@+liftBaseOp ∷ MonadBaseControl b m+           ⇒ ((α → b (StM m β)) → b (StM m γ))+           → ((α →        m β)  →        m γ)+liftBaseOp f = \g → control $ \runInBase → f $ runInBase ∘ g+{-# INLINE liftBaseOp #-}++-- | @liftBaseOp_@ is a particular application of 'liftBaseWith' that allows+-- lifting control operations of type:+--+-- @(b a -> b a)@ to: @('MonadBaseControl' b m => m a -> m a)@.+--+-- For example:+--+-- @liftBaseOp_ mask_ :: 'MonadBaseControl' 'IO' m => m a -> m a@+liftBaseOp_ ∷ MonadBaseControl b m+            ⇒ (b (StM m α) → b (StM m β))+            → (       m α  →        m β)+liftBaseOp_ f = \m → control $ \runInBase → f $ runInBase m+{-# INLINE liftBaseOp_ #-}++-- | @liftBaseDiscard@ is a particular application of 'liftBaseWith' that allows+-- lifting control operations of type:+--+-- @(b () -> b a)@ to: @('MonadBaseControl' b m => m () -> m a)@.+--+-- Note that, while the argument computation @m ()@ has access to the captured+-- state, all its side-effects in @m@ are discarded. It is run only for its+-- side-effects in the base monad @b@.+--+-- For example:+--+-- @liftBaseDiscard forkIO :: 'MonadBaseControl' 'IO' m => m () -> m ThreadId@+liftBaseDiscard ∷ MonadBaseControl b m ⇒ (b () → b α) → (m () → m α)+liftBaseDiscard f = \m → liftBaseWith $ \runInBase → f $ void $ runInBase m+{-# INLINE liftBaseDiscard #-}

@@ -1,3 +1,11 @@+0.2.0.3++(Released on: Sat Aug 27 21:18:22 UTC 2011)++* Fixed issue #2+  https://github.com/basvandijk/monad-control/issues/2++ 0.2.0.2  (Released on: Mon Aug 8 09:16:08 UTC 2011)

@@ -2,9 +2,7 @@ `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`.+the `transformers` library except `ContT`.  Note that this package is a rewrite of Anders Kaseorg's `monad-peel` library.  The main difference is that this package provides CPS style

@@ -1,44 +1,2 @@-#! /usr/bin/env runhaskell--{-# LANGUAGE NoImplicitPrelude, UnicodeSyntax #-}--module Main (main) where------------------------------------------------------------------------------------- Imports------------------------------------------------------------------------------------ from base-import System.IO ( IO )---- from cabal-import Distribution.Simple ( defaultMainWithHooks-                           , simpleUserHooks-                           , UserHooks(haddockHook)-                           )--import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )-import Distribution.Simple.Program        ( userSpecifyArgs )-import Distribution.Simple.Setup          ( HaddockFlags )-import Distribution.PackageDescription    ( PackageDescription(..) )------------------------------------------------------------------------------------- Cabal setup program which sets the CPP define '__HADDOCK __' when haddock is run.----------------------------------------------------------------------------------main ∷ IO ()-main = defaultMainWithHooks hooks-  where-    hooks = simpleUserHooks { haddockHook = haddockHook' }---- 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 ---------------------------------------------------------------------+import Distribution.Simple+main = defaultMain

@@ -1,44 +1,39 @@ Name:                monad-control-Version:             0.2.0.3+Version:             0.3 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 on average about 2.5 times faster than @monad-peel@:-  .-  <https://github.com/basvandijk/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-Homepage:            https://github.com/basvandijk/monad-control/+Homepage:            https://github.com/basvandijk/monad-control Bug-reports:         https://github.com/basvandijk/monad-control/issues Category:            Control-Build-type:          Custom-Cabal-version:       >= 1.9.2+Build-type:          Simple+Cabal-version:       >= 1.6+Description:+  This package defines the type class @MonadBaseControl@, a subset of+  @MonadBase@ into which generic control operations such as @catch@ can be+  lifted from @IO@ or any other base monad. Instances are based on monad+  transformers in @MonadTransControl@, which includes all standard monad+  transformers in the @transformers@ library except @ContT@.+  .+  See the @lifted-base@ package which uses @monad-control@ to lift @IO@+  operations from the @base@ library (like @catch@ or @bracket@) into any monad+  that is an instance of @MonadBase@ or @MonadBaseControl@.+  .+  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@ and @TypeFamilies@ language extensions to+  simplify and speedup most definitions.+  .+  The following @critertion@ based benchmark shows that @monad-control@ is on+  average about 99% faster than @monad-peel@:+  .+  @git clone <https://github.com/basvandijk/bench-monad-peel-control>@  extra-source-files:  README.markdown, NEWS --- TODO: Remove when http://hackage.haskell.org/trac/hackage/ticket/792 is fixed:-extra-source-files:  test.hs- --------------------------------------------------------------------------------  source-repository head@@ -49,28 +44,10 @@  Library   Exposed-modules: Control.Monad.Trans.Control-                   Control.Monad.IO.Control-                   Control.Exception.Control    Build-depends: base                 >= 3     && < 4.5                , base-unicode-symbols >= 0.1.1 && < 0.3                , transformers         >= 0.2   && < 0.3+               , transformers-base    >= 0.4   && < 0.5    Ghc-options: -Wall------------------------------------------------------------------------------------test-suite test-threads-  type:    exitcode-stdio-1.0-  main-is: test.hs--  ghc-options: -Wall--  build-depends: base                 >= 3     && < 4.5-               , base-unicode-symbols >= 0.1.1 && < 0.3-               , transformers         >= 0.2   && < 0.3-               , HUnit                >= 1.2.2 && < 1.3-               , test-framework       >= 0.2.4 && < 0.5-               , test-framework-hunit >= 0.2.4 && < 0.3----------------------------------------------------------------------------------

@@ -1,159 +0,0 @@-{-# 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]