exceptions 0.9.0 → 0.10.0

raw patch · 6 files changed

+479/−185 lines, 6 filesdep ~QuickCheckdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, template-haskell

API changes (from Hackage documentation)

Files

• .travis.yml +2/−3
• CHANGELOG.markdown +12/−0
• exceptions.cabal +1/−1
• src/Control/Monad/Catch.hs +312/−147
• src/Control/Monad/Catch/Pure.hs +12/−9
• tests/Control/Monad/Catch/Tests.hs +140/−25

@@ -61,8 +61,8 @@     # env: TEST=--disable-tests BENCH=--disable-benchmarks       addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}     - compiler: "ghc-8.4.1"-      env: GHCHEAD=true-      addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}+    # env: TEST=--disable-tests BENCH=--disable-benchmarks+      addons: {apt: {packages: [*apt_packages,cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}     - compiler: "ghc-head"       env: GHCHEAD=true       addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-head], sources: [hvr-ghc]}}@@ -70,7 +70,6 @@   allow_failures:     - compiler: "ghc-7.0.4"     - compiler: "ghc-7.2.2"-    - compiler: "ghc-8.4.1"     - compiler: "ghc-head"  before_install:

@@ -1,3 +1,15 @@+0.10.0+------+* Fix a regression in 0.9.0 whereby the non-IO effects in `bracket`'s `use`+  action were not visible to the `release` action, and the non-IO effects in the+  `release` action were not visible after the `bracket` call.+* The type of `generalBracket` was changed in order to restore those non-IO+  effects, so if you are a library author that provides a `MonadMask` instance,+  you will need to update your implementation of this method.+* Add `MonadMask` instance for `MaybeT`+* Add `onError` function whose action also runs on errors which are not+  exceptions, such as a `Nothing` or a `Left`.+ 0.9.0 ----- * Add `generalBracket` to the `MonadMask` typeclass, allowing more

@@ -1,6 +1,6 @@ name:          exceptions category:      Control, Exceptions, Monad-version:       0.9.0+version:       0.10.0 cabal-version: >= 1.8 license:       BSD3 license-file:  LICENSE

