{-# LANGUAGE BlockArguments #-}
module Control.Effect.Error
(
Throw(..)
, Catch(..)
, Error
, throw
, catch
, try
, catchJust
, tryJust
, note
, fromEither
, runThrow
, runError
, errorToIO
, errorToIOAsExc
, errorToErrorIO
, errorToErrorIOAsExc
, throwToThrow
, catchToError
, errorToError
, errorToIOSimple
, errorToErrorIOSimple
, throwToThrowSimple
, catchToErrorSimple
, errorToErrorSimple
, ErrorThreads
, C.MonadCatch
, ThrowC
, ErrorC
, ErrorToIOC
, ErrorToIOC'
, ReifiesErrorHandler
, InterpretErrorC
, InterpretErrorC'
, ErrorToIOSimpleC
, InterpretErrorSimpleC
) where
import Data.Function
import Data.Coerce
import Control.Effect
import Control.Effect.Type.Throw
import Control.Effect.Type.Catch
import Control.Effect.Internal.Error
import qualified Control.Monad.Catch as C
import Control.Monad.Trans.Except
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Intro
import Control.Effect.Internal.Utils
throw :: Eff (Throw e) m => e -> m a
throw :: e -> m a
throw = Throw e m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Throw e m a -> m a) -> (e -> Throw e m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Throw e m a
forall e (m :: * -> *) a. e -> Throw e m a
Throw
{-# INLINE throw #-}
catch :: Eff (Catch e) m => m a -> (e -> m a) -> m a
catch :: m a -> (e -> m a) -> m a
catch m a
m e -> m a
h = Catch e m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (m a -> (e -> m a) -> Catch e m a
forall (m :: * -> *) a e. m a -> (e -> m a) -> Catch e m a
Catch m a
m e -> m a
h)
{-# INLINE catch #-}
try :: Eff (Catch e) m => m a -> m (Either e a)
try :: m a -> m (Either e a)
try m a
m = (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right m a
m m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
Eff (Catch e) m =>
m a -> (e -> m a) -> m a
`catch` (Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
{-# INLINE try #-}
catchJust :: forall smallExc bigExc m a
. Eff (Error bigExc) m
=> (bigExc -> Maybe smallExc)
-> m a
-> (smallExc -> m a)
-> m a
catchJust :: (bigExc -> Maybe smallExc) -> m a -> (smallExc -> m a) -> m a
catchJust bigExc -> Maybe smallExc
f m a
m smallExc -> m a
h = m a
m m a -> (bigExc -> m a) -> m a
forall e (m :: * -> *) a.
Eff (Catch e) m =>
m a -> (e -> m a) -> m a
`catch` \bigExc
e -> m a -> (smallExc -> m a) -> Maybe smallExc -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (bigExc -> m a
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw bigExc
e) smallExc -> m a
h (bigExc -> Maybe smallExc
f bigExc
e)
{-# INLINE catchJust #-}
tryJust :: forall smallExc bigExc m a
. Eff (Error bigExc) m
=> (bigExc -> Maybe smallExc)
-> m a
-> m (Either smallExc a)
tryJust :: (bigExc -> Maybe smallExc) -> m a -> m (Either smallExc a)
tryJust bigExc -> Maybe smallExc
f m a
m = (a -> Either smallExc a) -> m a -> m (Either smallExc a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either smallExc a
forall a b. b -> Either a b
Right m a
m m (Either smallExc a)
-> (m (Either smallExc a)
-> (smallExc -> m (Either smallExc a)) -> m (Either smallExc a))
-> (smallExc -> m (Either smallExc a))
-> m (Either smallExc a)
forall a b. a -> (a -> b) -> b
&((bigExc -> Maybe smallExc)
-> m (Either smallExc a)
-> (smallExc -> m (Either smallExc a))
-> m (Either smallExc a)
forall smallExc bigExc (m :: * -> *) a.
Eff (Error bigExc) m =>
(bigExc -> Maybe smallExc) -> m a -> (smallExc -> m a) -> m a
catchJust bigExc -> Maybe smallExc
f)((smallExc -> m (Either smallExc a)) -> m (Either smallExc a))
-> (smallExc -> m (Either smallExc a)) -> m (Either smallExc a)
forall a b. (a -> b) -> a -> b
$ (Either smallExc a -> m (Either smallExc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either smallExc a -> m (Either smallExc a))
-> (smallExc -> Either smallExc a)
-> smallExc
-> m (Either smallExc a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. smallExc -> Either smallExc a
forall a b. a -> Either a b
Left)
{-# INLINE tryJust #-}
note :: Eff (Throw e) m => e -> Maybe a -> m a
note :: e -> Maybe a -> m a
note e
_ (Just a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
note e
e Maybe a
Nothing = e -> m a
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw e
e
{-# INLINE note #-}
fromEither :: Eff (Throw e) m => Either e a -> m a
fromEither :: Either e a -> m a
fromEither = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE fromEither #-}
runThrow :: forall e m a p
. ( Carrier m
, Threaders '[ErrorThreads] m p
)
=> ThrowC e m a
-> m (Either e a)
runThrow :: ThrowC e m a -> m (Either e a)
runThrow = ThrowC e m a -> m (Either e a)
coerce
{-# INLINE runThrow #-}
runError :: forall e m a p
. ( Carrier m
, Threaders '[ErrorThreads] m p
)
=> ErrorC e m a
-> m (Either e a)
runError :: ErrorC e m a -> m (Either e a)
runError = ErrorC e m a -> m (Either e a)
coerce
{-# INLINE runError #-}
throwToThrow :: forall smallExc bigExc m a
. Eff (Throw bigExc) m
=> (smallExc -> bigExc)
-> InterpretReifiedC (Throw smallExc) m a
-> m a
throwToThrow :: (smallExc -> bigExc)
-> InterpretReifiedC (Throw smallExc) m a -> m a
throwToThrow smallExc -> bigExc
to = EffHandler (Throw smallExc) m
-> InterpretReifiedC (Throw smallExc) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler (Throw smallExc) m
-> InterpretReifiedC (Throw smallExc) m a -> m a)
-> EffHandler (Throw smallExc) m
-> InterpretReifiedC (Throw smallExc) m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
Throw e -> bigExc -> Effly z x
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw (smallExc -> bigExc
to smallExc
e)
{-# INLINE throwToThrow #-}
catchToError :: forall smallExc bigExc m a
. Eff (Error bigExc) m
=> (bigExc -> Maybe smallExc)
-> InterpretReifiedC (Catch smallExc) m a
-> m a
catchToError :: (bigExc -> Maybe smallExc)
-> InterpretReifiedC (Catch smallExc) m a -> m a
catchToError bigExc -> Maybe smallExc
from = EffHandler (Catch smallExc) m
-> InterpretReifiedC (Catch smallExc) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler (Catch smallExc) m
-> InterpretReifiedC (Catch smallExc) m a -> m a)
-> EffHandler (Catch smallExc) m
-> InterpretReifiedC (Catch smallExc) m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
Catch m h -> Effly z x
m Effly z x
-> (Effly z x -> (smallExc -> Effly z x) -> Effly z x)
-> (smallExc -> Effly z x)
-> Effly z x
forall a b. a -> (a -> b) -> b
&((bigExc -> Maybe smallExc)
-> Effly z x -> (smallExc -> Effly z x) -> Effly z x
forall smallExc bigExc (m :: * -> *) a.
Eff (Error bigExc) m =>
(bigExc -> Maybe smallExc) -> m a -> (smallExc -> m a) -> m a
catchJust bigExc -> Maybe smallExc
from)((smallExc -> Effly z x) -> Effly z x)
-> (smallExc -> Effly z x) -> Effly z x
forall a b. (a -> b) -> a -> b
$ smallExc -> Effly z x
h
{-# INLINE catchToError #-}
errorToError :: forall smallExc bigExc m a
. Eff (Error bigExc) m
=> (smallExc -> bigExc)
-> (bigExc -> Maybe smallExc)
-> InterpretErrorC smallExc m a
-> m a
errorToError :: (smallExc -> bigExc)
-> (bigExc -> Maybe smallExc)
-> InterpretErrorC smallExc m a
-> m a
errorToError smallExc -> bigExc
to bigExc -> Maybe smallExc
from InterpretErrorC smallExc m a
m0 =
(smallExc -> bigExc)
-> InterpretReifiedC (Throw smallExc) m a -> m a
forall smallExc bigExc (m :: * -> *) a.
Eff (Throw bigExc) m =>
(smallExc -> bigExc)
-> InterpretReifiedC (Throw smallExc) m a -> m a
throwToThrow smallExc -> bigExc
to
(InterpretReifiedC (Throw smallExc) m a -> m a)
-> InterpretReifiedC (Throw smallExc) m a -> m a
forall a b. (a -> b) -> a -> b
$ EffHandler
(Catch smallExc) (InterpretC (ViaReifiedH s) (Throw smallExc) m)
-> InterpretReifiedC
(Catch smallExc) (InterpretC (ViaReifiedH s) (Throw smallExc) m) a
-> InterpretC (ViaReifiedH s) (Throw smallExc) m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret \case
Catch m h -> Effly z x
m Effly z x -> (bigExc -> Effly z x) -> Effly z x
forall e (m :: * -> *) a.
Eff (Catch e) m =>
m a -> (e -> m a) -> m a
`catch` \bigExc
e -> case bigExc -> Maybe smallExc
from bigExc
e of
Just smallExc
e' -> smallExc -> Effly z x
h smallExc
e'
Maybe smallExc
Nothing -> IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
IntroConsistent '[] '[e] m =>
IntroTopC '[e] m a -> m a
intro1 (IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x)
-> IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ bigExc -> IntroTopC '[Throw smallExc] (Effly z) x
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw bigExc
e
(InterpretReifiedC
(Catch smallExc) (InterpretC (ViaReifiedH s) (Throw smallExc) m) a
-> InterpretC (ViaReifiedH s) (Throw smallExc) m a)
-> InterpretReifiedC
(Catch smallExc) (InterpretC (ViaReifiedH s) (Throw smallExc) m) a
-> InterpretC (ViaReifiedH s) (Throw smallExc) m a
forall a b. (a -> b) -> a -> b
$ InterpretErrorC' s s smallExc m a
-> InterpretC
(ViaReifiedH s)
(Catch smallExc)
(InterpretC (ViaReifiedH s) (Throw smallExc) m)
a
forall s s' e (m :: * -> *) a.
InterpretErrorC' s s' e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s') (Throw e) m)
a
unInterpretErrorC'
(InterpretErrorC' s s smallExc m a
-> InterpretC
(ViaReifiedH s)
(Catch smallExc)
(InterpretC (ViaReifiedH s) (Throw smallExc) m)
a)
-> InterpretErrorC' s s smallExc m a
-> InterpretC
(ViaReifiedH s)
(Catch smallExc)
(InterpretC (ViaReifiedH s) (Throw smallExc) m)
a
forall a b. (a -> b) -> a -> b
$ InterpretErrorC' s s smallExc m a
InterpretErrorC smallExc m a
m0
{-# INLINE errorToError #-}
throwToThrowSimple :: forall smallExc bigExc m a p
. ( Eff (Throw bigExc) m
, Threaders '[ReaderThreads] m p
)
=> (smallExc -> bigExc)
-> InterpretSimpleC (Throw smallExc) m a
-> m a
throwToThrowSimple :: (smallExc -> bigExc)
-> InterpretSimpleC (Throw smallExc) m a -> m a
throwToThrowSimple smallExc -> bigExc
to = EffHandler (Throw smallExc) m
-> InterpretSimpleC (Throw smallExc) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler (Throw smallExc) m
-> InterpretSimpleC (Throw smallExc) m a -> m a)
-> EffHandler (Throw smallExc) m
-> InterpretSimpleC (Throw smallExc) m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
Throw e -> bigExc -> Effly z x
forall e (m :: * -> *) a. Eff (Throw e) m => e -> m a
throw (smallExc -> bigExc
to smallExc
e)
{-# INLINE throwToThrowSimple #-}
catchToErrorSimple :: forall smallExc bigExc m a p
. ( Eff (Error bigExc) m
, Threaders '[ReaderThreads] m p
)
=> (bigExc -> Maybe smallExc)
-> InterpretSimpleC (Catch smallExc) m a
-> m a
catchToErrorSimple :: (bigExc -> Maybe smallExc)
-> InterpretSimpleC (Catch smallExc) m a -> m a
catchToErrorSimple bigExc -> Maybe smallExc
from = EffHandler (Catch smallExc) m
-> InterpretSimpleC (Catch smallExc) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler (Catch smallExc) m
-> InterpretSimpleC (Catch smallExc) m a -> m a)
-> EffHandler (Catch smallExc) m
-> InterpretSimpleC (Catch smallExc) m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
Catch m h -> (bigExc -> Maybe smallExc)
-> Effly z x -> (smallExc -> Effly z x) -> Effly z x
forall smallExc bigExc (m :: * -> *) a.
Eff (Error bigExc) m =>
(bigExc -> Maybe smallExc) -> m a -> (smallExc -> m a) -> m a
catchJust bigExc -> Maybe smallExc
from Effly z x
m smallExc -> Effly z x
h
{-# INLINE catchToErrorSimple #-}
errorToErrorSimple :: forall smallExc bigExc m a p
. ( Eff (Error bigExc) m
, Threaders '[ReaderThreads] m p
)
=> (smallExc -> bigExc)
-> (bigExc -> Maybe smallExc)
-> InterpretErrorSimpleC smallExc m a
-> m a
errorToErrorSimple :: (smallExc -> bigExc)
-> (bigExc -> Maybe smallExc)
-> InterpretErrorSimpleC smallExc m a
-> m a
errorToErrorSimple smallExc -> bigExc
to bigExc -> Maybe smallExc
from =
(smallExc -> bigExc)
-> InterpretSimpleC (Throw smallExc) m a -> m a
forall smallExc bigExc (m :: * -> *) a (p :: [Effect]).
(Eff (Throw bigExc) m, Threaders '[ReaderThreads] m p) =>
(smallExc -> bigExc)
-> InterpretSimpleC (Throw smallExc) m a -> m a
throwToThrowSimple smallExc -> bigExc
to
(InterpretSimpleC (Throw smallExc) m a -> m a)
-> (InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a
-> InterpretSimpleC (Throw smallExc) m a)
-> InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EffHandler (Catch smallExc) (InterpretSimpleC (Throw smallExc) m)
-> InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a
-> InterpretSimpleC (Throw smallExc) m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple \case
Catch m h -> IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
IntroConsistent '[] '[e] m =>
IntroTopC '[e] m a -> m a
intro1 (IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x)
-> IntroTopC '[Throw smallExc] (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ (bigExc -> Maybe smallExc)
-> IntroTopC '[Throw smallExc] (Effly z) x
-> (smallExc -> IntroTopC '[Throw smallExc] (Effly z) x)
-> IntroTopC '[Throw smallExc] (Effly z) x
forall smallExc bigExc (m :: * -> *) a.
Eff (Error bigExc) m =>
(bigExc -> Maybe smallExc) -> m a -> (smallExc -> m a) -> m a
catchJust bigExc -> Maybe smallExc
from (Effly z x -> IntroTopC '[Throw smallExc] (Effly z) x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Effly z x
m) (Effly z x -> IntroTopC '[Throw smallExc] (Effly z) x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Effly z x -> IntroTopC '[Throw smallExc] (Effly z) x)
-> (smallExc -> Effly z x)
-> smallExc
-> IntroTopC '[Throw smallExc] (Effly z) x
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. smallExc -> Effly z x
h)
(InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a
-> m a)
-> (InterpretErrorSimpleC smallExc m a
-> InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a)
-> InterpretErrorSimpleC smallExc m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretErrorSimpleC smallExc m a
-> InterpretSimpleC
(Catch smallExc) (InterpretSimpleC (Throw smallExc) m) a
forall e (m :: * -> *) a.
InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
unInterpretErrorSimpleC
{-# INLINE errorToErrorSimple #-}