git.iko.soy/effectful
on master help sign in
Add Except for handling exceptions and require IOE for it
commit36968f43231154e94d03839b7fa479a2b593e741 authorAndrzej Rybczak <andrzej@rybczak.net> dateFri 2 Jul 2021, 00:52 (5 years ago) parent9f1c163
5 files changed+54−31
compare with master
unifiedsplit
src/Effectful.hs+7−1 src/Effectful/Error.hs+18−20 src/Effectful/Internal/Monad.hs+16−3 src/Effectful/Monad.hs+7−1 tests/StateTests.hs+6−6
src/Effectful.hs+7−1
@@ -6,7 +6,7 @@ module Effectful
66 , Effect
77 , (:>)
88
9− -- * Sending effects
9+ -- ** Sending effects
1010 , send
1111
1212 -- * Running the 'Eff' monad
@@ -15,9 +15,15 @@ module Effectful
1515 , runEff
1616
1717 -- ** Operations with side effects
18+
19+ -- *** Arbitrary I/O
1820 , IOE
1921 , runIOE
2022
23+ -- *** Runtime exceptions
24+ , Except
25+ , runExcept
26+
2127 -- * Building 'Effect' handlers
2228
2329 -- ** Basic handlers
src/Effectful/Error.hs+18−20
@@ -1,20 +1,23 @@
11{- | Support for checked exceptions.
22
3− The `Error` effect provided by this module is a suitable replacement for the
4− `Control.Monad.Except.ExceptT` monad transformer found in the mtl library.
5− It is __not__ intended to be a general mechanism for catching errors like
6− the functions of the 'exceptions' package. For example, if you want to catch
7− an unchecked exception like `Control.Exception.SomeException` or
8− `Control.Exception.ErrorCall` you could rely on `Control.Monad.catch`:
9−
10− >>> :{
11− let boom :: Eff '[IOE] String
12− boom = error "BOOM!"
13− in
14− runIOE $ boom `Control.Monad.Catch.catch` \(e :: ErrorCall) ->
15− return "caught some error"
16− :}
17− "caught some error"
3+The 'Error' effect provided by this module is a suitable replacement for the
4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It
5+is __not__ intended to be a general mechanism for catching errors, that's what
6+the 'Except' effect is for.
7+
8+For example, if you want to catch an unchecked exception like
9+'Control.Exception.SomeException' or 'Control.Exception.ErrorCall' you could use
10+'Control.Monad.Catch.catch':
11+
12+>>> import qualified Control.Monad.Catch as E
13+>>> :{
14+ let boom :: Eff es String
15+ boom = error "BOOM!"
16+ in
17+ runIOE . runExcept $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"
18+:}
19+"caught some error"
20+
1821-}
1922module Effectful.Error
2023 ( Error
@@ -35,11 +38,6 @@ import Effectful.Internal.Effect
3538import Effectful.Internal.Env
3639import Effectful.Internal.Monad
3740
38−-- $setup
39−-- >>> import Control.Monad.Catch
40−-- >>> import Control.Monad.IO.Class
41−-- >>> import Effectful.Interpreter
42−
4341data Error e :: Effect where
4442 Error :: Unique -> Error e m r
4543
src/Effectful/Internal/Monad.hs+16−3
@@ -25,6 +25,10 @@ module Effectful.Internal.Monad
2525 , IOE
2626 , runIOE
2727
28+ -- * Except
29+ , Except
30+ , runExcept
31+
2832 -- * Low-level helpers
2933
3034 -- ** Running
@@ -174,10 +178,19 @@ instance MonadFix (Eff es) where
174178----------------------------------------
175179-- Exception
176180
177−instance E.MonadThrow (Eff es) where
181+-- | Handle runtime exceptions via 'E.MonadThrow', 'E.MonadCatch' and
182+-- 'E.MonadMask'.
183+data Except :: Effect where
184+ Except :: Except m r
185+
186+-- | Introduce the ability to handle runtime exceptions.
187+runExcept :: IOE :> es => Eff (Except : es) a -> Eff es a
188+runExcept = evalEffect (IdE Except)
189+
190+instance Except :> es => E.MonadThrow (Eff es) where
178191 throwM = unsafeEff_ . throwIO
179192
180−instance E.MonadCatch (Eff es) where
193+instance Except :> es => E.MonadCatch (Eff es) where
181194 catch m handler = unsafeEff $ \es -> do
182195 size <- sizeEnv es
183196 unEff m es `catch` \e -> do
@@ -185,7 +198,7 @@ instance E.MonadCatch (Eff es) where
185198 unEff (handler e) es
186199 {-# INLINABLE catch #-}
187200
188−instance E.MonadMask (Eff es) where
201+instance Except :> es => E.MonadMask (Eff es) where
189202 mask k = unsafeEff $ \es -> mask $ \restore ->
190203 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
191204
src/Effectful/Monad.hs+7−1
@@ -2,12 +2,18 @@ module Effectful.Monad
22 ( -- * The 'Eff' monad
33 Eff
44 , runEff
5+
6+ -- ** Effect constraints
57 , Effect
68 , (:>)
79
8− -- * The IO effect
10+ -- * Arbitrary I/O
911 , IOE
1012 , runIOE
13+
14+ -- * Exception handling
15+ , Except
16+ , runExcept
1117 ) where
1218
1319import Effectful.Internal.Effect
tests/StateTests.hs+6−6
@@ -50,7 +50,7 @@ test_deepStack = runIOE $ do
5050 U.assertEqual "n" 15 n
5151
5252test_exceptions :: Assertion
53−test_exceptions = runIOE $ do
53+test_exceptions = runIOE . runExcept $ do
5454 testTry "exceptions" E.try
5555 testCatch "exceptions" E.catch
5656 testTry "lifted-base" LE.try
@@ -60,8 +60,8 @@ test_exceptions = runIOE $ do
6060 where
6161 testTry
6262 :: String
63− -> (forall a es. IOE :> es => Eff es a -> Eff es (Either U.Ex a))
64− -> Eff '[IOE] ()
63+ -> (forall a es. (IOE :> es, Except :> es) => Eff es a -> Eff es (Either U.Ex a))
64+ -> Eff '[Except, IOE] ()
6565 testTry lib tryImpl = do
6666 e <- tryImpl $ runState (0::Int) action
6767 U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)
@@ -70,15 +70,15 @@ test_exceptions = runIOE $ do
7070
7171 testCatch
7272 :: String
73− -> (forall a es. IOE :> es => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
74− -> Eff '[IOE] ()
73+ -> (forall a es. (IOE :> es, Except :> es) => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
74+ -> Eff '[Except, IOE] ()
7575 testCatch lib catchImpl = do
7676 s <- execState (0::Int) $ do
7777 _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)
7878 modify @Int (+8)
7979 U.assertEqual (lib ++ " - state correctly updated") s 13
8080
81− action :: State Int :> es => Eff es ()
81+ action :: (State Int :> es, Except :> es) => Eff es ()
8282 action = do
8383 modify @Int (+1)
8484 _ <- E.throwM U.Ex