module Effectful.Error.Dynamic
(
Error(..)
, runError
, runErrorWith
, runErrorNoCallStack
, runErrorNoCallStackWith
, throwErrorWith
, throwError
, throwError_
, catchError
, handleError
, tryError
, E.HasCallStack
, E.CallStack
, E.getCallStack
, E.prettyCallStack
) where
import GHC.Stack (withFrozenCallStack)
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static qualified as E
data Error e :: Effect where
ThrowErrorWith :: (e -> String) -> e -> Error e m a
CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a
type instance DispatchOf (Error e) = Dynamic
runError
:: HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either (E.CallStack, e) a)
runError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError = (Eff (Error e : es) a -> Eff es (Either (CallStack, e) a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
(HasCallStack, Error e :> localEs) =>
LocalEnv localEs (Error e : es)
-> Error e (Eff localEs) a -> Eff (Error e : es) a)
-> Eff (Error e : es) a
-> Eff es (Either (CallStack, e) a)
forall (e :: (Type -> Type) -> Type -> Type)
(handlerEs :: [(Type -> Type) -> Type -> Type]) a
(es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
E.runError ((forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
(HasCallStack, Error e :> localEs) =>
LocalEnv localEs (Error e : es)
-> Error e (Eff localEs) a -> Eff (Error e : es) a)
-> Eff (Error e : es) a -> Eff es (Either (CallStack, e) a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
(HasCallStack, Error e :> localEs) =>
LocalEnv localEs (Error e : es)
-> Error e (Eff localEs) a -> Eff (Error e : es) a)
-> Eff (Error e : es) a
-> Eff es (Either (CallStack, e) a)
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error e : es)
env -> \case
ThrowErrorWith e -> String
display e
e -> (e -> String) -> e -> Eff (Error e : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
(e -> String) -> e -> Eff es a
E.throwErrorWith e -> String
display e
e
CatchError Eff localEs a
m CallStack -> e -> Eff localEs a
h -> LocalEnv localEs (Error e : es)
-> ((forall {r}. Eff localEs r -> Eff (Error e : es) r)
-> Eff (Error e : es) a)
-> Eff (Error e : es) a
forall (es :: [(Type -> Type) -> Type -> Type])
(handlerEs :: [(Type -> Type) -> Type -> Type])
(localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Error e : es)
env (((forall {r}. Eff localEs r -> Eff (Error e : es) r)
-> Eff (Error e : es) a)
-> Eff (Error e : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Error e : es) r)
-> Eff (Error e : es) a)
-> Eff (Error e : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Error e : es) r
unlift -> do
Eff (Error e : es) a
-> (CallStack -> e -> Eff (Error e : es) a) -> Eff (Error e : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
E.catchError (Eff localEs a -> Eff (Error e : es) a
forall {r}. Eff localEs r -> Eff (Error e : es) r
unlift Eff localEs a
m) (\CallStack
cs -> Eff localEs a -> Eff (Error e : es) a
forall {r}. Eff localEs r -> Eff (Error e : es) r
unlift (Eff localEs a -> Eff (Error e : es) a)
-> (e -> Eff localEs a) -> e -> Eff (Error e : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> e -> Eff localEs a
h CallStack
cs)
runErrorWith
:: HasCallStack
=> (E.CallStack -> e -> Eff es a)
-> Eff (Error e : es) a
-> Eff es a
runErrorWith :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
(CallStack -> e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorWith CallStack -> e -> Eff es a
handler Eff (Error e : es) a
m = Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError Eff (Error e : es) a
m Eff es (Either (CallStack, e) a)
-> (Either (CallStack, e) a -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (CallStack
cs, e
e) -> CallStack -> e -> Eff es a
handler CallStack
cs e
e
Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
runErrorNoCallStack
:: HasCallStack
=> Eff (Error e : es) a
-> Eff es (Either e a)
runErrorNoCallStack :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack = (Either (CallStack, e) a -> Either e a)
-> Eff es (Either (CallStack, e) a) -> Eff es (Either e a)
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CallStack, e) -> Either e a)
-> (a -> Either e a) -> Either (CallStack, e) a -> Either e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a)
-> ((CallStack, e) -> e) -> (CallStack, e) -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CallStack, e) -> e
forall a b. (a, b) -> b
snd) a -> Either e a
forall a b. b -> Either a b
Right) (Eff es (Either (CallStack, e) a) -> Eff es (Either e a))
-> (Eff (Error e : es) a -> Eff es (Either (CallStack, e) a))
-> Eff (Error e : es) a
-> Eff es (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError
runErrorNoCallStackWith
:: HasCallStack
=> (e -> Eff es a)
-> Eff (Error e : es) a
-> Eff es a
runErrorNoCallStackWith :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorNoCallStackWith e -> Eff es a
handler Eff (Error e : es) a
m = Eff (Error e : es) a -> Eff es (Either e a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack Eff (Error e : es) a
m Eff es (Either e a) -> (Either e a -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left e
e -> e -> Eff es a
handler e
e
Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
throwErrorWith
:: (HasCallStack, Error e :> es)
=> (e -> String)
-> e
-> Eff es a
throwErrorWith :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith e -> String
display = (HasCallStack => Error e (Eff es) a -> Eff es a)
-> Error e (Eff es) a -> Eff es a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => Error e (Eff es) a -> Eff es a
Error e (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Error e (Eff es) a -> Eff es a)
-> (e -> Error e (Eff es) a) -> e -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> String) -> e -> Error e (Eff es) a
forall e (m :: Type -> Type) a. (e -> String) -> e -> Error e m a
ThrowErrorWith e -> String
display
throwError
:: (HasCallStack, Error e :> es, Show e)
=> e
-> Eff es a
throwError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError = (HasCallStack => (e -> String) -> e -> Eff es a)
-> (e -> String) -> e -> Eff es a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => (e -> String) -> e -> Eff es a
(e -> String) -> e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith e -> String
forall a. Show a => a -> String
show
throwError_
:: (HasCallStack, Error e :> es)
=> e
-> Eff es a
throwError_ :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError_ = (HasCallStack => (e -> String) -> e -> Eff es a)
-> (e -> String) -> e -> Eff es a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => (e -> String) -> e -> Eff es a
(e -> String) -> e -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith (String -> e -> String
forall a b. a -> b -> a
const String
"<opaque>")
catchError
:: (HasCallStack, Error e :> es)
=> Eff es a
-> (E.CallStack -> e -> Eff es a)
-> Eff es a
catchError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
catchError Eff es a
m = Error e (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Error e (Eff es) a -> Eff es a)
-> ((CallStack -> e -> Eff es a) -> Error e (Eff es) a)
-> (CallStack -> e -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> (CallStack -> e -> Eff es a) -> Error e (Eff es) a
forall (m :: Type -> Type) a e.
m a -> (CallStack -> e -> m a) -> Error e m a
CatchError Eff es a
m
handleError
:: (HasCallStack, Error e :> es)
=> (E.CallStack -> e -> Eff es a)
-> Eff es a
-> Eff es a
handleError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
(CallStack -> e -> Eff es a) -> Eff es a -> Eff es a
handleError = (Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a)
-> (CallStack -> e -> Eff es a) -> Eff es a -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
catchError
tryError
:: (HasCallStack, Error e :> es)
=> Eff es a
-> Eff es (Either (E.CallStack, e) a)
tryError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> Eff es (Either (CallStack, e) a)
tryError Eff es a
m = (a -> Either (CallStack, e) a
forall a b. b -> Either a b
Right (a -> Either (CallStack, e) a)
-> Eff es a -> Eff es (Either (CallStack, e) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es a
m) Eff es (Either (CallStack, e) a)
-> (CallStack -> e -> Eff es (Either (CallStack, e) a))
-> Eff es (Either (CallStack, e) a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
`catchError` \CallStack
es e
e -> Either (CallStack, e) a -> Eff es (Either (CallStack, e) a)
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (CallStack, e) a -> Eff es (Either (CallStack, e) a))
-> Either (CallStack, e) a -> Eff es (Either (CallStack, e) a)
forall a b. (a -> b) -> a -> b
$ (CallStack, e) -> Either (CallStack, e) a
forall a b. a -> Either a b
Left (CallStack
es, e
e)