@@ -48,6 +48,7 @@     MonadThrow(..)   , MonadCatch(..)   , MonadMask(..)+  , ExitCase(..)      -- * Utilities     -- $utilities@@ -66,6 +67,7 @@   , try   , tryJust   , onException+  , onError   , bracket   , bracket_   , finally@@ -105,6 +107,10 @@ import Data.Monoid #endif +#if __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif+ ------------------------------------------------------------------------------ -- $mtl -- The mtl style typeclass@@ -153,17 +159,36 @@ -- asynchronous exceptions. Continuation-based monads are invalid -- instances of this class. ----- Note that this package /does/ provide a @MonadMask@ instance for @CatchT@.--- This instance is /only/ valid if the base monad provides no ability to--- provide multiple exit. For example, @IO@ or @Either@ would be invalid base--- monads, but @Reader@ or @State@ would be acceptable.--- -- Instances should ensure that, in the following code: ----- > f `finally` g+-- > fg = f `finally` g -- -- The action @g@ is called regardless of what occurs within @f@, including--- async exceptions.+-- async exceptions. Some monads allow @f@ to abort the computation via other+-- effects than throwing an exception. For simplicity, we will consider aborting+-- and throwing an exception to be two forms of "throwing an error".+--+-- If @f@ and @g@ both throw an error, the error thrown by @fg@ depends on which+-- errors we're talking about. In a monad transformer stack, the deeper layers+-- override the effects of the inner layers; for example, @ExceptT e1 (Except+-- e2) a@ represents a value of type @Either e2 (Either e1 a)@, so throwing both+-- an @e1@ and an @e2@ will result in @Left e2@. If @f@ and @g@ both throw an+-- error from the same layer, instances should ensure that the error from @g@+-- wins.+--+-- Effects other than throwing an error are also overriden by the deeper layers.+-- For example, @StateT s Maybe a@ represents a value of type @s -> Maybe (a,+-- s)@, so if an error thrown from @f@ causes this function to return @Nothing@,+-- any changes to the state which @f@ also performed will be erased. As a+-- result, @g@ will see the state as it was before @f@. Once @g@ completes,+-- @f@'s error will be rethrown, so @g@' state changes will be erased as well.+-- This is the normal interaction between effects in a monad transformer stack.+--+-- By contrast, <https://hackage.haskell.org/package/lifted-base lifted-base>'s+-- version of 'finally' always discards all of @g@'s non-IO effects, and @g@+-- never sees any of @f@'s non-IO effects, regardless of the layer ordering and+-- regardless of whether @f@ throws an error. This is not the result of+-- interacting effects, but a consequence of @MonadBaseControl@'s approach. class MonadCatch m => MonadMask m where   -- | Runs an action with asynchronous exceptions disabled. The action is   -- provided a method for restoring the async. environment to what it was@@ -178,15 +203,17 @@   -- and/or unkillable.   uninterruptibleMask :: ((forall a. m a -> m a) -> m b) -> m b -  -- | A generalized version of the standard bracket function which allows-  -- distinguishing different exit cases. Instead of providing it a single-  -- release action, this function takes two different actions: one for the-  -- case of a successful run of the inner function, and one in the case of an-  -- exception. The former function is provided the acquired value, while-  -- the exception release function is provided both the acquired value and-  -- the exception that was thrown. The result values of both of these-  -- functions are ignored.+  -- | A generalized version of 'bracket' which uses 'ExitCase' to distinguish+  -- the different exit cases, and returns the values of both the 'use' and+  -- 'release' actions. In practice, this extra information is rarely needed,+  -- so it is often more convenient to use one of the simpler functions which+  -- are defined in terms of this one, such as 'bracket', 'finally', 'onError',+  -- and 'bracketOnError'.   --+  -- This function exists because in order to thread their effects through the+  -- execution of 'bracket', monad transformers need values to be threaded from+  -- 'use' to 'release' and from 'release' to the output value.+  --   -- /NOTE/ This method was added in version 0.9.0 of this   -- library. Previously, implementation of functions like 'bracket'   -- and 'finally' in this module were based on the 'mask' and@@ -194,62 +221,98 @@   -- tranformers from having @MonadMask@ instances (notably   -- multi-exit-point transformers like 'ExceptT'). If you are a   -- library author, you'll now need to provide an implementation for-  -- this method. As two examples, here is a @ReaderT@ implementation:+  -- this method. The @StateT@ implementation demonstrates most of the+  -- subtleties:   --   -- @-  -- generalBracket acquire release cleanup use = ReaderT $ \r ->-  --   generalBracket-  --     (runReaderT acquire r)-  --     (\resource -> runReaderT (release resource) r)-  --     (\resource e -> runReaderT (cleanup resource e) r)-  --     (\resource -> runReaderT (use resource) r)+  -- generalBracket acquire release use = StateT $ \s0 -> do+  --   ((b, _s2), (c, s3)) <- generalBracket+  --     (runStateT acquire s0)+  --     (\(resource, s1) exitCase -> case exitCase of+  --       ExitCaseSuccess (b, s2) -> runStateT (release resource (ExitCaseSuccess b)) s2+  --+  --       -- In the two other cases, the base monad overrides @use@'s state+  --       -- changes and the state reverts to @s1@.+  --       ExitCaseException e     -> runStateT (release resource (ExitCaseException e)) s1+  --       ExitCaseAbort           -> runStateT (release resource ExitCaseAbort) s1+  --     )+  --     (\(resource, s1) -> runStateT (use resource) s1)+  --   return ((b, c), s3)   -- @   ---  -- This implementation reuses the base monad's @generalBracket@, and-  -- simply uses the @ReaderT@ environment to run the relevant-  -- @acquire@, @release@, @cleanup@ (for exceptions), and @use@-  -- actions. A more complicated example is the implementation for-  -- @ExceptT@, which must implement @ExceptT@'s short-circuit logic-  -- itself:+  -- The @StateT s m@ implementation of @generalBracket@ delegates to the @m@+  -- implementation of @generalBracket@. The @acquire@, @use@, and @release@+  -- arguments given to @StateT@'s implementation produce actions of type+  -- @StateT s m a@, @StateT s m b@, and @StateT s m c@. In order to run those+  -- actions in the base monad, we need to call @runStateT@, from which we+  -- obtain actions of type @m (a, s)@, @m (b, s)@, and @m (c, s)@. Since each+  -- action produces the next state, it is important to feed the state produced+  -- by the previous action to the next action.   --+  -- In the 'ExitCaseSuccess' case, the state starts at @s0@, flows through+  -- @acquire@ to become @s1@, flows through @use@ to become @s2@, and finally+  -- flows through @release@ to become @s3@. In the other two cases, @release@+  -- does not receive the value @s2@, so its action cannot see the state changes+  -- performed by @use@. This is fine, because in those two cases, an error was+  -- thrown in the base monad, so as per the usual interaction between effects+  -- in a monad transformer stack, those state changes get reverted. So we start+  -- from @s1@ instead.+  --+  -- Finally, the @m@ implementation of @generalBracket@ returns the pairs+  -- @(b, s)@ and @(c, s)@. For monad transformers other than @StateT@, this+  -- will be some other type representing the effects and values performed and+  -- returned by the @use@ and @release@ actions. The effect part of the @use@+  -- result, in this case @_s2@, usually needs to be discarded, since those+  -- effects have already been incorporated in the @release@ action.+  --+  -- The only effect which is intentionally not incorporated in the @release@+  -- action is the effect of throwing an error. In that case, the error must be+  -- re-thrown. One subtlety which is easy to miss is that in the case in which+  -- @use@ and @release@ both throw an error, the error from @release@ should+  -- take priority. Here is an implementation for @ExceptT@ which demonstrates+  -- how to do this.+  --   -- @-  -- generalBracket acquire release cleanup use = ExceptT $-  --   generalBracket+  -- generalBracket acquire release use = ExceptT $ do+  --   (eb, ec) <- generalBracket   --     (runExceptT acquire)-  --     (\eresource ->-  --       case eresource of-  --         Left _ -> return ()-  --         Right resource -> runExceptT (release resource) >> return ())-  --     (\eresource e ->-  --        case eresource of-  --          Left _ -> return ()-  --          Right resource -> runExceptT (cleanup resource e) >> return ())+  --     (\eresource exitCase -> case eresource of+  --       Left e -> return (Left e) -- nothing to release, acquire didn't succeed+  --       Right resource -> case exitCase of+  --         ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))+  --         ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))+  --         _                         -> runExceptT (release resource ExitCaseAbort))   --     (either (return . Left) (runExceptT . use))+  --   return $ do+  --     -- The order in which we perform those two 'Either' effects determines+  --     -- which error will win if they are both 'Left's. We want the error from+  --     -- 'release' to win.+  --     c <- ec+  --     b <- eb+  --     return (b, c)   -- @   ---  -- In this implementation, we need to deal with the potential that-  -- the @acquire@ action returned a @Left@ (as opposed to succeeding-  -- with a @Right@ or throwing an exception via @throwM@), and-  -- therefore have to handle the @Left@ case explicitly when provide-  -- @release@, @cleanup@, and @use@ actions to the base monad's-  -- implementation of @generalBracket@.-  ---  -- You should ensure that in all cases of the @acquire@ action-  -- completing successfully, either the @release@ or @cleanup@-  -- actions are called, regardless of what occurs in @use@.-  --   -- @since 0.9.0   generalBracket     :: m a     -- ^ acquire some resource-    -> (a -> m ignored1)-    -- ^ release, no exception thrown-    -> (a -> SomeException -> m ignored2)-    -- ^ release, some exception thrown; the exception will be rethrown+    -> (a -> ExitCase b -> m c)+    -- ^ release the resource, observing the outcome of the inner action     -> (a -> m b)     -- ^ inner action to perform with the resource-    -> m b+    -> m (b, c) +-- | A 'MonadMask' computation may either succeed with a value, abort with an+-- exception, or abort for some other reason. For example, in @ExceptT e IO@+-- you can use 'throwM' to abort with an exception ('ExitCaseException') or+-- 'Control.Monad.Trans.Except.throwE' to abort with a value of type 'e'+-- ('ExitCaseAbort').+data ExitCase a+  = ExitCaseSuccess a+  | ExitCaseException SomeException+  | ExitCaseAbort+  deriving Show+ instance MonadThrow [] where   throwM _ = [] instance MonadThrow Maybe where@@ -264,13 +327,13 @@ instance MonadMask IO where   mask = ControlException.mask   uninterruptibleMask = ControlException.uninterruptibleMask-  generalBracket acquire release cleanup use = mask $ \unmasked -> do+  generalBracket acquire release use = mask $ \unmasked -> do     resource <- acquire-    result <- unmasked (use resource) `catch` \e -> do-      _ <- cleanup resource e+    b <- unmasked (use resource) `catch` \e -> do+      _ <- release resource (ExitCaseException e)       throwM e-    _ <- release resource-    return result+    c <- release resource (ExitCaseSuccess b)+    return (b, c)  instance MonadThrow STM where   throwM = STM.throwSTM@@ -291,15 +354,15 @@   mask f = f id   uninterruptibleMask f = f id -  generalBracket acquire release cleanup use =+  generalBracket acquire release use =     case acquire of       Left e -> Left e       Right resource ->         case use resource of-          Left e -> cleanup resource e >> Left e-          Right result -> do-            _ <- release resource-            return result+          Left e -> release resource (ExitCaseException e) >> Left e+          Right b -> do+            c <- release resource (ExitCaseSuccess b)+            return (b, c)  instance MonadThrow m => MonadThrow (IdentityT m) where   throwM e = lift $ throwM e@@ -314,11 +377,10 @@       where q :: (m a -> m a) -> IdentityT m a -> IdentityT m a             q u = IdentityT . u . runIdentityT -  generalBracket acquire release cleanup use = IdentityT $+  generalBracket acquire release use = IdentityT $     generalBracket       (runIdentityT acquire)-      (runIdentityT . release)-      (\resource e -> runIdentityT (cleanup resource e))+      (\resource exitCase -> runIdentityT (release resource exitCase))       (\resource -> runIdentityT (use resource))  instance MonadThrow m => MonadThrow (LazyS.StateT s m) where@@ -334,17 +396,20 @@       where q :: (m (a, s) -> m (a, s)) -> LazyS.StateT s m a -> LazyS.StateT s m a             q u (LazyS.StateT b) = LazyS.StateT (u . b) -  generalBracket acquire release cleanup use = LazyS.StateT $ \s0 ->-    generalBracket+  generalBracket acquire release use = LazyS.StateT $ \s0 -> do+    -- This implementation is given as an example in the documentation of+    -- 'generalBracket', so when changing it, remember to update the+    -- documentation's copy as well+    ((b, _s2), (c, s3)) <- generalBracket       (LazyS.runStateT acquire s0)--      -- Note that we're reverting to s1 here, the state after the-      -- acquire step, and _not_ getting the state from the successful-      -- run of the inner action. This is because we may be on top of-      -- something like ExceptT, where no updated state is available.-      (\(resource, s1) -> LazyS.runStateT (release resource) s1)-      (\(resource, s1) e -> LazyS.runStateT (cleanup resource e) s1)+      (\(resource, s1) exitCase -> case exitCase of+        ExitCaseSuccess (b, s2) -> LazyS.runStateT (release resource (ExitCaseSuccess b)) s2+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @s1@.+        ExitCaseException e     -> LazyS.runStateT (release resource (ExitCaseException e)) s1+        ExitCaseAbort           -> LazyS.runStateT (release resource ExitCaseAbort) s1)       (\(resource, s1) -> LazyS.runStateT (use resource) s1)+    return ((b, c), s3)  instance MonadThrow m => MonadThrow (StrictS.StateT s m) where   throwM e = lift $ throwM e@@ -359,12 +424,17 @@       where q :: (m (a, s) -> m (a, s)) -> StrictS.StateT s m a -> StrictS.StateT s m a             q u (StrictS.StateT b) = StrictS.StateT (u . b) -  generalBracket acquire release cleanup use = StrictS.StateT $ \s0 ->-    generalBracket+  generalBracket acquire release use = StrictS.StateT $ \s0 -> do+    ((b, _s2), (c, s3)) <- generalBracket       (StrictS.runStateT acquire s0)-      (\(resource, s1) -> StrictS.runStateT (release resource) s1)-      (\(resource, s1) e -> StrictS.runStateT (cleanup resource e) s1)+      (\(resource, s1) exitCase -> case exitCase of+        ExitCaseSuccess (b, s2) -> StrictS.runStateT (release resource (ExitCaseSuccess b)) s2+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @s1@.+        ExitCaseException e     -> StrictS.runStateT (release resource (ExitCaseException e)) s1+        ExitCaseAbort           -> StrictS.runStateT (release resource ExitCaseAbort) s1)       (\(resource, s1) -> StrictS.runStateT (use resource) s1)+    return ((b, c), s3)  instance MonadThrow m => MonadThrow (ReaderT r m) where   throwM e = lift $ throwM e@@ -379,11 +449,10 @@       where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a             q u (ReaderT b) = ReaderT (u . b) -  generalBracket acquire release cleanup use = ReaderT $ \r ->+  generalBracket acquire release use = ReaderT $ \r ->     generalBracket       (runReaderT acquire r)-      (\resource -> runReaderT (release resource) r)-      (\resource e -> runReaderT (cleanup resource e) r)+      (\resource exitCase -> runReaderT (release resource exitCase) r)       (\resource -> runReaderT (use resource) r)  instance (MonadThrow m, Monoid w) => MonadThrow (StrictW.WriterT w m) where@@ -399,18 +468,25 @@       where q :: (m (a, w) -> m (a, w)) -> StrictW.WriterT w m a -> StrictW.WriterT w m a             q u b = StrictW.WriterT $ u (StrictW.runWriterT b) -  generalBracket acquire release cleanup use = StrictW.WriterT $-    generalBracket+  generalBracket acquire release use = StrictW.WriterT $ do+    ((b, _w12), (c, w123)) <- generalBracket       (StrictW.runWriterT acquire)-      -- NOTE: The updated writer values here are actually going to be-      -- lost, as the return value of this cleanup is discarded-      (StrictW.runWriterT . release . fst)-      (\(resource, w1) e -> do-        (a, w2) <- StrictW.runWriterT (cleanup resource e)-        return (a, mappend w1 w2))+      (\(resource, w1) exitCase -> case exitCase of+        ExitCaseSuccess (b, w12) -> do+          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseSuccess b))+          return (c, mappend w12 w3)+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @w1@.+        ExitCaseException e -> do+          (c, w3) <- StrictW.runWriterT (release resource (ExitCaseException e))+          return (c, mappend w1 w3)+        ExitCaseAbort -> do+          (c, w3) <- StrictW.runWriterT (release resource ExitCaseAbort)+          return (c, mappend w1 w3))       (\(resource, w1) -> do         (a, w2) <- StrictW.runWriterT (use resource)         return (a, mappend w1 w2))+    return ((b, c), w123)  instance (MonadThrow m, Monoid w) => MonadThrow (LazyW.WriterT w m) where   throwM e = lift $ throwM e@@ -425,16 +501,25 @@       where q :: (m (a, w) -> m (a, w)) -> LazyW.WriterT w m a -> LazyW.WriterT w m a             q u b = LazyW.WriterT $ u (LazyW.runWriterT b) -  generalBracket acquire release cleanup use = LazyW.WriterT $-    generalBracket+  generalBracket acquire release use = LazyW.WriterT $ do+    ((b, _w12), (c, w123)) <- generalBracket       (LazyW.runWriterT acquire)-      (LazyW.runWriterT . release . fst)-      (\(resource, w1) e -> do-        (a, w2) <- LazyW.runWriterT (cleanup resource e)-        return (a, mappend w1 w2))+      (\(resource, w1) exitCase -> case exitCase of+        ExitCaseSuccess (b, w12) -> do+          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseSuccess b))+          return (c, mappend w12 w3)+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @w1@.+        ExitCaseException e -> do+          (c, w3) <- LazyW.runWriterT (release resource (ExitCaseException e))+          return (c, mappend w1 w3)+        ExitCaseAbort -> do+          (c, w3) <- LazyW.runWriterT (release resource ExitCaseAbort)+          return (c, mappend w1 w3))       (\(resource, w1) -> do         (a, w2) <- LazyW.runWriterT (use resource)         return (a, mappend w1 w2))+    return ((b, c), w123)  instance (MonadThrow m, Monoid w) => MonadThrow (LazyRWS.RWST r w s m) where   throwM e = lift $ throwM e@@ -449,17 +534,25 @@       where q :: (m (a, s, w) -> m (a, s, w)) -> LazyRWS.RWST r w s m a -> LazyRWS.RWST r w s m a             q u (LazyRWS.RWST b) = LazyRWS.RWST $ \ r s -> u (b r s) -  generalBracket acquire release cleanup use = LazyRWS.RWST $ \r s0 ->-    generalBracket+  generalBracket acquire release use = LazyRWS.RWST $ \r s0 -> do+    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket       (LazyRWS.runRWST acquire r s0)-      -- All comments from StateT and WriterT apply here too-      (\(resource, s1, _) -> LazyRWS.runRWST (release resource) r s1)-      (\(resource, s1, w1) e -> do-        (a, s2, w2) <- LazyRWS.runRWST (cleanup resource e) r s1-        return (a, s2, mappend w1 w2))+      (\(resource, s1, w1) exitCase -> case exitCase of+        ExitCaseSuccess (b, s2, w12) -> do+          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseSuccess b)) r s2+          return (c, s3, mappend w12 w3)+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @s1@ and @w1@.+        ExitCaseException e -> do+          (c, s3, w3) <- LazyRWS.runRWST (release resource (ExitCaseException e)) r s1+          return (c, s3, mappend w1 w3)+        ExitCaseAbort -> do+          (c, s3, w3) <- LazyRWS.runRWST (release resource ExitCaseAbort) r s1+          return (c, s3, mappend w1 w3))       (\(resource, s1, w1) -> do         (a, s2, w2) <- LazyRWS.runRWST (use resource) r s1         return (a, s2, mappend w1 w2))+    return ((b, c), s3, w123)  instance (MonadThrow m, Monoid w) => MonadThrow (StrictRWS.RWST r w s m) where   throwM e = lift $ throwM e@@ -474,16 +567,25 @@       where q :: (m (a, s, w) -> m (a, s, w)) -> StrictRWS.RWST r w s m a -> StrictRWS.RWST r w s m a             q u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s) -  generalBracket acquire release cleanup use = StrictRWS.RWST $ \r s0 ->-    generalBracket+  generalBracket acquire release use = StrictRWS.RWST $ \r s0 -> do+    ((b, _s2, _w12), (c, s3, w123)) <- generalBracket       (StrictRWS.runRWST acquire r s0)-      (\(resource, s1, _) -> StrictRWS.runRWST (release resource) r s1)-      (\(resource, s1, w1) e -> do-        (a, s2, w2) <- StrictRWS.runRWST (cleanup resource e) r s1-        return (a, s2, mappend w1 w2))+      (\(resource, s1, w1) exitCase -> case exitCase of+        ExitCaseSuccess (b, s2, w12) -> do+          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseSuccess b)) r s2+          return (c, s3, mappend w12 w3)+        -- In the two other cases, the base monad overrides @use@'s state+        -- changes and the state reverts to @s1@ and @w1@.+        ExitCaseException e -> do+          (c, s3, w3) <- StrictRWS.runRWST (release resource (ExitCaseException e)) r s1+          return (c, s3, mappend w1 w3)+        ExitCaseAbort -> do+          (c, s3, w3) <- StrictRWS.runRWST (release resource ExitCaseAbort) r s1+          return (c, s3, mappend w1 w3))       (\(resource, s1, w1) -> do         (a, s2, w2) <- StrictRWS.runRWST (use resource) r s1         return (a, s2, mappend w1 w2))+    return ((b, c), s3, w123)  -- Transformers which are only instances of MonadThrow and MonadCatch, not MonadMask instance MonadThrow m => MonadThrow (ListT m) where@@ -497,7 +599,35 @@ -- | Catches exceptions from the base monad. instance MonadCatch m => MonadCatch (MaybeT m) where   catch (MaybeT m) f = MaybeT $ catch m (runMaybeT . f)+-- | @since 0.10.0+instance MonadMask m => MonadMask (MaybeT m) where+  mask f = MaybeT $ mask $ \u -> runMaybeT $ f (q u)+    where+      q :: (m (Maybe a) -> m (Maybe a))+        -> MaybeT m a -> MaybeT m a+      q u (MaybeT b) = MaybeT (u b)+  uninterruptibleMask f = MaybeT $ uninterruptibleMask $ \u -> runMaybeT $ f (q u)+    where+      q :: (m (Maybe a) -> m (Maybe a))+        -> MaybeT m a -> MaybeT m a+      q u (MaybeT b) = MaybeT (u b) +  generalBracket acquire release use = MaybeT $ do+    (eb, ec) <- generalBracket+      (runMaybeT acquire)+      (\resourceMay exitCase -> case resourceMay of+        Nothing -> return Nothing -- nothing to release, acquire didn't succeed+        Just resource -> case exitCase of+          ExitCaseSuccess (Just b) -> runMaybeT (release resource (ExitCaseSuccess b))+          ExitCaseException e      -> runMaybeT (release resource (ExitCaseException e))+          _                        -> runMaybeT (release resource ExitCaseAbort))+      (\resourceMay -> case resourceMay of+        Nothing -> return Nothing+        Just resource -> runMaybeT (use resource))+    -- The order in which we perform those two 'Maybe' effects doesn't matter,+    -- since the error message is the same regardless.+    return ((,) <$> eb <*> ec)+ -- | Throws exceptions into the base monad. instance (Error e, MonadThrow m) => MonadThrow (ErrorT e m) where   throwM = lift . throwM@@ -516,18 +646,23 @@         -> ErrorT e m a -> ErrorT e m a       q u (ErrorT b) = ErrorT (u b) -  generalBracket acquire release cleanup use = ErrorT $-    generalBracket+  generalBracket acquire release use = ErrorT $ do+    (eb, ec) <- generalBracket       (runErrorT acquire)-      (\eresource ->-        case eresource of-          Left _ -> return () -- nothing to release, it didn't succeed-          Right resource -> runErrorT (release resource) >> return ())-      (\eresource e ->-         case eresource of-           Left _ -> return ()-           Right resource -> runErrorT (cleanup resource e) >> return ())+      (\eresource exitCase -> case eresource of+        Left e -> return (Left e) -- nothing to release, acquire didn't succeed+        Right resource -> case exitCase of+          ExitCaseSuccess (Right b) -> runErrorT (release resource (ExitCaseSuccess b))+          ExitCaseException e       -> runErrorT (release resource (ExitCaseException e))+          _                         -> runErrorT (release resource ExitCaseAbort))       (either (return . Left) (runErrorT . use))+    return $ do+      -- The order in which we perform those two 'Either' effects determines+      -- which error will win if they are both 'Left's. We want the error from+      -- 'release' to win.+      c <- ec+      b <- eb+      return (b, c)  -- | Throws exceptions into the base monad. instance MonadThrow m => MonadThrow (ExceptT e m) where@@ -535,6 +670,7 @@ -- | Catches exceptions from the base monad. instance MonadCatch m => MonadCatch (ExceptT e m) where   catch (ExceptT m) f = ExceptT $ catch m (runExceptT . f)+-- | @since 0.9.0 instance MonadMask m => MonadMask (ExceptT e m) where   mask f = ExceptT $ mask $ \u -> runExceptT $ f (q u)     where@@ -547,18 +683,26 @@         -> ExceptT e m a -> ExceptT e m a       q u (ExceptT b) = ExceptT (u b) -  generalBracket acquire release cleanup use = ExceptT $-    generalBracket+  generalBracket acquire release use = ExceptT $ do+    -- This implementation is given as an example in the documentation of+    -- 'generalBracket', so when changing it, remember to update the+    -- documentation's copy as well+    (eb, ec) <- generalBracket       (runExceptT acquire)-      (\eresource ->-        case eresource of-          Left _ -> return ()-          Right resource -> runExceptT (release resource) >> return ())-      (\eresource e ->-         case eresource of-           Left _ -> return ()-           Right resource -> runExceptT (cleanup resource e) >> return ())+      (\eresource exitCase -> case eresource of+        Left e -> return (Left e) -- nothing to release, acquire didn't succeed+        Right resource -> case exitCase of+          ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))+          ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))+          _                         -> runExceptT (release resource ExitCaseAbort))       (either (return . Left) (runExceptT . use))+    return $ do+      -- The order in which we perform those two 'Either' effects determines+      -- which error will win if they are both 'Left's. We want the error from+      -- 'release' to win.+      c <- ec+      b <- eb+      return (b, c)  instance MonadThrow m => MonadThrow (ContT r m) where   throwM = lift . throwM@@ -583,6 +727,9 @@  -- | Catches all exceptions, and somewhat defeats the purpose of the extensible -- exception system. Use sparingly.+--+-- /NOTE/ This catches all /exceptions/, but if the monad supports other ways of+-- aborting the computation, those other kinds of errors will not be caught. catchAll :: MonadCatch m => m a -> (SomeException -> m a) -> m a catchAll = catch @@ -653,44 +800,62 @@  -- | Run an action only if an exception is thrown in the main action. The -- exception is not caught, simply rethrown.+--+-- /NOTE/ The action is only run if an /exception/ is thrown. If the monad+-- supports other ways of aborting the computation, the action won't run if+-- those other kinds of errors are thrown. See 'onError'. onException :: MonadCatch m => m a -> m b -> m a onException action handler = action `catchAll` \e -> handler >> throwM e +-- | Run an action only if an error is thrown in the main action. Unlike+-- 'onException', this works with every kind of error, not just exceptions. For+-- example, if @f@ is an 'ExceptT' computation which aborts with a 'Left', the+-- computation @onError f g@ will execute @g@, while @onException f g@ will not.+--+-- This distinction is only meaningful for monads which have multiple exit+-- points, such as 'Except' and 'MaybeT'. For monads that only have a single+-- exit point, there is no difference between 'onException' and 'onError',+-- except that 'onError' has a more constrained type.+--+-- @since 0.10.0+onError :: MonadMask m => m a -> m b -> m a+onError action handler = bracketOnError (return ()) (const handler) (const action)+ -- | Generalized abstracted pattern of safe resource acquisition and release--- in the face of exceptions. The first action \"acquires\" some value, which+-- in the face of errors. The first action \"acquires\" some value, which -- is \"released\" by the second action at the end. The third action \"uses\" -- the value and its result is the result of the 'bracket'. ----- If an exception occurs during the use, the release still happens before the--- exception is rethrown.+-- If an error is thrown during the use, the release still happens before the+-- error is rethrown. -- -- Note that this is essentially a type-specialized version of -- 'generalBracket'. This function has a more common signature (matching the -- signature from "Control.Exception"), and is often more convenient to use. By -- contrast, 'generalBracket' is more expressive, allowing us to implement -- other functions like 'bracketOnError'.-bracket :: MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c-bracket acquire release use = generalBracket+bracket :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b+bracket acquire release = liftM fst . generalBracket   acquire-  release-  (\a _e -> release a)-  use+  (\a _exitCase -> release a)  -- | Version of 'bracket' without any value being passed to the second and -- third actions.-bracket_ :: MonadMask m => m a -> m b -> m c -> m c+bracket_ :: MonadMask m => m a -> m c -> m b -> m b bracket_ before after action = bracket before (const after) (const action)  -- | Perform an action with a finalizer action that is run, even if an--- exception occurs.+-- error occurs. finally :: MonadMask m => m a -> m b -> m a finally action finalizer = bracket_ (return ()) finalizer action --- | Like 'bracket', but only performs the final action if there was an--- exception raised by the in-between computation.-bracketOnError :: MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c-bracketOnError acquire release use = generalBracket+-- | Like 'bracket', but only performs the final action if an error is+-- thrown by the in-between computation.+bracketOnError :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b+bracketOnError acquire release = liftM fst . generalBracket   acquire-  (\_ -> return ())-  (\a _e -> release a)-  use+  (\a exitCase -> case exitCase of+    ExitCaseSuccess _ -> return ()+    _ -> do+      _ <- release a+      return ())

