{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Control.Monad.Rescue
( attemptM
, rescue
, rescueT
, rescueM
, rescueBase
, rescueEach
, rescueEachM
, rescueEachT
, rescueAll
, reattempt
, report
, lastly
, mapError
, replaceError
, asNotFound
, module Control.Monad.Raise
, module Control.Monad.Rescue.Class
, module Control.Monad.Rescue.Constraint
) where
import Numeric.Natural
import Data.Bifunctor as Bifunctor
import Data.Exception.Types
import Data.WorldPeace
import Control.Monad.Base
import Control.Monad.Raise
import Control.Monad.Rescue.Class
import Control.Monad.Rescue.Constraint
import Control.Monad.Trans.Error
attemptM :: MonadRescue m => m a -> (Either (ErrorCase m) a -> m b) -> m b
attemptM :: m a -> (Either (ErrorCase m) a -> m b) -> m b
attemptM m a
action Either (ErrorCase m) a -> m b
handler = m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action m (Either (ErrorCase m) a)
-> (Either (ErrorCase m) a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (ErrorCase m) a -> m b
handler
rescue
:: ( Bifunctor m
, ElemRemove err errs
)
=> (err -> OpenUnion (Remove err errs))
-> m (OpenUnion errs) a
-> m (OpenUnion (Remove err errs)) a
rescue :: (err -> OpenUnion (Remove err errs))
-> m (OpenUnion errs) a -> m (OpenUnion (Remove err errs)) a
rescue err -> OpenUnion (Remove err errs)
handler = (OpenUnion errs -> OpenUnion (Remove err errs))
-> m (OpenUnion errs) a -> m (OpenUnion (Remove err errs)) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first ((OpenUnion (Remove err errs) -> OpenUnion (Remove err errs))
-> (err -> OpenUnion (Remove err errs))
-> OpenUnion errs
-> OpenUnion (Remove err errs)
forall a (as :: [*]) b.
ElemRemove a as =>
(OpenUnion (Remove a as) -> b) -> (a -> b) -> OpenUnion as -> b
openUnionHandle OpenUnion (Remove err errs) -> OpenUnion (Remove err errs)
forall a. a -> a
id err -> OpenUnion (Remove err errs)
handler)
rescueT ::
( MonadTransError t errs m
, MonadRaise (t (Remove err errs) m)
, CheckErrors (t (Remove err errs) m)
, ElemRemove err (Errors (t errs m))
, Remove err (Errors (t errs m)) ~ Errors (t (Remove err errs) m)
)
=> (err -> (t (Remove err errs)) m a)
-> t errs m a
-> t (Remove err errs) m a
rescueT :: (err -> t (Remove err errs) m a)
-> t errs m a -> t (Remove err errs) m a
rescueT err -> t (Remove err errs) m a
handler = (OpenUnion (Errors (t errs m)) -> t (Remove err errs) m a)
-> t errs m a -> t (Remove err errs) m a
forall (t :: [*] -> (* -> *) -> * -> *) (sourceErrs :: [*])
(m :: * -> *) (targetErrs :: [*]) a.
MonadTransError t sourceErrs m =>
(OpenUnion (Errors (t sourceErrs m)) -> t targetErrs m a)
-> t sourceErrs m a -> t targetErrs m a
onRaise ((OpenUnion (Remove err (Errors (t errs m)))
-> t (Remove err errs) m a)
-> (err -> t (Remove err errs) m a)
-> OpenUnion (Errors (t errs m))
-> t (Remove err errs) m a
forall a (as :: [*]) b.
ElemRemove a as =>
(OpenUnion (Remove a as) -> b) -> (a -> b) -> OpenUnion as -> b
openUnionHandle OpenUnion (Remove err (Errors (t errs m)))
-> t (Remove err errs) m a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise err -> t (Remove err errs) m a
handler)
rescueBase
:: ( MonadRescue wide
, MonadBase wide narrow
, MonadRaise narrow
, CheckErrors narrow
, Remove err (Errors wide) ~ Errors narrow
, ElemRemove err (Errors wide)
)
=> (err -> narrow a)
-> wide a
-> narrow a
rescueBase :: (err -> narrow a) -> wide a -> narrow a
rescueBase err -> narrow a
handler wide a
action =
wide (Either (OpenUnion (Errors wide)) a)
-> narrow (Either (OpenUnion (Errors wide)) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (wide a -> wide (Either (OpenUnion (Errors wide)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt wide a
action) narrow (Either (OpenUnion (Errors wide)) a)
-> (Either (OpenUnion (Errors wide)) a -> narrow a) -> narrow a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left OpenUnion (Errors wide)
err -> (OpenUnion (Remove err (Errors wide)) -> narrow a)
-> (err -> narrow a) -> OpenUnion (Errors wide) -> narrow a
forall a (as :: [*]) b.
ElemRemove a as =>
(OpenUnion (Remove a as) -> b) -> (a -> b) -> OpenUnion as -> b
openUnionHandle OpenUnion (Remove err (Errors wide)) -> narrow a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise err -> narrow a
handler OpenUnion (Errors wide)
err
Right a
value -> a -> narrow a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
rescueM
:: ( MonadBase (m (OpenUnion wide)) (m (OpenUnion (Remove err wide)))
, MonadRescue (m (OpenUnion wide))
, MonadRaise (m (OpenUnion narrow))
, wide ~ Errors (m (OpenUnion wide))
, narrow ~ Errors (m (OpenUnion narrow))
, narrow ~ Remove err wide
, CheckErrors (m (OpenUnion narrow))
, ElemRemove err wide
)
=> (err -> m (OpenUnion narrow) a)
-> m (OpenUnion wide) a
-> m (OpenUnion narrow) a
rescueM :: (err -> m (OpenUnion narrow) a)
-> m (OpenUnion wide) a -> m (OpenUnion narrow) a
rescueM err -> m (OpenUnion narrow) a
handler m (OpenUnion wide) a
action =
m (OpenUnion wide) (Either (OpenUnion wide) a)
-> m (OpenUnion narrow) (Either (OpenUnion wide) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m (OpenUnion wide) a
-> m (OpenUnion wide) (Either (ErrorCase (m (OpenUnion wide))) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m (OpenUnion wide) a
action) m (OpenUnion narrow) (Either (OpenUnion wide) a)
-> (Either (OpenUnion wide) a -> m (OpenUnion narrow) a)
-> m (OpenUnion narrow) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right a
val ->
a -> m (OpenUnion narrow) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
Left OpenUnion wide
errs ->
case OpenUnion wide -> Either (OpenUnion (Remove err wide)) err
forall a (as :: [*]).
ElemRemove a as =>
OpenUnion as -> Either (OpenUnion (Remove a as)) a
openUnionRemove OpenUnion wide
errs of
Left OpenUnion (Remove err wide)
remainingErrs -> OpenUnion narrow -> m (OpenUnion narrow) a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise OpenUnion narrow
OpenUnion (Remove err wide)
remainingErrs
Right err
matchedErr -> err -> m (OpenUnion narrow) a
handler err
matchedErr
rescueEach
:: ( Bifunctor m
, ToOpenProduct handlerTuple (ReturnX (OpenUnion targetErrs) errs)
)
=> handlerTuple
-> m (OpenUnion errs) a
-> m (OpenUnion targetErrs) a
rescueEach :: handlerTuple -> m (OpenUnion errs) a -> m (OpenUnion targetErrs) a
rescueEach handlerTuple
handleCases = (OpenUnion errs -> OpenUnion targetErrs)
-> m (OpenUnion errs) a -> m (OpenUnion targetErrs) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first (handlerTuple -> OpenUnion errs -> OpenUnion targetErrs
forall tuple x (as :: [*]).
ToOpenProduct tuple (ReturnX x as) =>
tuple -> OpenUnion as -> x
catchesOpenUnion handlerTuple
handleCases)
rescueEachM
:: ( sourceErrs ~ Errors (m (OpenUnion sourceErrs))
, MonadRescue (m (OpenUnion sourceErrs))
, MonadBase (m (OpenUnion sourceErrs)) (m (OpenUnion targetErrs))
, ToOpenProduct handlerTuple (ReturnX (m (OpenUnion targetErrs) a) sourceErrs)
)
=> handlerTuple
-> m (OpenUnion sourceErrs) a
-> m (OpenUnion targetErrs) a
rescueEachM :: handlerTuple
-> m (OpenUnion sourceErrs) a -> m (OpenUnion targetErrs) a
rescueEachM handlerTuple
handleCases m (OpenUnion sourceErrs) a
action =
m (OpenUnion sourceErrs) (Either (OpenUnion sourceErrs) a)
-> m (OpenUnion targetErrs) (Either (OpenUnion sourceErrs) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m (OpenUnion sourceErrs) a
-> m (OpenUnion sourceErrs)
(Either (ErrorCase (m (OpenUnion sourceErrs))) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m (OpenUnion sourceErrs) a
action) m (OpenUnion targetErrs) (Either (OpenUnion sourceErrs) a)
-> (Either (OpenUnion sourceErrs) a -> m (OpenUnion targetErrs) a)
-> m (OpenUnion targetErrs) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left OpenUnion sourceErrs
errs -> handlerTuple -> OpenUnion sourceErrs -> m (OpenUnion targetErrs) a
forall tuple x (as :: [*]).
ToOpenProduct tuple (ReturnX x as) =>
tuple -> OpenUnion as -> x
catchesOpenUnion handlerTuple
handleCases OpenUnion sourceErrs
errs
Right a
val -> a -> m (OpenUnion targetErrs) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
rescueEachT
:: ( sourceErrs ~ Errors (t sourceErrs m)
, MonadTransError t sourceErrs m
, ToOpenProduct handlerTuple (ReturnX (t targetErrs m a) sourceErrs)
)
=> handlerTuple
-> t sourceErrs m a
-> t targetErrs m a
rescueEachT :: handlerTuple -> t sourceErrs m a -> t targetErrs m a
rescueEachT handlerTuple
handleCases = (OpenUnion (Errors (t sourceErrs m)) -> t targetErrs m a)
-> t sourceErrs m a -> t targetErrs m a
forall (t :: [*] -> (* -> *) -> * -> *) (sourceErrs :: [*])
(m :: * -> *) (targetErrs :: [*]) a.
MonadTransError t sourceErrs m =>
(OpenUnion (Errors (t sourceErrs m)) -> t targetErrs m a)
-> t sourceErrs m a -> t targetErrs m a
onRaise (handlerTuple -> OpenUnion sourceErrs -> t targetErrs m a
forall tuple x (as :: [*]).
ToOpenProduct tuple (ReturnX x as) =>
tuple -> OpenUnion as -> x
catchesOpenUnion handlerTuple
handleCases)
rescueAll
:: ( MonadRescue (m (OpenUnion errs))
, MonadBase (m (OpenUnion errs)) (m ())
, errs ~ Errors (m (OpenUnion errs))
)
=> (OpenUnion errs -> m () a)
-> m (OpenUnion errs) a
-> m () a
rescueAll :: (OpenUnion errs -> m () a) -> m (OpenUnion errs) a -> m () a
rescueAll OpenUnion errs -> m () a
handler m (OpenUnion errs) a
action =
m (OpenUnion errs) (Either (OpenUnion errs) a)
-> m () (Either (OpenUnion errs) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m (OpenUnion errs) a
-> m (OpenUnion errs) (Either (ErrorCase (m (OpenUnion errs))) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m (OpenUnion errs) a
action) m () (Either (OpenUnion errs) a)
-> (Either (OpenUnion errs) a -> m () a) -> m () a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left OpenUnion errs
errs -> OpenUnion errs -> m () a
handler OpenUnion errs
errs
Right a
val -> a -> m () a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
report
:: ( MonadRescue m
, RaisesOnly m errs
, CheckErrors m
)
=> (ErrorCase m -> m ())
-> m a
-> m a
report :: (ErrorCase m -> m ()) -> m a -> m a
report ErrorCase m -> m ()
withErr m a
action =
m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action m (Either (Union Identity errs) a)
-> (Either (Union Identity errs) a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Union Identity errs
err -> do
ErrorCase m -> m ()
withErr Union Identity errs
ErrorCase m
err
Union Identity errs -> m a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise Union Identity errs
err
Right a
val ->
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
reattempt :: MonadRescue m => Natural -> m a -> m a
reattempt :: Natural -> m a -> m a
reattempt Natural
0 m a
action = m a
action
reattempt Natural
times m a
action =
m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action m (Either (ErrorCase m) a)
-> (Either (ErrorCase m) a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ErrorCase m
_ -> Natural -> m a -> m a
forall (m :: * -> *) a. MonadRescue m => Natural -> m a -> m a
reattempt (Natural
times Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) m a
action
Right a
val -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
lastly :: (CheckErrors m, MonadRescue m) => m a -> m b -> m a
lastly :: m a -> m b -> m a
lastly m a
action m b
finalizer = do
Either (OpenUnion (Errors m)) a
errOrOk <- m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action
b
_ <- m b
finalizer
Either (OpenUnion (Errors m)) a -> m a
forall (m :: * -> *) inner a.
(MonadRaise m, Raises m inner) =>
Either inner a -> m a
ensure Either (OpenUnion (Errors m)) a
errOrOk
mapError
:: ( MonadRescue m
, MonadBase m n
, MonadRaise n
, CheckErrors n
)
=> (ErrorCase m -> ErrorCase n)
-> m a
-> n a
mapError :: (ErrorCase m -> ErrorCase n) -> m a -> n a
mapError ErrorCase m -> ErrorCase n
mapper m a
action =
m (Either (ErrorCase m) a) -> n (Either (ErrorCase m) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action) n (Either (ErrorCase m) a)
-> (Either (ErrorCase m) a -> n a) -> n a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left ErrorCase m
errCaseN -> ErrorCase n -> n a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise (ErrorCase n -> n a) -> ErrorCase n -> n a
forall a b. (a -> b) -> a -> b
$ ErrorCase m -> ErrorCase n
mapper ErrorCase m
errCaseN
Right a
value -> a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
replaceError
:: ( MonadRescue m
, MonadBase m n
, MonadRaise n
, n `Raises` err
)
=> err
-> m a
-> n a
replaceError :: err -> m a -> n a
replaceError err
err m a
action =
m (Either (OpenUnion (Errors m)) a)
-> n (Either (OpenUnion (Errors m)) a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action) n (Either (OpenUnion (Errors m)) a)
-> (Either (OpenUnion (Errors m)) a -> n a) -> n a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left OpenUnion (Errors m)
_ -> err -> n a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise err
err
Right a
value -> a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
asNotFound
:: forall n m a .
( MonadRescue m
, MonadBase m n
, MonadRaise n
, n `Raises` NotFound a
)
=> m a
-> n a
asNotFound :: m a -> n a
asNotFound = NotFound a -> m a -> n a
forall (m :: * -> *) (n :: * -> *) err a.
(MonadRescue m, MonadBase m n, MonadRaise n, Raises n err) =>
err -> m a -> n a
replaceError (NotFound a
forall entity. NotFound entity
NotFound @a)