packages feed

safe-exceptions 0.1.7.3 → 0.1.7.4

raw patch · 3 files changed

+143/−65 lines, 3 filesdep ~deepseq

Dependency ranges changed: deepseq

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog for safe-exceptions +## 0.1.7.4++* Add `HasCallStack` when `exceptions >= 0.10.6` [#41](https://github.com/fpco/safe-exceptions/issues/41)+ ## 0.1.7.3  * Allow transformers 0.6 [#39](https://github.com/fpco/safe-exceptions/issues/39)
safe-exceptions.cabal view
@@ -1,5 +1,5 @@ name:                safe-exceptions-version:             0.1.7.3+version:             0.1.7.4 synopsis:            Safe, consistent, and easy exception handling description:         Please see README.md homepage:            https://github.com/fpco/safe-exceptions#readme
src/Control/Exception/Safe.hs view
@@ -102,23 +102,66 @@ import GHC.Stack.Types (HasCallStack, CallStack, getCallStack) #endif +#if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6)+import GHC.Stack (withFrozenCallStack)+#endif++-- The exceptions package that safe-exceptions is based on added HasCallStack+-- to many of its functions in 0.10.6:+--+-- https://github.com/ekmett/exceptions/pull/90+-- https://github.com/ekmett/exceptions/pull/92+--+-- We make the same change here. The following comment has been lifted+-- verbatim from exceptions:+--+-- We use the following bit of CPP to enable the use of HasCallStack+-- constraints without breaking the build for pre-8.0 GHCs, which did not+-- provide GHC.Stack. We are careful to always write constraints like this:+--+--   HAS_CALL_STACK => MonadThrow m => ...+--+-- Instead of like this:+--+--   (HAS_CALL_STACK, MonadThrow e) => ...+--+-- The latter is equivalent to (() :: Constraint, MonadThrow e) => ..., which+-- requires ConstraintKinds. More importantly, it's slightly less efficient,+-- since it requires passing an empty constraint tuple dictionary around.+--+-- Note that we do /not/ depend on the call-stack compatibility library to+-- provide HasCallStack on older GHCs. We tried this at one point, but we+-- discovered that downstream libraries failed to build because combining+-- call-stack with GeneralizedNewtypeDeriving on older GHCs would require the+-- use of ConstraintKinds/FlexibleContexts, which downstream libraries did not+-- enable. (See #91.) The CPP approach that we use now, while somewhat clunky,+-- avoids these issues by not requiring any additional language extensions for+-- downstream users.+#if MIN_VERSION_base(4,9,0) && MIN_VERSION_exceptions(0,10,6)+# define HAS_CALL_STACK HasCallStack+#else+# define HAS_CALL_STACK ()+withFrozenCallStack :: a -> a+withFrozenCallStack a = a+#endif+ -- | Synchronously throw the given exception -- -- @since 0.1.0.0-throw :: (C.MonadThrow m, Exception e) => e -> m a+throw :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a throw = C.throwM . toSyncException  -- | Synonym for 'throw' -- -- @since 0.1.0.0-throwIO :: (C.MonadThrow m, Exception e) => e -> m a-throwIO = throw+throwIO :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a+throwIO = withFrozenCallStack throw  -- | Synonym for 'throw' -- -- @since 0.1.0.0-throwM :: (C.MonadThrow m, Exception e) => e -> m a-throwM = throw+throwM :: HAS_CALL_STACK => (C.MonadThrow m, Exception e) => e -> m a+throwM = withFrozenCallStack throw  -- | A convenience function for throwing a user error. This is useful -- for cases where it would be too high a burden to define your own@@ -193,14 +236,14 @@ -- see <https://github.com/fpco/safe-exceptions#quickstart> -- -- @since 0.1.0.0-impureThrow :: Exception e => e -> a+impureThrow :: HAS_CALL_STACK => Exception e => e -> a impureThrow = E.throw . toSyncException  -- | Same as upstream 'C.catch', but will not catch asynchronous -- exceptions -- -- @since 0.1.0.0-catch :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a+catch :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a catch f g = f `C.catch` \e ->     if isSyncException e         then g e@@ -211,22 +254,22 @@ -- | 'C.catch' specialized to only catching 'E.IOException's -- -- @since 0.1.3.0-catchIO :: C.MonadCatch m => m a -> (E.IOException -> m a) -> m a-catchIO = C.catch+catchIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> (E.IOException -> m a) -> m a+catchIO = withFrozenCallStack C.catch  -- | 'catch' specialized to catch all synchronous exception -- -- @since 0.1.0.0-catchAny :: C.MonadCatch m => m a -> (SomeException -> m a) -> m a-catchAny = catch+catchAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> (SomeException -> m a) -> m a+catchAny = withFrozenCallStack catch  -- | Same as 'catch', but fully force evaluation of the result value -- to find all impure exceptions. -- -- @since 0.1.1.0-catchDeep :: (C.MonadCatch m, MonadIO m, Exception e, NFData a)+catchDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, Exception e, NFData a)           => m a -> (e -> m a) -> m a-catchDeep = catch . evaluateDeep+catchDeep = withFrozenCallStack catch . evaluateDeep  -- | Internal helper function evaluateDeep :: (MonadIO m, NFData a) => m a -> m a@@ -237,8 +280,8 @@ -- | 'catchDeep' specialized to catch all synchronous exception -- -- @since 0.1.1.0-catchAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => m a -> (SomeException -> m a) -> m a-catchAnyDeep = catchDeep+catchAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> (SomeException -> m a) -> m a+catchAnyDeep = withFrozenCallStack catchDeep  -- | 'catch' without async exception safety --@@ -247,7 +290,7 @@ -- <https://github.com/fpco/safe-exceptions#quickstart> -- -- @since 0.1.0.0-catchAsync :: (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a+catchAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => m a -> (e -> m a) -> m a catchAsync = C.catch  -- | 'catchJust' is like 'catch' but it takes an extra argument which@@ -255,39 +298,39 @@ -- exceptions we're interested in. -- -- @since 0.1.4.0-catchJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a-catchJust f a b = a `catch` \e -> maybe (throwM e) b $ f e+catchJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a+catchJust f a b = withFrozenCallStack catch a (\e -> maybe (throwM e) b $ f e)  -- | Flipped version of 'catch' -- -- @since 0.1.0.0-handle :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a-handle = flip catch+handle :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a+handle = flip (withFrozenCallStack catch)  -- | 'C.handle' specialized to only catching 'E.IOException's -- -- @since 0.1.3.0-handleIO :: C.MonadCatch m => (E.IOException -> m a) -> m a -> m a-handleIO = C.handle+handleIO :: HAS_CALL_STACK => C.MonadCatch m => (E.IOException -> m a) -> m a -> m a+handleIO = withFrozenCallStack C.handle   -- | Flipped version of 'catchAny' -- -- @since 0.1.0.0-handleAny :: C.MonadCatch m => (SomeException -> m a) -> m a -> m a-handleAny = flip catchAny+handleAny :: HAS_CALL_STACK => C.MonadCatch m => (SomeException -> m a) -> m a -> m a+handleAny = flip (withFrozenCallStack catchAny)  -- | Flipped version of 'catchDeep' -- -- @since 0.1.1.0-handleDeep :: (C.MonadCatch m, Exception e, MonadIO m, NFData a) => (e -> m a) -> m a -> m a-handleDeep = flip catchDeep+handleDeep :: HAS_CALL_STACK => (C.MonadCatch m, Exception e, MonadIO m, NFData a) => (e -> m a) -> m a -> m a+handleDeep = flip (withFrozenCallStack catchDeep)  -- | Flipped version of 'catchAnyDeep' -- -- @since 0.1.1.0-handleAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => (SomeException -> m a) -> m a -> m a-handleAnyDeep = flip catchAnyDeep+handleAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => (SomeException -> m a) -> m a -> m a+handleAnyDeep = flip (withFrozenCallStack catchAnyDeep)  -- | Flipped version of 'catchAsync' --@@ -296,46 +339,46 @@ -- <https://github.com/fpco/safe-exceptions#quickstart> -- -- @since 0.1.0.0-handleAsync :: (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a+handleAsync :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> m a) -> m a -> m a handleAsync = C.handle  -- | Flipped 'catchJust'. -- -- @since 0.1.4.0-handleJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a-handleJust f = flip (catchJust f)+handleJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a+handleJust f = flip (withFrozenCallStack catchJust f)  -- | Same as upstream 'C.try', but will not catch asynchronous -- exceptions -- -- @since 0.1.0.0-try :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)-try f = catch (liftM Right f) (return . Left)+try :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)+try f = withFrozenCallStack catch (liftM Right f) (return . Left)  -- | 'C.try' specialized to only catching 'E.IOException's -- -- @since 0.1.3.0-tryIO :: C.MonadCatch m => m a -> m (Either E.IOException a)-tryIO = C.try+tryIO :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either E.IOException a)+tryIO = withFrozenCallStack C.try  -- | 'try' specialized to catch all synchronous exceptions -- -- @since 0.1.0.0-tryAny :: C.MonadCatch m => m a -> m (Either SomeException a)-tryAny = try+tryAny :: HAS_CALL_STACK => C.MonadCatch m => m a -> m (Either SomeException a)+tryAny = withFrozenCallStack try  -- | Same as 'try', but fully force evaluation of the result value -- to find all impure exceptions. -- -- @since 0.1.1.0-tryDeep :: (C.MonadCatch m, MonadIO m, E.Exception e, NFData a) => m a -> m (Either e a)-tryDeep f = catch (liftM Right (evaluateDeep f)) (return . Left)+tryDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, E.Exception e, NFData a) => m a -> m (Either e a)+tryDeep f = withFrozenCallStack catch (liftM Right (evaluateDeep f)) (return . Left)  -- | 'tryDeep' specialized to catch all synchronous exceptions -- -- @since 0.1.1.0-tryAnyDeep :: (C.MonadCatch m, MonadIO m, NFData a) => m a -> m (Either SomeException a)-tryAnyDeep = tryDeep+tryAnyDeep :: HAS_CALL_STACK => (C.MonadCatch m, MonadIO m, NFData a) => m a -> m (Either SomeException a)+tryAnyDeep = withFrozenCallStack tryDeep  -- | 'try' without async exception safety --@@ -344,27 +387,56 @@ -- <https://github.com/fpco/safe-exceptions#quickstart> -- -- @since 0.1.0.0-tryAsync :: (C.MonadCatch m, E.Exception e) => m a -> m (Either e a)+tryAsync :: HAS_CALL_STACK => (C.MonadCatch m, E.Exception e) => m a -> m (Either e a) tryAsync = C.try  -- | A variant of 'try' that takes an exception predicate to select -- which exceptions are caught. -- -- @since 0.1.4.0-tryJust :: (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)-tryJust f a = catch (Right `liftM` a) (\e -> maybe (throwM e) (return . Left) (f e))+tryJust :: HAS_CALL_STACK => (C.MonadCatch m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)+tryJust f a = withFrozenCallStack catch (Right `liftM` a) (\e -> maybe (throwM e) (return . Left) (f e))  -- | Async safe version of 'E.onException' -- -- @since 0.1.0.0-onException :: C.MonadMask m => m a -> m b -> m a-onException thing after = withException thing (\(_ :: SomeException) -> after)+onException :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a+onException thing after = withFrozenCallStack withException thing (\(_ :: SomeException) -> after) +-- Note: [withFrozenCallStack impredicativity]+--+-- We do not currently use 'withFrozenCallStack' in 'withException' or the similar+-- 'finally' due to impredicativity. That is, we would like to be consistent+-- with other functions and apply 'withFrozenCallStack' to the _handler only_ i.e.+--+--     withException thing after = withFrozenCallStack C.uninterruptibleMask $ \restore ...+--+-- Alas, that fails due to impredicativity:+--+--     • Couldn't match type: m a -> m a+--                      with: forall a1. m a1 -> m a1+--       Expected: (forall a1. m a1 -> m a1) -> m a+--         Actual: (m a -> m a) -> m a+--+-- Armed with -XImpredicativeTypes, we can define:+--+--     uninterruptibleMaskFrozen :: forall m b. C.MonadMask m => ((forall a. m a -> m a) -> m b) -> m b+--     uninterruptibleMaskFrozen = withFrozenCallStack C.uninterruptibleMask+--+-- and then+--+--     withException thing after = uninterruptibleMaskFrozen $ \restore -> do ...+--+-- But we cannot rely on -XImpredicativeTypes until GHC 9.2 is the oldest+-- supported release, and even then it is worth asking if the benefit+-- (consistency, omit handler from CallStack) is worth the cost (powerful,+-- relatively exotic extension).+ -- | Like 'onException', but provides the handler the thrown -- exception. -- -- @since 0.1.0.0-withException :: (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a+withException :: HAS_CALL_STACK => (C.MonadMask m, E.Exception e) => m a -> (e -> m b) -> m a withException thing after = C.uninterruptibleMask $ \restore -> do     fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing)   where@@ -376,20 +448,22 @@ -- | Async safe version of 'E.bracket' -- -- @since 0.1.0.0-bracket :: forall m a b c. C.MonadMask m+bracket :: forall m a b c. HAS_CALL_STACK => C.MonadMask m         => m a -> (a -> m b) -> (a -> m c) -> m c-bracket before after = bracketWithError before (const after)+bracket before after = withFrozenCallStack bracketWithError before (const after)  -- | Async safe version of 'E.bracket_' -- -- @since 0.1.0.0-bracket_ :: C.MonadMask m => m a -> m b -> m c -> m c-bracket_ before after thing = bracket before (const after) (const thing)+bracket_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c+bracket_ before after thing = withFrozenCallStack bracket before (const after) (const thing) +-- See Note [withFrozenCallStack impredicativity]+ -- | Async safe version of 'E.finally' -- -- @since 0.1.0.0-finally :: C.MonadMask m => m a -> m b -> m a+finally :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m a finally thing after = C.uninterruptibleMask $ \restore -> do     fmap fst $ C.generalBracket (pure ()) cAfter (const $ restore thing)   where@@ -401,9 +475,9 @@ -- | Async safe version of 'E.bracketOnError' -- -- @since 0.1.0.0-bracketOnError :: forall m a b c. C.MonadMask m+bracketOnError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m                => m a -> (a -> m b) -> (a -> m c) -> m c-bracketOnError before after thing = fmap fst $ C.generalBracket before cAfter thing+bracketOnError before after thing = fmap fst $ withFrozenCallStack C.generalBracket before cAfter thing   where     -- ignore the exception from after, see bracket for explanation     cAfter x (C.ExitCaseException se) =@@ -415,16 +489,16 @@ -- computation is not required. -- -- @since 0.1.0.0-bracketOnError_ :: C.MonadMask m => m a -> m b -> m c -> m c-bracketOnError_ before after thing = bracketOnError before (const after) (const thing)+bracketOnError_ :: HAS_CALL_STACK => C.MonadMask m => m a -> m b -> m c -> m c+bracketOnError_ before after thing = withFrozenCallStack bracketOnError before (const after) (const thing)  -- | Async safe version of 'E.bracket' with access to the exception in the -- cleanup action. -- -- @since 0.1.7.0-bracketWithError :: forall m a b c. C.MonadMask m+bracketWithError :: forall m a b c. HAS_CALL_STACK => C.MonadMask m         => m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c-bracketWithError before after thing = fmap fst $ C.generalBracket before cAfter thing+bracketWithError before after thing = fmap fst $ withFrozenCallStack C.generalBracket before cAfter thing   where     cAfter x (C.ExitCaseException se) =         C.uninterruptibleMask_ $ ignoreExceptions $ after (Just se) x@@ -534,15 +608,15 @@ -- exceptions -- -- @since 0.1.2.0-catches :: (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a-catches io handlers = io `catch` catchesHandler handlers+catches :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a+catches io handlers = withFrozenCallStack catch io (catchesHandler handlers)  -- | Same as 'catches', but fully force evaluation of the result value -- to find all impure exceptions. -- -- @since 0.1.2.0-catchesDeep :: (C.MonadCatch m, C.MonadThrow m, MonadIO m, NFData a) => m a -> [Handler m a] -> m a-catchesDeep io handlers = evaluateDeep io `catch` catchesHandler handlers+catchesDeep :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m, MonadIO m, NFData a) => m a -> [Handler m a] -> m a+catchesDeep io handlers = withFrozenCallStack catch (evaluateDeep io) (catchesHandler handlers)  -- | 'catches' without async exception safety --@@ -551,10 +625,10 @@ -- <https://github.com/fpco/safe-exceptions#quickstart> -- -- @since 0.1.2.0-catchesAsync :: (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a+catchesAsync :: HAS_CALL_STACK => (C.MonadCatch m, C.MonadThrow m) => m a -> [Handler m a] -> m a catchesAsync io handlers = io `catchAsync` catchesHandler handlers -catchesHandler :: (C.MonadThrow m) => [Handler m a] -> SomeException -> m a+catchesHandler :: HAS_CALL_STACK => (C.MonadThrow m) => [Handler m a] -> SomeException -> m a catchesHandler handlers e = foldr tryHandler (C.throwM e) handlers     where tryHandler (Handler handler) res               = case fromException e of