From a0097cf8eac4392088f3eed442d742f2a4f3d956 Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Mon, 30 Sep 2024 03:44:48 +0200 Subject: [PATCH] Add the Effectful.Exception module with appropriate re-exports --- effectful-core/effectful-core.cabal | 3 + effectful-core/src/Effectful.hs | 2 +- .../src/Effectful/Dispatch/Dynamic.hs | 7 +- effectful-core/src/Effectful/Error/Static.hs | 14 +- effectful-core/src/Effectful/Exception.hs | 131 ++++++++++++++++++ .../src/Effectful/State/Static/Local.hs | 3 +- .../src/Effectful/State/Static/Shared.hs | 3 +- .../src/Effectful/Writer/Static/Local.hs | 2 +- .../src/Effectful/Writer/Static/Shared.hs | 2 +- effectful/CHANGELOG.md | 1 + effectful/effectful.cabal | 2 + effectful/tests/StateTests.hs | 19 +-- effectful/tests/Utils.hs | 3 +- 13 files changed, 163 insertions(+), 29 deletions(-) create mode 100644 effectful-core/src/Effectful/Exception.hs diff --git a/effectful-core/effectful-core.cabal b/effectful-core/effectful-core.cabal index 7ee9641..8049c1e 100644 --- a/effectful-core/effectful-core.cabal +++ b/effectful-core/effectful-core.cabal @@ -64,9 +64,11 @@ library build-depends: base >= 4.14 && < 5 , containers >= 0.6 + , deepseq >= 1.2 , exceptions >= 0.10.4 , monad-control >= 1.0.3 , primitive >= 0.7.3.0 + , safe-exceptions >= 0.1.7.2 , strict-mutable-base >= 1.1.0.0 , transformers-base >= 0.4.6 , unliftio-core >= 0.2.0.1 @@ -83,6 +85,7 @@ library Effectful.Dispatch.Static.Unsafe Effectful.Error.Dynamic Effectful.Error.Static + Effectful.Exception Effectful.Fail Effectful.Internal.Effect Effectful.Internal.Env diff --git a/effectful-core/src/Effectful.hs b/effectful-core/src/Effectful.hs index 9e2f8c1..aea17de 100644 --- a/effectful-core/src/Effectful.hs +++ b/effectful-core/src/Effectful.hs @@ -148,7 +148,7 @@ import Effectful.Internal.Monad -- -- These libraries can trivially be used with the 'Eff' monad since it provides -- typical instances that these libraries require the underlying monad to have, --- such as t'Control.Monad.Catch.MonadMask' or 'MonadUnliftIO'. +-- such as t'Effectful.Exception.MonadMask' or 'MonadUnliftIO'. -- -- In case the 'Eff' monad doesn't provide a specific instance out of the box, -- it can be supplied via an effect. As an example see how the instance of diff --git a/effectful-core/src/Effectful/Dispatch/Dynamic.hs b/effectful-core/src/Effectful/Dispatch/Dynamic.hs index 4d4e172..017123d 100644 --- a/effectful-core/src/Effectful/Dispatch/Dynamic.hs +++ b/effectful-core/src/Effectful/Dispatch/Dynamic.hs @@ -153,12 +153,10 @@ import Effectful.Internal.Utils -- The following defines an 'EffectHandler' that reads and writes files from the -- drive: -- --- >>> import Control.Exception (IOException) --- >>> import Control.Monad.Catch (catch) --- >>> import Control.Monad.IO.Class -- >>> import qualified System.IO as IO -- -- >>> import Effectful.Error.Static +-- >>> import Effectful.Exception -- -- >>> newtype FsError = FsError String deriving Show -- @@ -249,7 +247,6 @@ import Effectful.Internal.Utils -- -- If we naively try to interpret it, we will run into trouble: -- --- >>> import Control.Monad.IO.Class -- >>> import GHC.Clock (getMonotonicTime) -- -- >>> :{ @@ -491,7 +488,6 @@ reinterpretWith runHandlerEs m handler = reinterpret runHandlerEs handler m -- type instance DispatchOf E = Dynamic -- :} -- --- >>> import Control.Monad.IO.Class -- >>> :{ -- runE :: IOE :> es => Eff (E : es) a -> Eff es a -- runE = interpret_ $ \case @@ -1199,4 +1195,5 @@ instance -- $setup -- >>> import Control.Concurrent (ThreadId, forkIOWithUnmask) +-- >>> import Control.Monad.IO.Class -- >>> import Effectful.Reader.Static diff --git a/effectful-core/src/Effectful/Error/Static.hs b/effectful-core/src/Effectful/Error/Static.hs index 6177ea7..97a22db 100644 --- a/effectful-core/src/Effectful/Error/Static.hs +++ b/effectful-core/src/Effectful/Error/Static.hs @@ -1,13 +1,13 @@ -- | Support for handling errors of a particular type, i.e. checked exceptions. -- -- The 'Error' effect is __not__ a general mechanism for handling regular --- exceptions, that's what functions from the @exceptions@ library are for (see --- "Control.Monad.Catch" for more information). +-- exceptions, that's what functions from the "Effectful.Exception" module are +-- for. -- -- In particular, regular exceptions of type @e@ are distinct from errors of -- type @e@ and will __not__ be caught by functions from this module: -- --- >>> import qualified Control.Monad.Catch as E +-- >>> import qualified Effectful.Exception as E -- -- >>> boom = error "BOOM!" -- @@ -16,14 +16,14 @@ -- ... -- -- If you want to catch regular exceptions, you should use --- 'Control.Monad.Catch.catch' (or a similar function): +-- 'Effectful.Exception.catch' (or a similar function): -- -- >>> runEff $ boom `E.catch` \(_::ErrorCall) -> pure "caught" -- "caught" -- -- On the other hand, functions for safe finalization and management of --- resources such as 'Control.Monad.Catch.finally' and --- 'Control.Monad.Catch.bracket' work as expected: +-- resources such as 'Effectful.Exception.finally' and +-- 'Effectful.Exception.bracket' work as expected: -- -- >>> msg = liftIO . putStrLn -- @@ -74,7 +74,7 @@ -- -- /Hint:/ if you'd like to reproduce the transactional behavior with the -- t'Effectful.State.Static.Local.State' effect, appropriate usage of --- 'Control.Monad.Catch.bracketOnError' will do the trick. +-- 'Effectful.Exception.bracketOnError' will do the trick. module Effectful.Error.Static ( -- * Effect Error diff --git a/effectful-core/src/Effectful/Exception.hs b/effectful-core/src/Effectful/Exception.hs new file mode 100644 index 0000000..973b41d --- /dev/null +++ b/effectful-core/src/Effectful/Exception.hs @@ -0,0 +1,131 @@ +-- | The 'Eff' monad comes with instances of 'MonadThrow', 'MonadCatch' and +-- 'MonadMask' from the +-- [@exceptions@](https://hackage.haskell.org/package/exceptions) library out of +-- the box, so this module simply re-exports the interface of the +-- [@safe-exceptions@](https://hackage.haskell.org/package/safe-exceptions) +-- library. +-- +-- Why @safe-exceptions@ and not @exceptions@? Because the latter provides more +-- convenience functions and makes it much easier to correctly deal with +-- asynchronous exceptions (for more information see its +-- [README](https://github.com/fpco/safe-exceptions#readme)). +module Effectful.Exception + ( C.MonadThrow(..) + , C.MonadCatch(..) + , C.MonadMask(..) + , C.ExitCase(..) + + -- * Utilities + + -- ** Throwing + , Safe.throwString + , Safe.StringException(..) + + -- ** Catching (with recovery) + , Safe.catchIO + , Safe.catchIOError + , Safe.catchAny + , Safe.catchDeep + , Safe.catchAnyDeep + , Safe.catchAsync + , Safe.catchJust + + , Safe.handle + , Safe.handleIO + , Safe.handleIOError + , Safe.handleAny + , Safe.handleDeep + , Safe.handleAnyDeep + , Safe.handleAsync + , Safe.handleJust + + , Safe.try + , Safe.tryIO + , Safe.tryAny + , Safe.tryDeep + , Safe.tryAnyDeep + , Safe.tryAsync + , Safe.tryJust + + , Safe.Handler(..) + , Safe.catches + , Safe.catchesDeep + , Safe.catchesAsync + + -- ** Cleanup (no recovery) + , Safe.onException + , Safe.bracket + , Safe.bracket_ + , Safe.finally + , Safe.withException + , Safe.bracketOnError + , Safe.bracketOnError_ + , Safe.bracketWithError + + -- ** Coercion to sync and async + , Safe.SyncExceptionWrapper(..) + , Safe.toSyncException + , Safe.AsyncExceptionWrapper(..) + , Safe.toAsyncException + + -- ** Check exception type + , Safe.isSyncException + , Safe.isAsyncException + + -- ** Evaluation + , evaluate + , evaluateDeep + + -- * Re-exports from "Control.Exception" + + -- ** The 'SomeException' type + , E.SomeException(..) + + -- ** The 'Exception' class + , E.Exception(..) + + -- ** Concrete exception types + , E.IOException + , E.ArithException(..) + , E.ArrayException(..) + , E.AssertionFailed(..) + , E.NoMethodError(..) + , E.PatternMatchFail(..) + , E.RecConError(..) + , E.RecSelError(..) + , E.RecUpdError(..) + , E.ErrorCall(..) + , E.TypeError(..) + + -- ** Asynchronous exceptions + , E.SomeAsyncException(..) + , E.AsyncException(..) + , E.asyncExceptionToException + , E.asyncExceptionFromException + , E.NonTermination(..) + , E.NestedAtomically(..) + , E.BlockedIndefinitelyOnMVar(..) + , E.BlockedIndefinitelyOnSTM(..) + , E.AllocationLimitExceeded(..) + , E.CompactionFailed(..) + , E.Deadlock(..) + + -- ** Assertions + , E.assert + ) where + +import Control.DeepSeq +import Control.Exception qualified as E +import Control.Exception.Safe qualified as Safe +import Control.Monad.Catch qualified as C + +import Effectful +import Effectful.Dispatch.Static + +-- | Lifted version of 'E.evaluate'. +evaluate :: a -> Eff es a +evaluate = unsafeEff_ . E.evaluate + +-- | Deeply evaluate a value using 'evaluate' and 'NFData'. +evaluateDeep :: NFData a => a -> Eff es a +evaluateDeep = unsafeEff_ . E.evaluate . force diff --git a/effectful-core/src/Effectful/State/Static/Local.hs b/effectful-core/src/Effectful/State/Static/Local.hs index d08da06..31e2890 100644 --- a/effectful-core/src/Effectful/State/Static/Local.hs +++ b/effectful-core/src/Effectful/State/Static/Local.hs @@ -137,5 +137,4 @@ modifyM modifyM f = stateM (\s -> ((), ) <$> f s) -- $setup --- >>> import Control.Exception (ErrorCall) --- >>> import Control.Monad.Catch +-- >>> import Effectful.Exception diff --git a/effectful-core/src/Effectful/State/Static/Shared.hs b/effectful-core/src/Effectful/State/Static/Shared.hs index 1f72504..43f9240 100644 --- a/effectful-core/src/Effectful/State/Static/Shared.hs +++ b/effectful-core/src/Effectful/State/Static/Shared.hs @@ -153,5 +153,4 @@ modifyM :: (HasCallStack, State s :> es) => (s -> Eff es s) -> Eff es () modifyM f = stateM (\s -> ((), ) <$> f s) -- $setup --- >>> import Control.Exception (ErrorCall) --- >>> import Control.Monad.Catch +-- >>> import Effectful.Exception diff --git a/effectful-core/src/Effectful/Writer/Static/Local.hs b/effectful-core/src/Effectful/Writer/Static/Local.hs index 1a4d9a5..05057fd 100644 --- a/effectful-core/src/Effectful/Writer/Static/Local.hs +++ b/effectful-core/src/Effectful/Writer/Static/Local.hs @@ -102,4 +102,4 @@ listens f m = do -- $setup -- >>> import Control.Exception (ErrorCall) --- >>> import Control.Monad.Catch +-- >>> import Effectful.Exception diff --git a/effectful-core/src/Effectful/Writer/Static/Shared.hs b/effectful-core/src/Effectful/Writer/Static/Shared.hs index 37d1df5..55a4a8f 100644 --- a/effectful-core/src/Effectful/Writer/Static/Shared.hs +++ b/effectful-core/src/Effectful/Writer/Static/Shared.hs @@ -116,4 +116,4 @@ listens f m = do -- $setup -- >>> import Control.Exception (ErrorCall) --- >>> import Control.Monad.Catch +-- >>> import Effectful.Exception diff --git a/effectful/CHANGELOG.md b/effectful/CHANGELOG.md index 76907a5..da98490 100644 --- a/effectful/CHANGELOG.md +++ b/effectful/CHANGELOG.md @@ -20,6 +20,7 @@ * Add a `SeqForkUnlift` strategy to support running unlifting functions outside of the scope of effects they capture. * Ensure that a `LocalEnv` is only used in a thread it belongs to. +* Add the `Effectful.Exception` module with appropriate re-exports. * **Breaking changes**: - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a list of effects instead of a single one. diff --git a/effectful/effectful.cabal b/effectful/effectful.cabal index 7edfbcf..7748e7b 100644 --- a/effectful/effectful.cabal +++ b/effectful/effectful.cabal @@ -113,6 +113,7 @@ library , Effectful.Dispatch.Static , Effectful.Error.Static , Effectful.Error.Dynamic + , Effectful.Exception , Effectful.Fail , Effectful.Labeled , Effectful.Labeled.Error @@ -144,6 +145,7 @@ test-suite test , exceptions , lifted-base , primitive + , safe-exceptions , strict-mutable-base , tasty , tasty-hunit diff --git a/effectful/tests/StateTests.hs b/effectful/tests/StateTests.hs index 16edadf..336c3bf 100644 --- a/effectful/tests/StateTests.hs +++ b/effectful/tests/StateTests.hs @@ -1,8 +1,9 @@ module StateTests (stateTests) where import Control.Exception.Lifted qualified as LE +import Control.Exception.Safe qualified as Safe import Control.Monad -import Control.Monad.Catch qualified as E +import Control.Monad.Catch qualified as C import Data.IORef.Strict import Test.Tasty import Test.Tasty.HUnit @@ -66,12 +67,14 @@ test_deepStack = runEff $ do test_exceptions :: Assertion test_exceptions = runEff $ do - testTry "exceptions" E.try - testCatch "exceptions" E.catch - testTry "lifted-base" LE.try - testCatch "lifted-base" LE.catch - testTry "unliftio" UE.try - testCatch "unliftio" UE.catch + testTry "exceptions" C.try + testCatch "exceptions" C.catch + testTry "safe-exceptions" Safe.try + testCatch "safe-exceptions" Safe.catch + testTry "lifted-base" LE.try + testCatch "lifted-base" LE.catch + testTry "unliftio" UE.try + testCatch "unliftio" UE.catch where testTry :: String @@ -96,7 +99,7 @@ test_exceptions = runEff $ do action :: State Int :> es => Eff es () action = do modify @Int (+1) - _ <- E.throwM U.Ex + _ <- C.throwM U.Ex modify @Int (+2) test_localEffects :: Assertion diff --git a/effectful/tests/Utils.hs b/effectful/tests/Utils.hs index 2f943c5..38a8ec0 100644 --- a/effectful/tests/Utils.hs +++ b/effectful/tests/Utils.hs @@ -7,12 +7,11 @@ module Utils , Ex(..) ) where -import Control.Exception (ErrorCall(..)) -import Control.Monad.Catch import GHC.Stack import Test.Tasty.HUnit qualified as T import Effectful +import Effectful.Exception assertBool :: (HasCallStack, IOE :> es) => String -> Bool -> Eff es () assertBool msg p = liftIO $ T.assertBool msg p