module Effectful.Fail
(
Fail(..)
, runFail
, runFailIO
) where
import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Static
import Effectful.Internal.Monad (Fail(..))
runFail :: Eff (Fail : es) a -> Eff es (Either String a)
runFail :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
Eff (Fail : es) a -> Eff es (Either String a)
runFail = 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 e a)
runErrorNoCallStack forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error String : es)
_ -> \case
Fail String
msg -> forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
e -> Eff es a
throwError String
msg
runFailIO :: IOE :> es => Eff (Fail : es) a -> Eff es a
runFailIO :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
(IOE :> es) =>
Eff (Fail : es) a -> Eff es a
runFailIO = 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 forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
_ -> \case
Fail String
msg -> forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
msg