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