safe-exceptions 0.1.7.1 → 0.1.7.2
raw patch · 5 files changed
+103/−47 lines, 5 filesdep ~basedep ~exceptionsdep ~transformers
Dependency ranges changed: base, exceptions, transformers
Files
- ChangeLog.md +5/−0
- README.md +2/−1
- safe-exceptions.cabal +4/−3
- src/Control/Exception/Safe.hs +35/−43
- test/Control/Exception/SafeSpec.hs +57/−0
ChangeLog.md view
@@ -1,5 +1,10 @@ # ChangeLog for safe-exceptions +## 0.1.7.2++* Changed `bracketWithError` and `bracketOnError` to use `generalBracket` from `MonadMask` [#36](https://github.com/fpco/safe-exceptions/issues/36)+* Raised dependency `exceptions` from `>= 0.8` to `>= 0.10`+ ## 0.1.7.1 * Doc update
README.md view
@@ -2,7 +2,8 @@ *Safe, consistent, and easy exception handling* -[](https://travis-ci.org/fpco/safe-exceptions) [](http://stackage.org/lts/package/safe-exceptions)+[](https://github.com/fpco/safe-exceptions/actions/workflows/tests.yml)+[](http://stackage.org/lts/package/safe-exceptions) > The documentation for this library is available on [Stackage](http://stackage.org/lts/package/safe-exceptions)
safe-exceptions.cabal view
@@ -1,5 +1,5 @@ name: safe-exceptions-version: 0.1.7.1+version: 0.1.7.2 synopsis: Safe, consistent, and easy exception handling description: Please see README.md homepage: https://github.com/fpco/safe-exceptions#readme@@ -16,9 +16,9 @@ library hs-source-dirs: src exposed-modules: Control.Exception.Safe- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4.11 && < 5 , deepseq >= 1.2 && < 1.5- , exceptions >= 0.8 && < 0.11+ , exceptions >= 0.10 && < 0.11 , transformers >= 0.2 && < 0.6 default-language: Haskell2010 @@ -30,6 +30,7 @@ build-depends: base , hspec , safe-exceptions+ , transformers , void ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010
src/Control/Exception/Safe.hs view
@@ -93,7 +93,7 @@ import qualified Control.Exception as E import qualified Control.Monad.Catch as C import Control.Monad.Catch (Handler (..))-import Control.Monad (liftM)+import Control.Monad (liftM, void) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Typeable (Typeable, cast) @@ -366,13 +366,12 @@ -- @since 0.1.0.0 withException :: (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a withException thing after = C.uninterruptibleMask $ \restore -> do- res1 <- C.try $ restore thing- case res1 of- Left e1 -> do- -- see explanation in bracket- _ :: Either SomeException b <- C.try $ after e1- C.throwM e1- Right x -> return x+ fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing)+ where+ -- ignore the exception from after, see bracket for explanation+ cAfter () (C.ExitCaseException se) | Just ex <- fromException se =+ ignoreExceptions $ after ex+ cAfter () _ = pure () -- | Async safe version of 'E.bracket' --@@ -392,32 +391,26 @@ -- @since 0.1.0.0 finally :: C.MonadMask m => m a -> m b -> m a finally thing after = C.uninterruptibleMask $ \restore -> do- res1 <- C.try $ restore thing- case res1 of- Left (e1 :: SomeException) -> do- -- see bracket for explanation- _ :: Either SomeException b <- C.try after- C.throwM e1- Right x -> do- _ <- after- return x+ fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing)+ where+ -- ignore the exception from after, see bracket for explanation+ cAfter () (C.ExitCaseException se) =+ ignoreExceptions after+ cAfter () _ = void after -- | Async safe version of 'E.bracketOnError' -- -- @since 0.1.0.0 bracketOnError :: forall m a b c. C.MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c-bracketOnError before after thing = C.mask $ \restore -> do- x <- before- res1 <- C.try $ restore (thing x)- case res1 of- Left (e1 :: SomeException) -> do- -- ignore the exception, see bracket for explanation- _ :: Either SomeException b <-- C.try $ C.uninterruptibleMask_ $ after x- C.throwM e1- Right y -> return y+bracketOnError before after thing = fmap fst $ C.generalBracket before cAfter thing+ where+ -- ignore the exception from after, see bracket for explanation+ cAfter x (C.ExitCaseException se) =+ C.uninterruptibleMask_ $ ignoreExceptions $ after x+ cAfter x _ = pure () + -- | A variant of 'bracketOnError' where the return value from the first -- computation is not required. --@@ -431,22 +424,21 @@ -- @since 0.1.7.0 bracketWithError :: forall m a b c. C.MonadMask m => m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c-bracketWithError before after thing = C.mask $ \restore -> do- x <- before- res1 <- C.try $ restore (thing x)- case res1 of- Left (e1 :: SomeException) -> do- -- explicitly ignore exceptions from after. We know that- -- no async exceptions were thrown there, so therefore- -- the stronger exception must come from thing- --- -- https://github.com/fpco/safe-exceptions/issues/2- _ :: Either SomeException b <-- C.try $ C.uninterruptibleMask_ $ after (Just e1) x- C.throwM e1- Right y -> do- _ <- C.uninterruptibleMask_ $ after Nothing x- return y+bracketWithError before after thing = fmap fst $ C.generalBracket before cAfter thing+ where+ cAfter x (C.ExitCaseException se) =+ C.uninterruptibleMask_ $ ignoreExceptions $ after (Just se) x+ cAfter x _ =+ void $ C.uninterruptibleMask_ $ after Nothing x++-- | Internal function that swallows all exceptions, used in some bracket-like+-- combinators. When it's run inside of uninterruptibleMask, we know that+-- no async exceptions can be thrown from thing, so the other exception from+-- the combinator will not be overridden.+--+-- https://github.com/fpco/safe-exceptions/issues/2+ignoreExceptions :: C.MonadMask m => m a -> m ()+ignoreExceptions thing = void thing `C.catch` (\(_ :: SomeException) -> pure ()) -- | Wrap up an asynchronous exception to be treated as a synchronous -- exception
test/Control/Exception/SafeSpec.hs view
@@ -8,6 +8,9 @@ import qualified Control.Exception as E import Control.Exception.Safe import Control.Monad (forever)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (runExceptT, throwE)+import Data.IORef (modifyIORef, newIORef, readIORef) import Data.Typeable (Typeable) import Data.Void (Void, absurd) import System.IO.Unsafe (unsafePerformIO)@@ -50,6 +53,13 @@ withAll :: (SomeException -> Bool -> IO ()) -> Spec withAll f = mapM_ (\(e, b) -> it (show e) (f e b)) exceptions +data ResourceAction+ = ResourceAcquire+ | ResourceUse+ | ResourceRelease+ | ExceptionObserve ExceptionPred+ deriving (Show, Eq)+ spec :: Spec spec = do describe "isSyncException" $ withAll@@ -132,3 +142,50 @@ describe "throwString" $ do it "is a StringException" $ throwString "foo" `catch` \(StringException _ _) -> return () :: IO ()++ describe "bracketWithError" $ do+ it "should prioritize exceptions from thing" $ do+ actionLogRef <- newIORef []+ eiResult <-+ try $+ Control.Exception.Safe.bracketWithError+ ( do+ modifyIORef actionLogRef (ResourceAcquire :)+ )+ ( \mbEx () -> do+ case mbEx of+ Just ex | Just exPred <- fromException ex ->+ modifyIORef actionLogRef (ExceptionObserve exPred :)+ _ -> pure ()+ modifyIORef actionLogRef (ResourceRelease :)+ throw $ ExceptionPred $ Just ()+ )+ ( \() -> do+ modifyIORef actionLogRef (ResourceUse :)+ throw $ ExceptionPred Nothing+ pure ()+ )+ eiResult `shouldBe` Left (ExceptionPred Nothing)+ readIORef actionLogRef+ `shouldReturn` [ResourceRelease, ExceptionObserve (ExceptionPred Nothing), ResourceUse, ResourceAcquire]++ it "should lift through ExceptT" $ do+ actionLogRef <- newIORef []+ eiResult <-+ runExceptT $+ Control.Exception.Safe.bracketWithError+ ( do+ lift $ modifyIORef actionLogRef (ResourceAcquire :)+ )+ ( \_ () -> do+ lift $ modifyIORef actionLogRef (ResourceRelease :)+ )+ ( \() -> do+ lift $ modifyIORef actionLogRef (ResourceUse :)+ throwE $ ExceptionPred Nothing+ pure ()+ )+ eiResult `shouldBe` Left (ExceptionPred Nothing)+ readIORef actionLogRef+ `shouldReturn` [ResourceRelease, ResourceUse, ResourceAcquire]+