@@ -0,0 +1,46 @@
1+module Effectful.Error.Dynamic
2+ ( Error(..)
3+ , runError
4+ , throwError
5+ , catchError
6+ , tryError
7+ ) where
8+
9+import Data.Typeable
10+import GHC.Stack
11+
12+import Effectful.Handler
13+import Effectful.Monad
14+import qualified Effectful.Error as E
15+
16+data Error e :: Effect where
17+ ThrowError :: e -> Error e m a
18+ CatchError :: m a -> (CallStack -> e -> m a) -> Error e m a
19+
20+runError
21+ :: Typeable e
22+ => Eff (Error e : es) a
23+ -> Eff es (Either (CallStack, e) a)
24+runError = reinterpretM E.runError $ \env -> \case
25+ ThrowError e -> E.throwError e
26+ CatchError m h -> localSeqUnlift env $ \run -> do
27+ E.catchError (run m) (\cs -> run . h cs)
28+
29+throwError
30+ :: (HasCallStack, Error e :> es)
31+ => e
32+ -> Eff es a
33+throwError = send . ThrowError
34+
35+catchError
36+ :: Error e :> es
37+ => Eff es a
38+ -> (CallStack -> e -> Eff es a)
39+ -> Eff es a
40+catchError m = send . CatchError m
41+
42+tryError
43+ :: Error e :> es
44+ => Eff es a
45+ -> Eff es (Either (CallStack, e) a)
46+tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)