{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Control.Monad.Rescue
( rescue
, handle
, reattempt
, onRaise
, lastly
, module Control.Monad.Raise
, module Control.Monad.Rescue.Class
, module Control.Monad.Rescue.Constraint
) where
import Data.Result.Types
import Data.WorldPeace
import Control.Monad.Raise
import Control.Monad.Rescue.Class
import Control.Monad.Rescue.Constraint
import Numeric.Natural
rescue
:: MonadRescueFrom n m
=> n a
-> (ErrorCase n -> m a)
-> m a
rescue action handler = either handler pure =<< attempt action
handle
:: ( MonadRaise m
, MonadRescueFrom n m
, Handles err n m
)
=> n a
-> (err -> m a)
-> m a
handle action handler =
either runHandler pure =<< attempt action
where
runHandler = openUnionHandle raise handler
onRaise
:: ( MonadRescue m
, RaisesOnly m errs
)
=> (OpenUnion errs -> m ())
-> m a
-> m (Result errs a)
onRaise errHandler action =
attempt action >>= \case
Left err -> do
errHandler err
return $ Err err
Right val ->
return $ Ok val
reattempt :: MonadRescue m => Natural -> m a -> m a
reattempt 0 action = action
reattempt times action =
attempt action >>= \case
Left _ -> reattempt (times - 1) action
Right val -> return val
lastly
:: ( Errors m `Contains` Errors m
, MonadRaise m
, MonadRescueFrom m m
)
=> m a
-> m b
-> m a
lastly action finalizer = do
errOrOk <- attempt action
_ <- finalizer
ensure errOrOk