-- | The dynamically dispatched variant of the 'Error' effect.
--
-- /Note:/ unless you plan to change interpretations at runtime, it's
-- recommended to use the statically dispatched variant,
-- i.e. "Effectful.Error.Static".
module Effectful.Error.Dynamic
  ( -- * Effect
    Error(..)

    -- ** Handlers
  , runError
  , runErrorNoCallStack

    -- ** Operations
  , throwError
  , catchError
  , handleError
  , tryError

    -- * Re-exports
  , E.HasCallStack
  , E.CallStack
  , E.getCallStack
  , E.prettyCallStack
  ) where

import Effectful
import Effectful.Dispatch.Dynamic
import qualified Effectful.Error.Static as E

-- | Provide the ability to handle errors of type @e@.
data Error e :: Effect where
  ThrowError :: e -> Error e m a
  CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a

type instance DispatchOf (Error e) = Dynamic

-- | Handle errors of type @e@ (via "Effectful.Error.Static").
runError
  :: Eff (Error e : es) a
  -> Eff es (Either (E.CallStack, e) a)
runError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError = (Eff (Error e : es) a -> Eff es (Either (CallStack, e) a))
-> EffectHandler (Error e) (Error e : es)
-> 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.
(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.
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
E.runError (EffectHandler (Error e) (Error e : es)
 -> Eff (Error e : es) a -> Eff es (Either (CallStack, e) a))
-> EffectHandler (Error e) (Error e : es)
-> 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
  ThrowError e
e   -> e -> Eff (Error e : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
E.throwError 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, SuffixOf 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.
(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)

-- | Handle errors of type @e@ (via "Effectful.Error.Static"). In case of an
-- error discard the 'E.CallStack'.
runErrorNoCallStack
  :: Eff (Error e : es) a
  -> Eff es (Either e a)
runErrorNoCallStack :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
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 (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.
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError

-- | Throw an error of type @e@.
throwError
  :: (HasCallStack, Error e :> es)
  => e
  -- ^ The error.
  -> Eff es a
throwError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError = 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 -> Error e (Eff es) a
forall e (m :: Type -> Type) a. e -> Error e m a
ThrowError

-- | Handle an error of type @e@.
catchError
  :: (HasCallStack, Error e :> es)
  => Eff es a
  -- ^ The inner computation.
  -> (E.CallStack -> e -> Eff es a)
  -- ^ A handler for errors in the inner computation.
  -> 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

-- | The same as @'flip' 'catchError'@, which is useful in situations where the
-- code for the handler is shorter.
handleError
  :: Error e :> es
  => (E.CallStack -> e -> Eff es a)
  -- ^ A handler for errors in the inner computation.
  -> Eff es a
  -- ^ The inner computation.
  -> Eff es a
handleError :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(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

-- | Similar to 'catchError', but returns an 'Either' result which is a 'Right'
-- if no error was thrown and a 'Left' otherwise.
tryError
  :: (HasCallStack, Error e :> es)
  => Eff es a
  -- ^ The inner computation.
  -> 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 (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)