-- | 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
  , runErrorWith
  , runErrorNoCallStack
  , runErrorNoCallStackWith

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

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

import GHC.Stack (withFrozenCallStack)

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 = 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 forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
E.runError forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error e : es)
env -> \case
  ThrowError e
e   -> 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 -> 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 a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (Error e : es) r
unlift -> do
    forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
E.catchError (forall r. Eff localEs r -> Eff (Error e : es) r
unlift Eff localEs a
m) (\CallStack
cs -> forall r. Eff localEs r -> Eff (Error e : es) r
unlift 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") with a specific
-- error handler.
runErrorWith
  :: (E.CallStack -> e -> Eff es a)
  -- ^ The error handler.
  -> Eff (Error e : es) a
  -> Eff es a
runErrorWith :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(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 = 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
m 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 -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a

-- | 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 = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. b -> Either a b
Right) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError

-- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific
-- error handler. In case of an error discard the 'CallStack'.
runErrorNoCallStackWith
  :: (e -> Eff es a)
  -- ^ The error handler.
  -> Eff (Error e : es) a
  -> Eff es a
runErrorNoCallStackWith :: forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorNoCallStackWith e -> Eff es a
handler Eff (Error e : es) a
m = forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack Eff (Error e : es) a
m 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 -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a

-- | 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 e
e = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ 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 (forall e (m :: Type -> Type) a. e -> Error e m a
ThrowError e
e)

-- | 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = (forall a b. b -> Either a b
Right forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es a
m) 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 -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (CallStack
es, e
e)