diff --git a/effectful-core/CHANGELOG.md b/effectful-core/CHANGELOG.md index 0adbed13..c7cf8369 100644 --- a/effectful-core/CHANGELOG.md +++ b/effectful-core/CHANGELOG.md @@ -1,6 +1,7 @@ # effectful-core-2.6.0.0 (????-??-??) * Adjust `generalBracket` with `base >= 4.21` to make use of the new exception annotation mechanism. +* Add `withException` to `Effectful.Exception`. * **Breaking changes**: - Change the order of type parameters in `raise` for better usability. - `Effectful.Error.Static.ErrorWrapper` is no longer caught by `catchSync`. diff --git a/effectful-core/src/Effectful/Exception.hs b/effectful-core/src/Effectful/Exception.hs index b27c61d4..c806f240 100644 --- a/effectful-core/src/Effectful/Exception.hs +++ b/effectful-core/src/Effectful/Exception.hs @@ -59,6 +59,7 @@ module Effectful.Exception , C.ExitCase(..) , finally , onException + , withException -- * Utils @@ -512,6 +513,27 @@ onException onException action handler = reallyUnsafeUnliftIO $ \unlift -> do E.onException (unlift action) (unlift handler) +-- | A variant of 'onException' that gives access to the exception. +-- +-- @since 2.6.0.0 +withException + :: E.Exception e + => Eff es a + -> (e -> Eff es b) + -- ^ Computation to run last when an exception or + -- t'Effectful.Error.Static.Error' was thrown. + -> Eff es a +withException action cleanup = do +#if MIN_VERSION_base(4,21,0) + action `catchNoPropagate` \ec@(E.ExceptionWithContext _ e) -> do + _ <- annotateIO (E.WhileHandling (E.toException ec)) (cleanup e) + rethrowIO ec +#else + action `catch` \e -> do + _ <- cleanup e + throwIO e +#endif + ---------------------------------------- -- Utils diff --git a/effectful/CHANGELOG.md b/effectful/CHANGELOG.md index 8c9d78c5..4fbe28a2 100644 --- a/effectful/CHANGELOG.md +++ b/effectful/CHANGELOG.md @@ -1,6 +1,7 @@ # effectful-core-2.6.0.0 (????-??-??) * Adjust `generalBracket` with `base >= 4.21` to make use of the new exception annotation mechanism. +* Add `withException` to `Effectful.Exception`. * Re-export `ThreadId` from `Effectful.Concurrent` for convenience. * **Breaking changes**: - Change the order of type parameters in `raise` for better usability.