-- | Provider of the 'MonadFail' instance for 'Eff'.
module Effectful.Fail
  ( -- * Effect
    Fail(..)

    -- ** Handlers
  , runFail
  , runFailIO
  ) where

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.Internal.Monad (Fail(..))

-- | Run the 'Fail' effect via 'Error'.
runFail :: Eff (Fail : es) a -> Eff es (Either String a)
runFail :: Eff (Fail : es) a -> Eff es (Either String a)
runFail = (Eff (Error String : es) a -> Eff es (Either String a))
-> EffectHandler Fail (Error String : es)
-> Eff (Fail : es) a
-> Eff es (Either String 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 String : es) a -> Eff es (Either String a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack (EffectHandler Fail (Error String : es)
 -> Eff (Fail : es) a -> Eff es (Either String a))
-> EffectHandler Fail (Error String : es)
-> Eff (Fail : es) a
-> Eff es (Either String a)
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error String : es)
_ -> \case
  Fail msg -> String -> Eff (Error String : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError String
msg

-- | Run the 'Fail' effect via the 'MonadFail' instance for 'IO'.
runFailIO :: IOE :> es => Eff (Fail : es) a -> Eff es a
runFailIO :: Eff (Fail : es) a -> Eff es a
runFailIO = EffectHandler Fail es -> Eff (Fail : es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler Fail es -> Eff (Fail : es) a -> Eff es a)
-> EffectHandler Fail es -> Eff (Fail : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
_ -> \case
  Fail msg -> IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
msg