@@ -156,22 +156,25 @@     Right a -> return (Right a) -- | Note: This instance is only valid if the underlying monad has a single -- exit point!+--+-- For example, @IO@ or @Either@ would be invalid base monads, but+-- @Reader@ or @State@ would be acceptable. instance Monad m => MonadMask (CatchT m) where   mask a = a id   uninterruptibleMask a = a id-  generalBracket acquire release cleanup use = CatchT $ do+  generalBracket acquire release use = CatchT $ do     eresource <- runCatchT acquire     case eresource of       Left e -> return $ Left e       Right resource -> do-        eresult <- runCatchT (use resource)-        case eresult of-          Left e -> do-            _ <- runCatchT (cleanup resource e)-            return $ Left e-          Right result -> do-            _ <- runCatchT (release resource)-            return $ Right result+        eb <- runCatchT (use resource)+        case eb of+          Left e -> runCatchT $ do+            _ <- release resource (ExitCaseException e)+            throwM e+          Right b -> runCatchT $ do+            c <- release resource (ExitCaseSuccess b)+            return (b, c)  instance MonadState s m => MonadState s (CatchT m) where   get = lift get

@@ -45,20 +45,30 @@  instance Exception TestException -data MSpec = forall m. (MonadCatch m) => MSpec+data MSpec m = MSpec     { mspecName :: String     , mspecRunner :: (m Property -> Property)     } -testMonadCatch :: MSpec -> Property-testMonadCatch MSpec { mspecRunner } = monadic mspecRunner $+-- the @m Bool@ determines whether the @m ()@ has executed+data DetectableEffect m = DetectableEffect+    { detectableEffectMSpec :: MSpec m+    , detectableEffectEffectDetector :: m (m (), m Bool)+    }++data SomeMSpec = forall m. (MonadCatch m) => SomeMSpec (MSpec m)++data SomeDetectableEffect = forall m. (MonadMask m) => SomeDetectableEffect (DetectableEffect m)++testMonadCatch :: SomeMSpec -> Property+testMonadCatch (SomeMSpec MSpec { mspecRunner }) = monadic mspecRunner $     run $ catch failure handler   where     failure = throwM (TestException "foo") >> error "testMonadCatch"     handler (_ :: TestException) = return () -testCatchJust :: MSpec -> Property-testCatchJust MSpec { mspecRunner } = monadic mspecRunner $ do+testCatchJust :: SomeMSpec -> Property+testCatchJust (SomeMSpec MSpec { mspecRunner }) = monadic mspecRunner $ do     nice <- run $ catchJust testException posFailure posHandler     assert $ nice == ("pos", True)     bad <- run $ catch (catchJust testException negFailure posHandler) negHandler@@ -70,48 +80,153 @@     posFailure = throwM (TestException "pos") >> error "testCatchJust pos"     negFailure = throwM (TestException "neg") >> error "testCatchJust neg" +testDetectableEffect :: SomeDetectableEffect -> Property+testDetectableEffect (SomeDetectableEffect (DetectableEffect mspec effectDetector)) = do+    monadic (mspecRunner mspec) $ do+        effectWasPerformed <- run $ do+          (effect, detector) <- effectDetector+          runExceptT $ ExceptT (return $ Left ()) `finally` lift effect+          detector+        assert effectWasPerformed+ tests :: Test tests = testGroup "Control.Monad.Catch.Tests" $    ([ mkMonadCatch     , mkCatchJust     ] <*> mspecs) +++   ([ mkDetectableEffect+    ] <*> detectableEffects) ++     [ testCase "ExceptT+Left" exceptTLeft+    , testCase "release error wins" releaseErrorWins     ]   where     mspecs =-        [ MSpec "IO" io-        , MSpec "IdentityT IO" $ io . runIdentityT-        , MSpec "LazyState.StateT IO" $ io . flip LazyState.evalStateT ()-        , MSpec "StrictState.StateT IO" $ io . flip StrictState.evalStateT ()-        , MSpec "ReaderT IO" $ io . flip runReaderT ()-        , MSpec "LazyWriter.WriterT IO" $ io . fmap tfst . LazyWriter.runWriterT-        , MSpec "StrictWriter.WriterT IO" $ io . fmap tfst . StrictWriter.runWriterT-        , MSpec "LazyRWS.RWST IO" $ \m -> io $ fmap tfst $ LazyRWS.evalRWST m () ()-        , MSpec "StrictRWS.RWST IO" $ \m -> io $ fmap tfst $ StrictRWS.evalRWST m () ()+        [ SomeMSpec mspecIO+        , SomeMSpec mspecIdentityTIO+        , SomeMSpec mspecLazyStateTIO+        , SomeMSpec mspecStrictStateTIO+        , SomeMSpec mspecReaderTIO+        , SomeMSpec mspecLazyWriterTIO+        , SomeMSpec mspecStrictWriterTIO+        , SomeMSpec mspecLazyRWSTIO+        , SomeMSpec mspecStrictRWSTIO -        , MSpec "ListT IO" $ \m -> io $ fmap (\[x] -> x) (runListT m)-        , MSpec "MaybeT IO" $ \m -> io $ fmap (maybe undefined id) (runMaybeT m)-        , MSpec "ErrorT IO" $ \m -> io $ fmap (either error id) (runErrorT m)-        , MSpec "STM" $ io . atomically-        --, MSpec "ContT IO" $ \m -> io $ runContT m return+        , SomeMSpec mspecListTIO+        , SomeMSpec mspecMaybeTIO+        , SomeMSpec mspecErrorTIO+        , SomeMSpec mspecSTM+        --, SomeMSpec mspecContTIO -        , MSpec "CatchT Identity" $ fromRight . runCatch-        , MSpec "Either SomeException" fromRight+        , SomeMSpec mspecCatchTIdentity+        , SomeMSpec mspecEitherSomeException         ] +    mspecIO :: MSpec IO+    mspecIO = MSpec "IO" io++    mspecIdentityTIO :: MSpec (IdentityT IO)+    mspecIdentityTIO = MSpec "IdentityT IO" $ io . runIdentityT++    mspecLazyStateTIO :: MSpec (LazyState.StateT Bool IO)+    mspecLazyStateTIO = MSpec "LazyState.StateT IO" $ io . flip LazyState.evalStateT False++    mspecStrictStateTIO :: MSpec (StrictState.StateT Bool IO)+    mspecStrictStateTIO = MSpec "StrictState.StateT IO" $ io . flip StrictState.evalStateT False++    mspecReaderTIO :: MSpec (ReaderT () IO)+    mspecReaderTIO = MSpec "ReaderT IO" $ io . flip runReaderT ()++    mspecLazyWriterTIO :: MSpec (LazyWriter.WriterT () IO)+    mspecLazyWriterTIO = MSpec "LazyWriter.WriterT IO" $ io . fmap tfst . LazyWriter.runWriterT++    mspecStrictWriterTIO :: MSpec (StrictWriter.WriterT () IO)+    mspecStrictWriterTIO = MSpec "StrictWriter.WriterT IO" $ io . fmap tfst . StrictWriter.runWriterT++    mspecLazyRWSTIO :: MSpec (LazyRWS.RWST () () Bool IO)+    mspecLazyRWSTIO = MSpec "LazyRWS.RWST IO" $ \m -> io $ fmap tfst $ LazyRWS.evalRWST m () False++    mspecStrictRWSTIO :: MSpec (StrictRWS.RWST () () Bool IO)+    mspecStrictRWSTIO = MSpec "StrictRWS.RWST IO" $ \m -> io $ fmap tfst $ StrictRWS.evalRWST m () False++    mspecListTIO :: MSpec (ListT IO)+    mspecListTIO = MSpec "ListT IO" $ \m -> io $ fmap (\[x] -> x) (runListT m)++    mspecMaybeTIO :: MSpec (MaybeT IO)+    mspecMaybeTIO = MSpec "MaybeT IO" $ \m -> io $ fmap (maybe undefined id) (runMaybeT m)++    mspecErrorTIO :: MSpec (ErrorT String IO)+    mspecErrorTIO = MSpec "ErrorT IO" $ \m -> io $ fmap (either error id) (runErrorT m)++    mspecSTM :: MSpec STM+    mspecSTM = MSpec "STM" $ io . atomically++    --mspecContTIO :: MSpec (ContT () IO)+    --mspecContTIO = MSpec "ContT IO" $ \m -> io $ runContT m return++    mspecCatchTIdentity :: MSpec Catch+    mspecCatchTIdentity = MSpec "Catch" $ fromRight . runCatch++    mspecEitherSomeException :: MSpec (Either SomeException)+    mspecEitherSomeException = MSpec "Either SomeException" fromRight+     tfst :: (Property, ()) -> Property = fst     fromRight (Left _) = error "fromRight"     fromRight (Right a) = a     io = morallyDubiousIOProperty -    mkMonadCatch = mkTestType "MonadCatch" testMonadCatch-    mkCatchJust = mkTestType "catchJust" testCatchJust+    detectableEffects =+        [ SomeDetectableEffect $ detectableEffectIO+        , SomeDetectableEffect detectableEffectLazyStateTIO+        , SomeDetectableEffect detectableEffectStrictStateTIO+        , SomeDetectableEffect detectableEffectLazyRWSTIO+        , SomeDetectableEffect detectableEffectStrictRWSTIO+        ] -    mkTestType name test = \spec ->-        testProperty (name ++ " " ++ mspecName spec) $ once $ test spec+    detectableEffectIO :: DetectableEffect IO+    detectableEffectIO = DetectableEffect mspecIO $ do+      ref <- newIORef False+      return (writeIORef ref True, readIORef ref) +    detectableEffectLazyStateTIO :: DetectableEffect (LazyState.StateT Bool IO)+    detectableEffectLazyStateTIO = DetectableEffect mspecLazyStateTIO $ do+      LazyState.put False+      return (LazyState.put True, LazyState.get)++    detectableEffectStrictStateTIO :: DetectableEffect (StrictState.StateT Bool IO)+    detectableEffectStrictStateTIO = DetectableEffect mspecStrictStateTIO $ do+      StrictState.put False+      return (StrictState.put True, StrictState.get)++    detectableEffectLazyRWSTIO :: DetectableEffect (LazyRWS.RWST () () Bool IO)+    detectableEffectLazyRWSTIO = DetectableEffect mspecLazyRWSTIO $ do+      LazyRWS.put False+      return (LazyRWS.put True, LazyRWS.get)++    detectableEffectStrictRWSTIO :: DetectableEffect (StrictRWS.RWST () () Bool IO)+    detectableEffectStrictRWSTIO = DetectableEffect mspecStrictRWSTIO $ do+      StrictRWS.put False+      return (StrictRWS.put True, StrictRWS.get)++    mkMonadCatch = mkMSpecTest "MonadCatch" testMonadCatch+    mkCatchJust = mkMSpecTest "catchJust" testCatchJust+    mkDetectableEffect = mkDetectableEffectTest "effect during release" testDetectableEffect++    mkMSpecTest :: String -> (SomeMSpec -> Property) -> SomeMSpec -> Test+    mkMSpecTest name test = \someMSpec@(SomeMSpec spec) ->+        testProperty (name ++ " " ++ mspecName spec) $ once $ test someMSpec++    mkDetectableEffectTest :: String -> (SomeDetectableEffect -> Property) -> SomeDetectableEffect -> Test+    mkDetectableEffectTest name test = \someDetectableEffect@(SomeDetectableEffect detectableEffect) ->+        let testName = name ++ " " ++ mspecName (detectableEffectMSpec detectableEffect)+        in testProperty testName $ once $ test someDetectableEffect+     exceptTLeft = do       ref <- newIORef False       Left () <- runExceptT $ ExceptT (return $ Left ()) `finally` lift (writeIORef ref True)       val <- readIORef ref       unless val $ error "Looks like cleanup didn't happen"++    -- if both 'use' and 'release' abort, the 'release' error should win+    releaseErrorWins = do+      Left val <- runExceptT $ ExceptT (return $ Left False) `finally` ExceptT (return $ Left True)+      unless val $ error "Looks like the 'use' error won"