git.iko.soy/effectful
on 209f615 help sign in
effectful/src/Effectful/Error.hs
63 lines 1.6 kB history raw
1-- | Support for checked exceptions.
2module Effectful.Error
3 ( Error
4 , runError
5 , throwError
6 , catchError
7 , tryError
8 ) where
10import Control.Exception
11import Data.Typeable
12import GHC.Stack
14import Effectful.Internal.Effect
15import Effectful.Internal.Env
16import Effectful.Internal.Monad
17import Effectful.Internal.Utils
19type role Error nominal phantom phantom
20data Error e :: Effect where
21 Error :: Error e m r
23runError
24 :: forall e es a. Exception e
25 => Eff (Error e : es) a
26 -> Eff es (Either ([String], e) a)
27runError (Eff m) = unsafeEff $ \es0 -> mask $ \release -> do
28 size0 <- sizeEnv es0
29 es <- unsafeConsEnv (IdE (Error @e)) noRelinker es0
30 try (release $ m es) >>= \case
31 Right a -> Right a <$ unsafeTailEnv size0 es
32 Left (WrapErr cs e) -> Left (cs, e) <$ unsafeTailEnv size0 es
34throwError
35 :: (HasCallStack, Exception e, Error e :> es)
36 => e
37 -> Eff es a
38throwError e = unsafeEff_ $ do
39 throwIO $ WrapErr (ppCallStack <$> getCallStack callStack) e
41catchError
42 :: (Exception e, Error e :> es)
43 => Eff es a
44 -> ([String] -> e -> Eff es a)
45 -> Eff es a
46catchError (Eff m) handler = unsafeEff $ \es -> do
47 size <- sizeEnv es
48 m es `catch` \(WrapErr e cs) -> do
49 checkSizeEnv size es
50 unEff (handler e cs) es
52tryError
53 :: (Exception e, Error e :> es)
54 => Eff es a
55 -> Eff es (Either ([String], e) a)
56tryError m = (Right <$> m) `catchError` \es e -> pure (Left (es, e))
58----------------------------------------
59-- WrapE
61data WrapErr e = WrapErr [String] e
62 deriving Show
63instance (Show e, Typeable e) => Exception (WrapErr e)