git.iko.soy/effectful
on master help sign in
Add Except for handling exceptions and require IOE for it
36968f4Andrzej Rybczak
src/Effectful.hs+7−1
compare with master
unifiedsplit
@@ -6,7 +6,7 @@ module Effectful
6 , Effect
6 , Effect
7 , (:>)
7 , (:>)
8
8
9− -- * Sending effects
9+ -- ** Sending effects
10 , send
10 , send
11
11
12 -- * Running the 'Eff' monad
12 -- * Running the 'Eff' monad
@@ -15,9 +15,15 @@ module Effectful
15 , runEff
15 , runEff
16
16
17 -- ** Operations with side effects
17 -- ** Operations with side effects
18+
19+ -- *** Arbitrary I/O
18 , IOE
20 , IOE
19 , runIOE
21 , runIOE
20
22
23+ -- *** Runtime exceptions
24+ , Except
25+ , runExcept
26+
21 -- * Building 'Effect' handlers
27 -- * Building 'Effect' handlers
22
28
23 -- ** Basic handlers
29 -- ** Basic handlers
src/Effectful/Error.hs+18−20
@@ -1,20 +1,23 @@
1{- | Support for checked exceptions.
1{- | Support for checked exceptions.
2
2
3− The `Error` effect provided by this module is a suitable replacement for the
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.
4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It
5− It is __not__ intended to be a general mechanism for catching errors like
5+is __not__ intended to be a general mechanism for catching errors, that's what
6+the 'Except' effect is for.
7+
6− the functions of the 'exceptions' package. For example, if you want to catch
8+For example, if you want to catch an unchecked exception like
7− an unchecked exception like `Control.Exception.SomeException` or
8− `Control.Exception.ErrorCall` you could rely on `Control.Monad.catch`:
9+'Control.Exception.SomeException' or 'Control.Exception.ErrorCall' you could use
9−
10+'Control.Monad.Catch.catch':
11+
12+>>> import qualified Control.Monad.Catch as E
10− >>> :{
13+>>> :{
11− let boom :: Eff '[IOE] String
14+ let boom :: Eff es String
12− boom = error "BOOM!"
15+ boom = error "BOOM!"
13− in
16+ in
14− runIOE $ boom `Control.Monad.Catch.catch` \(e :: ErrorCall) ->
17+ runIOE . runExcept $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"
15− return "caught some error"
16− :}
18+:}
17− "caught some error"
19+"caught some error"
20+
18-}
21-}
19module Effectful.Error
22module Effectful.Error
20 ( Error
23 ( Error
@@ -35,11 +38,6 @@ import Effectful.Internal.Effect
35import Effectful.Internal.Env
38import Effectful.Internal.Env
36import Effectful.Internal.Monad
39import Effectful.Internal.Monad
37
40
38−-- $setup
39−-- >>> import Control.Monad.Catch
40−-- >>> import Control.Monad.IO.Class
41−-- >>> import Effectful.Interpreter
42−
43data Error e :: Effect where
41data Error e :: Effect where
44 Error :: Unique -> Error e m r
42 Error :: Unique -> Error e m r
45
43
src/Effectful/Internal/Monad.hs+16−3
@@ -25,6 +25,10 @@ module Effectful.Internal.Monad
25 , IOE
25 , IOE
26 , runIOE
26 , runIOE
27
27
28+ -- * Except
29+ , Except
30+ , runExcept
31+
28 -- * Low-level helpers
32 -- * Low-level helpers
29
33
30 -- ** Running
34 -- ** Running
@@ -174,10 +178,19 @@ instance MonadFix (Eff es) where
174----------------------------------------
178----------------------------------------
175-- Exception
179-- Exception
176
180
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+
177−instance E.MonadThrow (Eff es) where
190+instance Except :> es => E.MonadThrow (Eff es) where
178 throwM = unsafeEff_ . throwIO
191 throwM = unsafeEff_ . throwIO
179
192
180−instance E.MonadCatch (Eff es) where
193+instance Except :> es => E.MonadCatch (Eff es) where
181 catch m handler = unsafeEff $ \es -> do
194 catch m handler = unsafeEff $ \es -> do
182 size <- sizeEnv es
195 size <- sizeEnv es
183 unEff m es `catch` \e -> do
196 unEff m es `catch` \e -> do
@@ -185,7 +198,7 @@ instance E.MonadCatch (Eff es) where
185 unEff (handler e) es
198 unEff (handler e) es
186 {-# INLINABLE catch #-}
199 {-# INLINABLE catch #-}
187
200
188−instance E.MonadMask (Eff es) where
201+instance Except :> es => E.MonadMask (Eff es) where
189 mask k = unsafeEff $ \es -> mask $ \restore ->
202 mask k = unsafeEff $ \es -> mask $ \restore ->
190 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
203 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
191
204
src/Effectful/Monad.hs+7−1
@@ -2,12 +2,18 @@ module Effectful.Monad
2 ( -- * The 'Eff' monad
2 ( -- * The 'Eff' monad
3 Eff
3 Eff
4 , runEff
4 , runEff
5+
6+ -- ** Effect constraints
5 , Effect
7 , Effect
6 , (:>)
8 , (:>)
7
9
8− -- * The IO effect
10+ -- * Arbitrary I/O
9 , IOE
11 , IOE
10 , runIOE
12 , runIOE
13+
14+ -- * Exception handling
15+ , Except
16+ , runExcept
11 ) where
17 ) where
12
18
13import Effectful.Internal.Effect
19import Effectful.Internal.Effect
tests/StateTests.hs+6−6
@@ -50,7 +50,7 @@ test_deepStack = runIOE $ do
50 U.assertEqual "n" 15 n
50 U.assertEqual "n" 15 n
51
51
52test_exceptions :: Assertion
52test_exceptions :: Assertion
53−test_exceptions = runIOE $ do
53+test_exceptions = runIOE . runExcept $ do
54 testTry "exceptions" E.try
54 testTry "exceptions" E.try
55 testCatch "exceptions" E.catch
55 testCatch "exceptions" E.catch
56 testTry "lifted-base" LE.try
56 testTry "lifted-base" LE.try
@@ -60,8 +60,8 @@ test_exceptions = runIOE $ do
60 where
60 where
61 testTry
61 testTry
62 :: String
62 :: String
63− -> (forall a es. IOE :> es => Eff es a -> Eff es (Either U.Ex a))
63+ -> (forall a es. (IOE :> es, Except :> es) => Eff es a -> Eff es (Either U.Ex a))
64− -> Eff '[IOE] ()
64+ -> Eff '[Except, IOE] ()
65 testTry lib tryImpl = do
65 testTry lib tryImpl = do
66 e <- tryImpl $ runState (0::Int) action
66 e <- tryImpl $ runState (0::Int) action
67 U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)
67 U.assertEqual (lib ++ " - exception caught") e (Left U.Ex)
@@ -70,15 +70,15 @@ test_exceptions = runIOE $ do
70
70
71 testCatch
71 testCatch
72 :: String
72 :: String
73− -> (forall a es. IOE :> es => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
73+ -> (forall a es. (IOE :> es, Except :> es) => Eff es a -> (U.Ex -> Eff es a) -> Eff es a)
74− -> Eff '[IOE] ()
74+ -> Eff '[Except, IOE] ()
75 testCatch lib catchImpl = do
75 testCatch lib catchImpl = do
76 s <- execState (0::Int) $ do
76 s <- execState (0::Int) $ do
77 _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)
77 _ <- (evalState () action) `catchImpl` \U.Ex -> modify @Int (+4)
78 modify @Int (+8)
78 modify @Int (+8)
79 U.assertEqual (lib ++ " - state correctly updated") s 13
79 U.assertEqual (lib ++ " - state correctly updated") s 13
80
80
81− action :: State Int :> es => Eff es ()
81+ action :: (State Int :> es, Except :> es) => Eff es ()
82 action = do
82 action = do
83 modify @Int (+1)
83 modify @Int (+1)
84 _ <- E.throwM U.Ex
84 _ <- E.throwM U.Ex