git.iko.soy/effectful
on 8a63c15 help sign in
effectful/src/Effectful/Error.hs
62 lines 1.5 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.Env
15import Effectful.Internal.Has
16import Effectful.Internal.Monad
17import Effectful.Internal.Utils
19type role Error nominal
20data Error e = Error
22runError
23 :: forall e es a. Exception e
24 => Eff (Error e : es) a
25 -> Eff es (Either ([String], e) a)
26runError (Eff m) = impureEff $ \es0 -> mask $ \release -> do
27 size <- sizeEnv es0
28 es <- unsafeConsEnv (Error @e) es0
29 try (release $ m es) >>= \case
30 Right a -> Right a <$ unsafeTrimEnv size es
31 Left (WrapE cs e) -> Left (cs, e) <$ unsafeTrimEnv size es
33throwError
34 :: (HasCallStack, Exception e, Error e :> es)
35 => e
36 -> Eff es a
37throwError e = impureEff_ $ do
38 throwIO $ WrapE (ppCallStack <$> getCallStack callStack) e
40catchError
41 :: (Exception e, Error e :> es)
42 => Eff es a
43 -> ([String] -> e -> Eff es a)
44 -> Eff es a
45catchError (Eff m) handler = impureEff $ \es -> do
46 size <- sizeEnv es
47 m es `catch` \(WrapE e cs) -> do
48 checkSizeEnv size es
49 unEff (handler e cs) es
51tryError
52 :: (Exception e, Error e :> es)
53 => Eff es a
54 -> Eff es (Either ([String], e) a)
55tryError m = (Right <$> m) `catchError` \es e -> pure (Left (es, e))
57----------------------------------------
58-- WrapE
60data WrapE e = WrapE [String] e
61 deriving Show
62instance (Show e, Typeable e) => Exception (WrapE e)