{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Convenience functions for the 'Labeled' 'Error' effect.
--
-- @since 2.4.0.0
module Effectful.Labeled.Error
  ( -- * Effect
    Error(..)

    -- ** Handlers
  , runError
  , runErrorWith
  , runErrorNoCallStack
  , runErrorNoCallStackWith

    -- ** Operations
  , throwErrorWith
  , throwError
  , 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 Effectful.Labeled
import Effectful.Error.Dynamic (Error(..))
import Effectful.Error.Dynamic qualified as E

-- | Handle errors of type @e@ (via "Effectful.Error.Static").
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

-- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific
-- error handler.
runErrorWith
  :: forall label e es a
   . HasCallStack
  => (E.CallStack -> e -> Eff es a)
  -- ^ The error handler.
  -> 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

-- | Handle errors of type @e@ (via "Effectful.Error.Static"). In case of an
-- error discard the 'E.CallStack'.
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

-- | Handle errors of type @e@ (via "Effectful.Error.Static") with a specific
-- error handler. In case of an error discard the 'CallStack'.
runErrorNoCallStackWith
  :: forall label e es a
   . HasCallStack
  => (e -> Eff es a)
  -- ^ The error handler.
  -> 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

-- | Throw an error of type @e@ and specify a display function in case a
-- third-party code catches the internal exception and 'show's it.
throwErrorWith
  :: forall label e es a
   . (HasCallStack, Labeled label (Error e) :> es)
  => (e -> String)
  -- ^ The display function.
  -> e
  -- ^ The error.
  -> 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

-- | Throw an error of type @e@ with 'show' as a display function.
throwError
  :: forall label e es a
   . (HasCallStack, Labeled label (Error e) :> es, Show e)
  => e
  -- ^ The error.
  -> 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

-- | Throw an error of type @e@ with no display function.
throwError_
  :: forall label e es a
   . (HasCallStack, Labeled label (Error e) :> es)
  => e
  -- ^ The error.
  -> 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>")

-- | Handle an error of type @e@.
catchError
  :: forall label e es a
   . (HasCallStack, Labeled label (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 {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

-- | The same as @'flip' 'catchError'@, which is useful in situations where the
-- code for the handler is shorter.
handleError
  :: forall label e es a
   . (HasCallStack, Labeled label (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 {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)

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