{-# LANGUAGE AllowAmbiguousTypes #-}
module Effectful.Labeled.Error
(
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.Labeled
import Effectful.Error.Dynamic (Error(..))
import Effectful.Error.Dynamic qualified as E
runError
:: forall label e es a
. HasCallStack
=> Eff (Labeled label (Error e) : es) a
-> Eff es (Either (E.CallStack, e) a)
runError :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
Eff (Labeled label (Error e) : es) a
-> Eff es (Either (CallStack, e) a)
runError = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label 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
runErrorWith
:: forall label e es a
. HasCallStack
=> (E.CallStack -> e -> Eff es a)
-> Eff (Labeled label (Error e) : es) a
-> Eff es a
runErrorWith :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
(CallStack -> e -> Eff es a)
-> Eff (Labeled label (Error e) : es) a -> Eff es a
runErrorWith = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (Error e : es) a -> Eff es a)
-> Eff (Labeled label (Error e) : es) a -> Eff es a)
-> ((CallStack -> e -> Eff es a)
-> Eff (Error e : es) a -> Eff es a)
-> (CallStack -> e -> Eff es a)
-> Eff (Labeled label (Error e) : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CallStack -> e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
(CallStack -> e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
E.runErrorWith
runErrorNoCallStack
:: forall label e es a
. HasCallStack
=> Eff (Labeled label (Error e) : es) a
-> Eff es (Either e a)
runErrorNoCallStack :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
Eff (Labeled label (Error e) : es) a -> Eff es (Either e a)
runErrorNoCallStack = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label 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)
E.runErrorNoCallStack
runErrorNoCallStackWith
:: forall label e es a
. HasCallStack
=> (e -> Eff es a)
-> Eff (Labeled label (Error e) : es) a
-> Eff es a
runErrorNoCallStackWith :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
HasCallStack =>
(e -> Eff es a) -> Eff (Labeled label (Error e) : es) a -> Eff es a
runErrorNoCallStackWith = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (Error e : es) a -> Eff es a)
-> Eff (Labeled label (Error e) : es) a -> Eff es a)
-> ((e -> Eff es a) -> Eff (Error e : es) a -> Eff es a)
-> (e -> Eff es a)
-> Eff (Labeled label (Error e) : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
E.runErrorNoCallStackWith
throwErrorWith
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es)
=> (e -> String)
-> e
-> Eff es a
throwErrorWith :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith e -> String
display =
(HasCallStack => Labeled label (Error e) (Eff es) a -> Eff es a)
-> Labeled label (Error e) (Eff es) a -> Eff es a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => Labeled label (Error e) (Eff es) a -> Eff es a
Labeled label (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 (Labeled label (Error e) (Eff es) a -> Eff es a)
-> (e -> Labeled label (Error e) (Eff es) a) -> e -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (Error e (Eff es) a -> Labeled label (Error e) (Eff es) a)
-> (e -> Error e (Eff es) a)
-> e
-> Labeled label (Error e) (Eff es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> String) -> e -> Error e (Eff es) a
forall e (a :: Type -> Type) b. (e -> String) -> e -> Error e a b
ThrowErrorWith e -> String
display
throwError
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es, Show e)
=> e
-> Eff es a
throwError :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (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 (forall (label :: k) e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (Error e) :> es) =>
(e -> String) -> e -> Eff es a
forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith @label) e -> String
forall a. Show a => a -> String
show
throwError_
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es)
=> e
-> Eff es a
throwError_ :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (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 (forall (label :: k) e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (Error e) :> es) =>
(e -> String) -> e -> Eff es a
forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
(e -> String) -> e -> Eff es a
throwErrorWith @label) (String -> e -> String
forall a b. a -> b -> a
const String
"<opaque>")
catchError
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es)
=> Eff es a
-> (E.CallStack -> e -> Eff es a)
-> Eff es a
catchError :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
catchError Eff es a
m = Labeled label (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 (Labeled label (Error e) (Eff es) a -> Eff es a)
-> ((CallStack -> e -> Eff es a)
-> Labeled label (Error e) (Eff es) a)
-> (CallStack -> e -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
(a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (Error e (Eff es) a -> Labeled label (Error e) (Eff es) a)
-> ((CallStack -> e -> Eff es a) -> Error e (Eff es) a)
-> (CallStack -> e -> Eff es a)
-> Labeled label (Error e) (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 (a :: Type -> Type) b e.
a b -> (CallStack -> e -> a b) -> Error e a b
CatchError Eff es a
m
handleError
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es)
=> (E.CallStack -> e -> Eff es a)
-> Eff es a
-> Eff es a
handleError :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (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 (forall (label :: k) e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
catchError @label)
tryError
:: forall label e es a
. (HasCallStack, Labeled label (Error e) :> es)
=> Eff es a
-> Eff es (Either (E.CallStack, e) a)
tryError :: forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> Eff es (Either (CallStack, e) a)
tryError Eff es a
m = forall (label :: k) e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
forall {k} (label :: k) e (es :: [(Type -> Type) -> Type -> Type])
a.
(HasCallStack, Labeled label (Error e) :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
catchError @label (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) (\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))