monad-control 0.2.0.1 → 0.2.0.2
raw patch · 6 files changed
+375/−212 lines, 6 filesdep ~basedep ~test-frameworksetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base, test-framework
API changes (from Hackage documentation)
- Control.Exception.Control: blocked :: MonadIO m => m Bool
Files
- Control/Exception/Control.hs +11/−2
- NEWS +323/−0
- README.markdown +19/−0
- Setup.hs +4/−22
- monad-control.cabal +18/−29
- test.hs +0/−159
Control/Exception/Control.hs view
@@ -47,8 +47,10 @@ #else , block, unblock #endif- , blocked +#if !MIN_VERSION_base(4,4,0)+ , blocked+#endif -- * Brackets , bracket, bracket_, bracketOnError @@ -65,7 +67,6 @@ import Data.Function ( ($) ) import Data.Either ( Either(Left, Right), either ) import Data.Maybe ( Maybe )-import Data.Bool ( Bool ) import Control.Monad ( Monad, (>>=), return, liftM ) import System.IO.Error ( IOError ) @@ -96,12 +97,18 @@ #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@@ -256,11 +263,13 @@ 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 --------------------------------------------------------------------------------
+ NEWS view
@@ -0,0 +1,323 @@+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
+ README.markdown view
@@ -0,0 +1,19 @@+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`.++[This `critertion`](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`.
Setup.hs view
@@ -10,17 +10,12 @@ ------------------------------------------------------------------------------- -- from base-import Control.Monad ( (>>), return )-import Data.Bool ( Bool )-import System.Cmd ( system )-import System.FilePath ( (</>) )-import System.IO ( IO )+import System.IO ( IO ) -- from cabal import Distribution.Simple ( defaultMainWithHooks , simpleUserHooks- , UserHooks(runTests, haddockHook)- , Args+ , UserHooks(haddockHook) ) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )@@ -30,26 +25,13 @@ ---------------------------------------------------------------------------------- Cabal setup program with support for 'cabal test' and--- which sets the CPP define '__HADDOCK __' when haddock is run.+-- Cabal setup program which sets the CPP define '__HADDOCK __' when haddock is run. ------------------------------------------------------------------------------- main ∷ IO () main = defaultMainWithHooks hooks where- hooks = simpleUserHooks- { runTests = runTests'- , haddockHook = haddockHook'- }---- Run a 'test' binary that gets built when configured with '-ftest'.-runTests' ∷ Args → Bool → PackageDescription → LocalBuildInfo → IO ()-runTests' _ _ _ _ = system testcmd >> return ()- where testcmd = "."- </> "dist"- </> "build"- </> "test-monad-control"- </> "test-monad-control"+ hooks = simpleUserHooks { haddockHook = haddockHook' } -- Define __HADDOCK__ for CPP when running haddock. haddockHook' ∷ PackageDescription → LocalBuildInfo → UserHooks → HaddockFlags → IO ()
monad-control.cabal view
@@ -1,5 +1,5 @@ Name: monad-control-Version: 0.2.0.1+Version: 0.2.0.2 Synopsis: Lift control operations, like exception catching, through monad transformers Description: This package defines the type class @MonadControlIO@, a subset of@@ -21,32 +21,26 @@ The following @critertion@ based benchmark shows that @monad-control@ is on average about 2.5 times faster than @monad-peel@: .- <http://code.haskell.org/~basvandijk/code/bench-monad-peel-control>+ <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/+Bug-reports: https://github.com/basvandijk/monad-control/issues Category: Control Build-type: Custom-Cabal-version: >= 1.6----------------------------------------------------------------------------------+Cabal-version: >= 1.9.2 -source-repository head- type: darcs- location: http://code.haskell.org/~basvandijk/code/monad-control+extra-source-files: README.markdown, NEWS -------------------------------------------------------------------------------- -flag test- description: Build the testing suite- default: False--flag hpc- description: Enable program coverage on test executable- default: False+source-repository head+ type: git+ location: git://github.com/basvandijk/monad-control.git -------------------------------------------------------------------------------- @@ -55,7 +49,7 @@ Control.Monad.IO.Control Control.Exception.Control - Build-depends: base >= 3 && < 4.4+ Build-depends: base >= 3 && < 4.5 , base-unicode-symbols >= 0.1.1 && < 0.3 , transformers >= 0.2 && < 0.3 @@ -63,22 +57,17 @@ -------------------------------------------------------------------------------- -executable test-monad-control+test-suite test-threads+ type: exitcode-stdio-1.0 main-is: test.hs ghc-options: -Wall - if flag(test)- build-depends: base >= 3 && < 4.4- , base-unicode-symbols >= 0.1.1 && < 0.3- , HUnit >= 1.2.2 && < 1.3- , test-framework >= 0.2.4 && < 0.4- , test-framework-hunit >= 0.2.4 && < 0.3- buildable: True- else- buildable: False-- if flag(hpc)- ghc-options: -fhpc+ 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 --------------------------------------------------------------------------------
− test.hs
@@ -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]