monad-control-aligned (empty) → 0.0.0
raw patch · 5 files changed
+1163/−0 lines, 5 filesdep +basedep +stmdep +transformers
Dependencies added: base, stm, transformers, transformers-base, transformers-compat
Files
- CHANGELOG +470/−0
- Control/Monad/Trans/Control.hs +604/−0
- LICENSE +29/−0
- README.markdown +20/−0
- monad-control-aligned.cabal +40/−0
+ CHANGELOG view
@@ -0,0 +1,470 @@+1.0.1.0++* Added the functions:++ liftThrough+ :: (MonadTransControl t, Monad (t m), Monad m)+ => (m (StT t a) -> m (StT t b)) -- ^+ -> t m a -> t m b++ captureT :: (MonadTransControl t, Monad (t m), Monad m) => t m (StT t ())+ captureM :: MonadBaseControl b m => m (StM m ())++* Added Travis-CI integration+++1.0.0.5++* Support transformers-0.5 & ransformers-compat-0.5.*.+++1.0.0.4++* Support transformers-compat-0.4.*.+++1.0.0.3++* Unconditionally add ExceptT instances using transformers-compat.+ Courtesy of Adam Bergmark.+++1.0.0.2++* Add a base >= 4.5 constraint because monad-control only builds on GHC >= 7.4.+++1.0.0.1++* Use Safe instead of Trustworthy.++ This requires a dependency on stm.+++1.0.0.0++* Switch the associated data types StT and StM to associated type synonyms.++ This is an API breaking change. To fix your MonadTransControl or+ MonadBaseControl instances simply remove the StT or StM constructors+ and deconstructors for your monad transformers or monad.++* Add the embed, embed_ and liftBaseOpDiscard functions.+++0.3.3.1++* Unconditionally add ExceptT instances using transformers-compat.+ Courtesy of Adam Bergmark.+++0.3.3.0++* Support transformers-0.4.0.0++* Drop unicode syntax and symbols+++0.3.2.3++* Fix haddock documentation error+++0.3.2.2++* Fix preprocessor directive for GHC 7.6.3+++0.3.2.1++* Resolve #14. Bump upper version bound of base to 5+++0.3.2++* Added defaultLiftWith and defaultRestoreT to simplify defining+ MonadTransControl for newtypes.+++0.3.1.4++* Compatibility with ghc head+++0.3.1.3++* Added a Trustworthy flag+++0.3.1.2++* Fix issue #9. Replace all Unicode in type variables.+++0.3.1.1++* Add MonadBaseControl instances for ST and STM.+++0.3++(Released on: Fri Dec 2 09:52:16 UTC 2011)++* Major new API which IMHO is easier to understand than the old one.++* On average about 60 times faster than the previous release!++* New package lifted-base providing lifted versions of functions from the base+ library. It exports the following modules:++ - Control.Exception.Lifted+ - Control.Concurrent.Lifted+ - Control.Concurrent.MVar.Lifted+ - System.Timeout.Lifted++ Not all modules from base are converted yet. If you need a lifted version of+ some function from base, just ask me to add it or send me a patch.+++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)++* Switched to git on github.++* Tested with base-4.4 and ghc-7.2.1.++* Use the new cabal test-suite feature.+++0.2.0.1++(Released on: Wed Mar 16 15:53:50 UTC 2011)++* Added laws for MonadTransControl and MonadControlIO++* Bug fix: Add proper laziness to the MonadTransControl instances+ of the lazy StateT, WriteT and RWST+ These all failed the law: control $ \run -> run t = t+ where t = return undefined++* Add INLINABLE pragmas for most public functions+ A simple benchmark showed some functions+ (bracket and mask) improving by 30%.+++0.2++(Released on: Wed Feb 9 12:05:26 UTC 2011)++* Use RunInBase in the type of idLiftControl.++* Added this NEWS file.++* Only parameterize Run with t and use RankNTypes to quantify n and o+ -liftControl :: (Monad m, Monad n, Monad o) => (Run t n o -> m a) -> t m a+ +liftControl :: Monad m => (Run t -> m a) -> t m a++ -type Run t n o = forall b. t n b -> n (t o b)+ +type Run t = forall n o b. (Monad n, Monad o, Monad (t o)) => t n b -> n (t o b)++ Bumped version from 0.1 to 0.2 to indicate this breaking change in API.++* Added example of a derivation of liftControlIO.+ Really enlightening!+++0.1++(Released on: Sat Feb 5 23:36:21 UTC 2011)++* Initial release++This is the announcement message sent to the Haskell mailinglists:+http://www.mail-archive.com/haskell@haskell.org/msg23278.html+++Dear all,++Several attempts have been made to lift control operations (functions+that use monadic actions as input instead of just output) through+monad transformers:++MonadCatchIO-transformers[1] provided a type class that allowed to+overload some often used control operations (catch, block and+unblock). Unfortunately that library was limited to those operations.+It was not possible to use, say, alloca in a monad transformer. More+importantly however, the library was broken as was explained[2] by+Michael Snoyman. In response Michael created the MonadInvertIO type+class which solved the problems. Then Anders Kaseorg created the+monad-peel library which provided an even nicer implementation.++monad-control is a rewrite of monad-peel that uses CPS style+operations and exploits the RankNTypes language extension to simplify+and speedup most functions. A very preliminary and not yet fully+representative, benchmark shows that monad-control is on average about+2.6 times faster than monad-peel:++bracket: 2.4 x faster+bracket_: 3.1 x faster+catch: 1.8 x faster+try: 4.0 x faster+mask: 2.0 x faster++Note that, although the package comes with a test suite that passes, I+still consider it highly experimental.+++API DOCS:++http://hackage.haskell.org/package/monad-control+++INSTALLING:++$ cabal update+$ cabal install monad-control+++TESTING:++The package contains a copy of the monad-peel test suite written by+Anders. You can perform the tests using:++$ cabal unpack monad-control+$ cd monad-control+$ cabal configure -ftest+$ cabal test+++BENCHMARKING:++$ darcs get http://bifunctor.homelinux.net/~bas/bench-monad-peel-control/+$ cd bench-monad-peel-control+$ cabal configure+$ cabal build+$ dist/build/bench-monad-peel-control/bench-monad-peel-control+++DEVELOPING:++The darcs repository will be hosted on code.haskell.org ones that+server is back online. For the time being you can get the repository+from:++$ darcs get http://bifunctor.homelinux.net/~bas/monad-control/+++TUTORIAL:++This short unpolished tutorial will explain how to lift control+operations through monad transformers. Our goal is to lift a control+operation like:++foo ∷ M a → M a++where M is some monad, into a transformed monad like 'StateT M':++foo' ∷ StateT M a → StateT M a++The first thing we need to do is write an instance for the+MonadTransControl type class:++class MonadTrans t ⇒ MonadTransControl t where+ liftControl ∷ (Monad m, Monad n, Monad o)+ ⇒ (Run t n o → m a) → t m a++If you ignore the Run argument for now, you'll see that liftControl is+identical to the 'lift' method of the MonadTrans type class:++class MonadTrans t where+ lift ∷ Monad m ⇒ m a → t m a++So the instance for MonadTransControl will probably look very much+like the instance for MonadTrans. Let's see:++instance MonadTransControl (StateT s) where+ liftControl f = StateT $ \s → liftM (\x → (x, s)) (f run)++So what is this run function? Let's look at its type:++type Run t n o = ∀ b. t n b → n (t o b)++The run function executes a transformed monadic action 't n b' in the+non-transformed monad 'n'. In our case the 't' will be a StateT+computation. The only way to run a StateT computation is to give it+some state and the only state we have lying around is the one from the+outer computation: 's'. So let's run it on 's':++instance MonadTransControl (StateT s) where+ liftControl f =+ StateT $ \s →+ let run t = ... runStateT t s ...+ in liftM (\x → (x, s)) (f run)++Now that we are able to run a transformed monadic action, we're almost+done. Look at the type of Run again. The function should leave the+result 't o b' in the monad 'n'. This 't o b' computation should+contain the final state after running the supplied 't n b'+computation. In case of our StateT it should contain the final state+s':++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)++This final computation, "StateT $ \_ → return (x, s')", can later be+used to restore the final state. Now that we have our+MonadTransControl instance we can start using it. Recall that our goal+was to lift "foo ∷ M a → M a" into our StateT transformer yielding the+function "foo' ∷ StateT M a → StateT M a".++To define foo', the first thing we need to do is call liftControl:++foo' t = liftControl $ \run → ...++This captures the current state of the StateT computation and provides+us with the run function that allows us to run a StateT computation on+this captured state.++Now recall the type of liftControl ∷ (Run t n o → m a) → t m a. You+can see that in place of the ... we must fill in a value of type 'm+a'. In our case this will be a value of type 'M a'. We can construct+such a value by calling foo. However, foo expects an argument of type+'M a'. Fortunately we can provide one if we convert the supplied 't'+computation of type 'StateT M a' to 'M a' using our run function of+type ∀ b. StateT M b → M (StateT o b):++foo' t = ... liftControl $ \run → foo $ run t++However, note that the run function returns the final StateT+computation inside M. So the type of the right hand side is now+'StateT M (StateT o b)'. We would like to restore this final state. We+can do that using join:++foo' t = join $ liftControl $ \run → foo $ run t++That's it! Note that because it's so common to join after a+liftControl I provide an abstraction for it:++control = join ∘ liftControl++Allowing you to simplify foo' to:++foo' t = control $ \run → foo $ run t++Probably the most common control operations that you want to lift+through your transformers are IO operations. Think about: bracket,+alloca, mask, etc.. For this reason I provide the MonadControlIO type+class:++class MonadIO m ⇒ MonadControlIO m where+ liftControlIO ∷ (RunInBase m IO → IO a) → m a++Again, if you ignore the RunInBase argument, you will see that+liftControlIO is identical to the liftIO method of the MonadIO type+class:++class Monad m ⇒ MonadIO m where+ liftIO ∷ IO a → m a++Just like Run, RunInBase allows you to run your monadic computation+inside your base monad, which in case of liftControlIO is IO:++type RunInBase m base = ∀ b. m b → base (m b)++The instance for the base monad is trivial:++instance MonadControlIO IO where+ liftControlIO = idLiftControl++idLiftControl directly executes f and passes it a run function which+executes the given action and lifts the result r into the trivial+'return r' action:++idLiftControl ∷ Monad m ⇒ ((∀ b. m b → m (m b)) → m a) → m a+idLiftControl f = f $ liftM $ \r -> return r++The instances for the transformers are all identical. Let's look at+StateT and ReaderT:++instance MonadControlIO m ⇒ MonadControlIO (StateT s m) where+ liftControlIO = liftLiftControlBase liftControlIO++instance MonadControlIO m ⇒ MonadControlIO (ReaderT r m) where+ liftControlIO = liftLiftControlBase liftControlIO++The magic function is liftLiftControlBase. This function is used to+compose two liftControl operations, the outer provided by a+MonadTransControl instance and the inner provided as the argument:++liftLiftControlBase ∷ (MonadTransControl t, Monad base, Monad m, Monad (t m))+ ⇒ ((RunInBase m base → base a) → m a)+ → ((RunInBase (t m) base → base a) → t m a)+liftLiftControlBase lftCtrlBase =+ \f → liftControl $ \run →+ lftCtrlBase $ \runInBase →+ f $ liftM (join ∘ lift) ∘ runInBase ∘ run++Basically it captures the state of the outer monad transformer using+liftControl. Then it captures the state of the inner monad using the+supplied lftCtrlBase function. If you recall the identical definitions+of the liftControlIO methods: 'liftLiftControlBase liftControlIO' you+will see that this lftCtrlBase function is the recursive step of+liftLiftControlBase. If you use 'liftLiftControlBase liftControlIO' in+a stack of monad transformers a chain of liftControl operations is+created:++liftControl $ \run1 -> liftControl $ \run2 -> liftControl $ \run3 -> ...++This will recurse until we hit the base monad. Then+liftLiftControlBase will finally run f in the base monad supplying it+with a run function that is able to run a 't m a' computation in the+base monad. It does this by composing the run and runInBase functions.+Note that runInBase is basically the composition: '... ∘ run3 ∘ run2'.++However, just composing the run and runInBase functions is not enough.+Namely: runInBase ∘ run ∷ ∀ b. t m b → base (m (t m b)) while we need+to have ∀ b. t m b → base (t m b). So we need to lift the 'm (t m b)'+computation inside t yielding: 't m (t m b)' and then join that to get+'t m b'.++Now that we have our MonadControlIO instances we can start using them.+Let's look at how to lift 'bracket' into a monad supporting+MonadControlIO. Before we do that I define a little convenience+function similar to 'control':++controlIO = join ∘ liftControlIO++Bracket just calls controlIO which captures the state of m and+provides us with a runInIO function which allows us to run an m+computation in IO:++bracket ∷ MonadControlIO m+ ⇒ m a → (a → m b) → (a → m c) → m c+bracket before after thing =+ controlIO $ \runInIO →+ E.bracket (runInIO before)+ (\m → runInIO $ m >>= after)+ (\m → runInIO $ m >>= thing)++I welcome any comments, questions or patches.++Regards,++Bas++[1] http://hackage.haskell.org/package/MonadCatchIO-transformers+[2] http://docs.yesodweb.com/blog/invertible-monads-exceptions-allocations/+[3] http://hackage.haskell.org/package/monad-peel
+ Control/Monad/Trans/Control.hs view
@@ -0,0 +1,604 @@+{-# LANGUAGE CPP+ , NoImplicitPrelude+ , RankNTypes+ , TypeFamilies+ , TupleSections+ , FunctionalDependencies+ , FlexibleInstances+ , UndecidableInstances+ , MultiParamTypeClasses #-}++#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Safe #-}+#endif++#if MIN_VERSION_transformers(0,4,0)+-- Hide warnings for the deprecated ErrorT transformer:+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+#endif++{- |+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+-}++module Control.Monad.Trans.Control+ ( -- * MonadTransControl+ MonadTransControl(..), Run++ -- ** Defaults+ -- $MonadTransControlDefaults+ , RunDefault, defaultLiftWith, defaultRestoreT++ -- * MonadBaseControl+ , MonadBaseControl (..), RunInBase++ -- ** Defaults+ -- $MonadBaseControlDefaults+ , RunInBaseDefault, defaultLiftBaseWith, defaultRestoreM++ -- * Utility functions+ , control, embed, embed_, captureT, captureM++ , liftBaseOp, liftBaseOp_++ , liftBaseDiscard, liftBaseOpDiscard++ , liftThrough+ ) where+++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++-- from base:+import Data.Function ( (.), ($), const )+import Data.Monoid ( Monoid, mempty )+import Control.Monad ( Monad, (>>=), return, liftM )+import System.IO ( IO )+import Data.Maybe ( Maybe )+import Data.Either ( Either )+import Data.Functor.Identity ( Identity (..) )+import Data.Functor.Compose ( Compose (..) )+import Data.Tuple ( swap )++#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST.Lazy.Safe ( ST )+import qualified Control.Monad.ST.Safe as Strict ( ST )+#endif++-- from stm:+import Control.Monad.STM ( STM )++-- from transformers:+import Control.Monad.Trans.Class ( MonadTrans )++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 Control.Monad.Trans.Except ( ExceptT (ExceptT), runExceptT )++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 )++import Data.Functor.Identity ( Identity )++-- from transformers-base:+import Control.Monad.Base ( MonadBase )++#if MIN_VERSION_base(4,3,0)+import Control.Monad ( void )+#else+import Data.Functor (Functor, fmap)+void :: Functor f => f a -> f ()+void = fmap (const ())+#endif++import Prelude (id, (<$>), pure)++--------------------------------------------------------------------------------+-- MonadTransControl type class+--------------------------------------------------------------------------------++class MonadTrans t => MonadTransControl t stT | t -> stT where+ -- | @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 stT -> m a) -> t m a++ -- | 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 a) -> t m a++-- | 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 stT = forall n b. Monad n => t n b -> n (stT b)+++--------------------------------------------------------------------------------+-- Defaults for MonadTransControl+--------------------------------------------------------------------------------++-- $MonadTransControlDefaults+--+-- The following functions can be used to define a 'MonadTransControl' instance+-- for a monad transformer which simply wraps another monad transformer which+-- already has a @MonadTransControl@ instance. For example:+--+-- @+-- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-}+--+-- newtype CounterT m a = CounterT {unCounterT :: StateT Int m a}+-- deriving (Monad, MonadTrans)+--+-- instance MonadTransControl CounterT where+-- type StT CounterT a = StT (StateT Int) a+-- liftWith = 'defaultLiftWith' CounterT unCounterT+-- restoreT = 'defaultRestoreT' CounterT+-- @++-- | A function like 'Run' that runs a monad transformer @t@ which wraps the+-- monad transformer @t'@. This is used in 'defaultLiftWith'.+type RunDefault t stT = forall n b. Monad n => t n b -> n (stT b)++-- | Default definition for the 'liftWith' method.+defaultLiftWith :: (Monad m, MonadTransControl n stT)+ => (forall b. n m b -> t m b) -- ^ Monad constructor+ -> (forall o b. t o b -> n o b) -- ^ Monad deconstructor+ -> (RunDefault t stT -> m a)+ -> t m a+defaultLiftWith t unT = \f -> t $ liftWith $ \run -> f $ run . unT+{-# INLINABLE defaultLiftWith #-}++-- | Default definition for the 'restoreT' method.+defaultRestoreT :: (Monad m, MonadTransControl n stT)+ => (n m a -> t m a) -- ^ Monad constructor+ -> m (stT a)+ -> t m a+defaultRestoreT t = t . restoreT+{-# INLINABLE defaultRestoreT #-}+++--------------------------------------------------------------------------------+-- MonadTransControl instances+--------------------------------------------------------------------------------++instance MonadTransControl IdentityT Identity where+ liftWith f = IdentityT $ f $ \mx -> Identity <$> runIdentityT mx+ restoreT mx = IdentityT $ runIdentity <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl MaybeT Maybe where+ liftWith f = MaybeT $ liftM return $ f $ runMaybeT+ restoreT = MaybeT+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance Error e => MonadTransControl (ErrorT e) (Either e) where+ liftWith f = ErrorT $ liftM return $ f $ runErrorT+ restoreT = ErrorT+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl (ExceptT e) (Either e) where+ liftWith f = ExceptT $ liftM return $ f $ runExceptT+ restoreT = ExceptT+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl ListT [] where+ liftWith f = ListT $ liftM return $ f $ runListT+ restoreT = ListT+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl (ReaderT r) Identity where+ liftWith f = ReaderT $ \r -> f $ \t -> Identity <$> runReaderT t r+ restoreT mx = ReaderT $ \_ -> runIdentity <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl (StateT s) ((,) s) where+ liftWith f = StateT $ \s -> (,s) <$> f (\t -> swap <$> runStateT t s)+ restoreT mx = StateT $ \_ -> swap <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance MonadTransControl (Strict.StateT s) ((,) s) where+ liftWith f = Strict.StateT $ \s -> (,s) <$> f (\t -> swap <$> Strict.runStateT t s)+ restoreT mx = Strict.StateT $ \_ -> swap <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance Monoid w => MonadTransControl (WriterT w) ((,) w) where+ liftWith f = WriterT $ (,mempty) <$> (f $ \t -> swap <$> runWriterT t)+ restoreT mx = WriterT $ swap <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance Monoid w => MonadTransControl (Strict.WriterT w) ((,) w) where+ liftWith f = Strict.WriterT $ (,mempty) <$> (f $ \t -> swap <$> Strict.runWriterT t)+ restoreT mx = Strict.WriterT $ swap <$> mx+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance Monoid w => MonadTransControl (RWST r w s) ((,,) w s) where+ liftWith f = RWST $ \r s -> (,s,mempty) <$> (f $ \t -> (\(a,s,w) -> (w,s,a)) <$> runRWST t r s)+ restoreT mSt = RWST $ \_ _ -> (\(w,s,a) -> (a,s,w)) <$> mSt+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}++instance Monoid w => MonadTransControl (Strict.RWST r w s) ((,,) w s) where+ liftWith f = Strict.RWST $ \r s -> (,s,mempty) <$> (f $ \t -> (\(a,s,w) -> (w,s,a)) <$> Strict.runRWST t r s)+ restoreT mSt = Strict.RWST $ \_ _ -> (\(w,s,a) -> (a,s,w)) <$> mSt+ {-# INLINABLE liftWith #-}+ {-# INLINABLE restoreT #-}+++--------------------------------------------------------------------------------+-- MonadBaseControl type class+--------------------------------------------------------------------------------++class MonadBase b m => MonadBaseControl b m stM | m -> b stM where++ -- | @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 stM -> b a) -> m a++ -- | 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 a -> m a++-- | 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 stM = forall a. m a -> b (stM a)+++--------------------------------------------------------------------------------+-- MonadBaseControl instances for all monads in the base library+--------------------------------------------------------------------------------++instance MonadBaseControl IO IO Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl Maybe Maybe Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl (Either e) (Either e) Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl [] [] Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl ((->) r) ((->) r) Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl Identity Identity Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl STM STM Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++#if MIN_VERSION_base(4,4,0)+instance MonadBaseControl (Strict.ST s) (Strict.ST s) Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance MonadBaseControl (ST s) (ST s) Identity where+ liftBaseWith f = f (\x -> Identity <$> x)+ restoreM x = pure (runIdentity x)+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}+#endif++#undef BASE+++--------------------------------------------------------------------------------+-- Defaults for MonadBaseControl+--------------------------------------------------------------------------------++-- $MonadBaseControlDefaults+--+-- 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+-- type StM (T m) a = 'ComposeSt' T m a+-- liftBaseWith = 'defaultLiftBaseWith'+-- restoreM = 'defaultRestoreM'+-- @+--+-- Defining an instance for a base monad @B@ is equally straightforward:+--+-- @+-- instance MonadBaseControl B B where+-- type StM B a = a+-- liftBaseWith f = f 'id'+-- restoreM = 'return'+-- @++-- | A function like 'RunInBase' that runs a monad transformer @t@ in its base+-- monad @b@. It is used in 'defaultLiftBaseWith'.+type RunInBaseDefault (t :: (* -> *) -> * -> *) (m :: * -> *) (b :: * -> *) (stM :: * -> *) (stT :: * -> *) = forall a. t m a -> b (Compose stM stT a)++-- | 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 = \\f -> 'liftWith' $ \\run ->+-- 'liftBaseWith' $ \\runInBase ->+-- f $ runInBase . run+-- @+defaultLiftBaseWith :: (MonadTransControl t stT, MonadBaseControl b m stM)+ => (RunInBaseDefault t m b stM stT -> b a) -> t m a+defaultLiftBaseWith f = liftWith $ \run ->+ liftBaseWith $ \runInBase ->+ f (\t -> Compose <$> runInBase (run t))+{-# INLINABLE defaultLiftBaseWith #-}++-- | Default definition for the 'restoreM' method.+--+-- Note that: @defaultRestoreM = 'restoreT' . 'restoreM'@+defaultRestoreM :: (MonadTransControl t stT, MonadBaseControl b m stM)+ => Compose stM stT a -> t m a+defaultRestoreM (Compose x) = restoreT (restoreM x)+{-# INLINABLE defaultRestoreM #-}+++--------------------------------------------------------------------------------+-- MonadBaseControl transformer instances+--------------------------------------------------------------------------------++instance (MonadBaseControl b m stM) => MonadBaseControl b (IdentityT m) (Compose stM Identity) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (MaybeT m) (Compose stM Maybe) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (ListT m) (Compose stM []) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (ReaderT r m) (Compose stM Identity) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (Strict.StateT s m) (Compose stM ((,) s)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (StateT s m) (Compose stM ((,) s)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM) => MonadBaseControl b (ExceptT e m) (Compose stM (Either e)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++++instance (MonadBaseControl b m stM, Error e) => MonadBaseControl b (ErrorT e m) (Compose stM (Either e)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM, Monoid w) => MonadBaseControl b (Strict.WriterT w m) (Compose stM ((,) w)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM, Monoid w) => MonadBaseControl b (WriterT w m) (Compose stM ((,) w)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM, Monoid w) => MonadBaseControl b (Strict.RWST r w s m) (Compose stM ((,,) w s)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}++instance (MonadBaseControl b m stM, Monoid w) => MonadBaseControl b (RWST r w s m) (Compose stM ((,,) w s)) where+ liftBaseWith = defaultLiftBaseWith+ restoreM = defaultRestoreM+ {-# INLINABLE liftBaseWith #-}+ {-# INLINABLE restoreM #-}+++--------------------------------------------------------------------------------+-- * Utility functions+--------------------------------------------------------------------------------++-- | An often used composition: @control f = 'liftBaseWith' f >>= 'restoreM'@+control :: MonadBaseControl b m stM => (RunInBase m b stM -> b (stM a)) -> m a+control f = liftBaseWith f >>= restoreM+{-# INLINABLE control #-}++-- | Embed a transformer function as an function in the base monad returning a+-- mutated transformer state.+embed :: MonadBaseControl b m stM => (a -> m c) -> m (a -> b (stM c))+embed f = liftBaseWith $ \runInBase -> return (runInBase . f)+{-# INLINABLE embed #-}++-- | Performs the same function as 'embed', but discards transformer state+-- from the embedded function.+embed_ :: MonadBaseControl b m stM => (a -> m ()) -> m (a -> b ())+embed_ f = liftBaseWith $ \runInBase -> return (void . runInBase . f)+{-# INLINABLE embed_ #-}++-- | Capture the current state of a transformer+captureT :: (MonadTransControl t stT, Monad (t m), Monad m) => t m (stT ())+captureT = liftWith $ \runInM -> runInM (return ())+{-# INLINABLE captureT #-}++-- | Capture the current state above the base monad+captureM :: MonadBaseControl b m stM => m (stM ())+captureM = liftBaseWith $ \runInBase -> runInBase (return ())+{-# INLINABLE captureM #-}++-- | @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 stM+ => ((a -> b (stM c)) -> b (stM d))+ -> ((a -> m c) -> m d)+liftBaseOp f = \g -> control $ \runInBase -> f $ runInBase . g+{-# INLINABLE 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 stM+ => (b (stM a) -> b (stM c))+ -> ( m a -> m c)+liftBaseOp_ f = \m -> control $ \runInBase -> f $ runInBase m+{-# INLINABLE 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 stM => (b () -> b a) -> (m () -> m a)+liftBaseDiscard f = \m -> liftBaseWith $ \runInBase -> f $ void $ runInBase m+{-# INLINABLE liftBaseDiscard #-}++-- | @liftBaseOpDiscard@ is a particular application of 'liftBaseWith' that allows+-- lifting control operations of type:+--+-- @((a -> b ()) -> b c)@ to: @('MonadBaseControl' b m => (a -> m ()) -> m c)@.+--+-- 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 (runServer addr port) :: 'MonadBaseControl' 'IO' m => m () -> m ()@+liftBaseOpDiscard :: MonadBaseControl b m stM+ => ((a -> b ()) -> b c)+ -> (a -> m ()) -> m c+liftBaseOpDiscard f g = liftBaseWith $ \runInBase -> f $ void . runInBase . g+{-# INLINABLE liftBaseOpDiscard #-}++-- | Transform an action in @t m@ using a transformer that operates on the underlying monad @m@+liftThrough+ :: (MonadTransControl t stT, Monad (t m), Monad m)+ => (m (stT a) -> m (stT b)) -- ^+ -> t m a -> t m b+liftThrough f t = do+ st <- liftWith $ \run -> do+ f $ run t+ restoreT $ return st
+ LICENSE view
@@ -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.
+ README.markdown view
@@ -0,0 +1,20 @@+[](https://hackage.haskell.org/package/monad-control)+[](https://travis-ci.org/basvandijk/monad-control)++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`.++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`.++[This `criterion`](https://github.com/basvandijk/bench-monad-peel-control)+based benchmark shows that `monad-control` is on average about 2.5+times faster than `monad-peel`.
+ monad-control-aligned.cabal view
@@ -0,0 +1,40 @@+Name: monad-control-aligned+Version: 0.0.0+Synopsis: Just like monad-control, except less efficient, and the monadic state terms are all * -> *+License: BSD3+License-file: LICENSE+Author: Athan Clark+Maintainer: Athan Clark <athan.clark@gmail.com>+Copyright: (c) 2011 Bas van Dijk, Anders Kaseorg+Homepage: https://github.com/athanclark/monad-control#readme+Bug-reports: https://github.com/athanclark/monad-control/issues+Category: Control+Build-type: Simple+Cabal-version: >= 1.6+-- Description:+extra-source-files: README.markdown, CHANGELOG+tested-with:+ GHC==7.4.2,+ GHC==7.6.3,+ GHC==7.8.4,+ GHC==7.10.3,+ GHC==8.0.1++--------------------------------------------------------------------------------++source-repository head+ type: git+ location: git://github.com/athanclark/monad-control.git++--------------------------------------------------------------------------------++Library+ Exposed-modules: Control.Monad.Trans.Control++ Build-depends: base >= 4.5 && < 5+ , stm >= 2.3 && < 3+ , transformers >= 0.2 && < 0.6+ , transformers-compat >= 0.3 && < 0.6+ , transformers-base >= 0.4.4 && < 0.5++ Ghc-options: -Wall