{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{- | This module provides a Retry effect to adapt
 the @<https://hackage.haskell.org/package/retry retry>@ library for
 the @<https://hackage.haskell.org/package/effectful effectful>@ ecosystem.
-}
module Effectful.Retry (
    -- * Effect
    Retry,
    runRetry,

    -- * Types and Operations
    Control.Retry.RetryPolicyM (..),
    Control.Retry.retryPolicy,
    Control.Retry.retryPolicyDefault,
    Control.Retry.RetryAction (..),
    Control.Retry.toRetryAction,
    Control.Retry.RetryStatus (..),
    Control.Retry.defaultRetryStatus,
    Effectful.Retry.applyPolicy,
    Effectful.Retry.applyAndDelay,

    -- * Applying Retry Policies
    Effectful.Retry.retrying,
    Effectful.Retry.retryingDynamic,
    Effectful.Retry.recovering,
    Effectful.Retry.recoveringDynamic,
    Effectful.Retry.stepping,
    Effectful.Retry.recoverAll,
    Effectful.Retry.skipAsyncExceptions,
    Effectful.Retry.logRetries,
    Control.Retry.defaultLogMsg,
    -- Effectful.Retry.retryOnError,

    -- * Resumable variants
    Effectful.Retry.resumeRetrying,
    Effectful.Retry.resumeRetryingDynamic,
    Effectful.Retry.resumeRecovering,
    Effectful.Retry.resumeRecoveringDynamic,
    Effectful.Retry.resumeRecoverAll,

    -- * Retry Policies
    Control.Retry.constantDelay,
    Control.Retry.exponentialBackoff,
    Control.Retry.fullJitterBackoff,
    Control.Retry.fibonacciBackoff,
    Control.Retry.limitRetries,

    -- * Policy Transformers
    Control.Retry.limitRetriesByDelay,
    Control.Retry.limitRetriesByCumulativeDelay,
    Control.Retry.capDelay,

    -- * Development Helpers
    Control.Retry.simulatePolicy,
    Control.Retry.simulatePolicyPP,
) where

import Effectful
import Effectful.Dispatch.Static
import Effectful.Internal.Env (Env)

import Control.Exception (AsyncException, SomeAsyncException)
import Control.Monad.Catch
import Control.Retry

-- | An empty effect to provide the retry requirements, e.g. MonadIO and MonadMask
data Retry :: Effect

type instance DispatchOf Retry = 'Static 'WithSideEffects
data instance StaticRep Retry = Retry

-- | Peel the 'Retry' effect.
runRetry :: IOE :> es => Eff (Retry : es) a -> Eff es a
runRetry :: forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (Retry : es) a -> Eff es a
runRetry = forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Retry
Retry

-- effect helper
policyIO :: Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO :: forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env (RetryPolicyM RetryStatus -> Eff es (Maybe Int)
policy) = forall (m :: * -> *).
(RetryStatus -> m (Maybe Int)) -> RetryPolicyM m
RetryPolicyM forall a b. (a -> b) -> a -> b
$ \RetryStatus
s -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es (Maybe Int)
policy RetryStatus
s) Env es
env

-- effect helper
handlerIO :: Env es -> Handler (Eff es) a -> Handler IO a
handlerIO :: forall (es :: [Effect]) a.
Env es -> Handler (Eff es) a -> Handler IO a
handlerIO Env es
env (Handler e -> Eff es a
handler) = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \e
e -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (e -> Eff es a
handler e
e) Env es
env

-- wrappers
applyPolicy :: Retry :> es => RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)
applyPolicy :: forall (es :: [Effect]).
(Retry :> es) =>
RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)
applyPolicy RetryPolicyM (Eff es)
policy RetryStatus
status = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env -> forall (m :: * -> *).
Monad m =>
RetryPolicyM m -> RetryStatus -> m (Maybe RetryStatus)
Control.Retry.applyPolicy (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy) RetryStatus
status

applyAndDelay :: Retry :> es => RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)
applyAndDelay :: forall (es :: [Effect]).
(Retry :> es) =>
RetryPolicyM (Eff es) -> RetryStatus -> Eff es (Maybe RetryStatus)
applyAndDelay RetryPolicyM (Eff es)
policy RetryStatus
status = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env -> forall (m :: * -> *).
MonadIO m =>
RetryPolicyM m -> RetryStatus -> m (Maybe RetryStatus)
Control.Retry.applyAndDelay (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy) RetryStatus
status

retrying ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    (RetryStatus -> b -> Eff es Bool) ->
    (RetryStatus -> Eff es b) ->
    Eff es b
retrying :: forall (es :: [Effect]) b.
(Retry :> es) =>
RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es Bool)
-> (RetryStatus -> Eff es b)
-> Eff es b
retrying = forall (es :: [Effect]) b.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es Bool)
-> (RetryStatus -> Eff es b)
-> Eff es b
Effectful.Retry.resumeRetrying RetryStatus
defaultRetryStatus

retryingDynamic ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    (RetryStatus -> b -> Eff es RetryAction) ->
    (RetryStatus -> Eff es b) ->
    Eff es b
retryingDynamic :: forall (es :: [Effect]) b.
(Retry :> es) =>
RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es RetryAction)
-> (RetryStatus -> Eff es b)
-> Eff es b
retryingDynamic = forall (es :: [Effect]) b.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es RetryAction)
-> (RetryStatus -> Eff es b)
-> Eff es b
Effectful.Retry.resumeRetryingDynamic RetryStatus
defaultRetryStatus

resumeRetrying ::
    Retry :> es =>
    RetryStatus ->
    RetryPolicyM (Eff es) ->
    (RetryStatus -> b -> Eff es Bool) ->
    (RetryStatus -> Eff es b) ->
    Eff es b
resumeRetrying :: forall (es :: [Effect]) b.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es Bool)
-> (RetryStatus -> Eff es b)
-> Eff es b
resumeRetrying RetryStatus
retryStatus RetryPolicyM (Eff es)
policy RetryStatus -> b -> Eff es Bool
chk =
    forall (es :: [Effect]) b.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es RetryAction)
-> (RetryStatus -> Eff es b)
-> Eff es b
Effectful.Retry.resumeRetryingDynamic
        RetryStatus
retryStatus
        RetryPolicyM (Eff es)
policy
        (\RetryStatus
rs -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> RetryAction
toRetryAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetryStatus -> b -> Eff es Bool
chk RetryStatus
rs)

resumeRetryingDynamic ::
    Retry :> es =>
    RetryStatus ->
    RetryPolicyM (Eff es) ->
    (RetryStatus -> b -> Eff es RetryAction) ->
    (RetryStatus -> Eff es b) ->
    Eff es b
resumeRetryingDynamic :: forall (es :: [Effect]) b.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> (RetryStatus -> b -> Eff es RetryAction)
-> (RetryStatus -> Eff es b)
-> Eff es b
resumeRetryingDynamic RetryStatus
retryStatus RetryPolicyM (Eff es)
policy RetryStatus -> b -> Eff es RetryAction
chk RetryStatus -> Eff es b
f =
    forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env ->
        forall (m :: * -> *) b.
MonadIO m =>
RetryStatus
-> RetryPolicyM m
-> (RetryStatus -> b -> m RetryAction)
-> (RetryStatus -> m b)
-> m b
Control.Retry.resumeRetryingDynamic
            RetryStatus
retryStatus
            (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy)
            (\RetryStatus
rs b
b -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> b -> Eff es RetryAction
chk RetryStatus
rs b
b) Env es
env)
            (\RetryStatus
rs -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es b
f RetryStatus
rs) Env es
env)

recovering ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    [RetryStatus -> Handler (Eff es) Bool] ->
    (RetryStatus -> Eff es a) ->
    Eff es a
recovering :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) Bool]
-> (RetryStatus -> Eff es a)
-> Eff es a
recovering = forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) Bool]
-> (RetryStatus -> Eff es a)
-> Eff es a
Effectful.Retry.resumeRecovering RetryStatus
defaultRetryStatus

resumeRecovering ::
    Retry :> es =>
    RetryStatus ->
    RetryPolicyM (Eff es) ->
    [RetryStatus -> Handler (Eff es) Bool] ->
    (RetryStatus -> Eff es a) ->
    Eff es a
resumeRecovering :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) Bool]
-> (RetryStatus -> Eff es a)
-> Eff es a
resumeRecovering RetryStatus
retryStatus RetryPolicyM (Eff es)
policy [RetryStatus -> Handler (Eff es) Bool]
hs =
    forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) RetryAction]
-> (RetryStatus -> Eff es a)
-> Eff es a
Effectful.Retry.resumeRecoveringDynamic RetryStatus
retryStatus RetryPolicyM (Eff es)
policy [RetryStatus -> Handler (Eff es) RetryAction]
hs'
  where
    hs' :: [RetryStatus -> Handler (Eff es) RetryAction]
hs' = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> RetryAction
toRetryAction forall b c a. (b -> c) -> (a -> b) -> a -> c
.) [RetryStatus -> Handler (Eff es) Bool]
hs

recoveringDynamic ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    [RetryStatus -> Handler (Eff es) RetryAction] ->
    (RetryStatus -> Eff es a) ->
    Eff es a
recoveringDynamic :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) RetryAction]
-> (RetryStatus -> Eff es a)
-> Eff es a
recoveringDynamic = forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) RetryAction]
-> (RetryStatus -> Eff es a)
-> Eff es a
Effectful.Retry.resumeRecoveringDynamic RetryStatus
defaultRetryStatus

resumeRecoveringDynamic ::
    Retry :> es =>
    RetryStatus ->
    RetryPolicyM (Eff es) ->
    [RetryStatus -> Handler (Eff es) RetryAction] ->
    (RetryStatus -> Eff es a) ->
    Eff es a
resumeRecoveringDynamic :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) RetryAction]
-> (RetryStatus -> Eff es a)
-> Eff es a
resumeRecoveringDynamic RetryStatus
retryStatus RetryPolicyM (Eff es)
policy [RetryStatus -> Handler (Eff es) RetryAction]
hs RetryStatus -> Eff es a
f =
    forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env ->
        forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryStatus
-> RetryPolicyM m
-> [RetryStatus -> Handler m RetryAction]
-> (RetryStatus -> m a)
-> m a
Control.Retry.resumeRecoveringDynamic
            RetryStatus
retryStatus
            (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy)
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (es :: [Effect]) a.
Env es -> Handler (Eff es) a -> Handler IO a
handlerIO Env es
env) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RetryStatus -> Handler (Eff es) RetryAction]
hs)
            (\RetryStatus
rs -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es a
f RetryStatus
rs) Env es
env)

stepping ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    [RetryStatus -> Handler (Eff es) Bool] ->
    (RetryStatus -> Eff es ()) ->
    (RetryStatus -> Eff es a) ->
    RetryStatus ->
    Eff es (Maybe a)
stepping :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryPolicyM (Eff es)
-> [RetryStatus -> Handler (Eff es) Bool]
-> (RetryStatus -> Eff es ())
-> (RetryStatus -> Eff es a)
-> RetryStatus
-> Eff es (Maybe a)
stepping RetryPolicyM (Eff es)
policy [RetryStatus -> Handler (Eff es) Bool]
hs RetryStatus -> Eff es ()
schedule RetryStatus -> Eff es a
f RetryStatus
s =
    forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env ->
        forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool]
-> (RetryStatus -> m ())
-> (RetryStatus -> m a)
-> RetryStatus
-> m (Maybe a)
Control.Retry.stepping
            (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy)
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (es :: [Effect]) a.
Env es -> Handler (Eff es) a -> Handler IO a
handlerIO Env es
env) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RetryStatus -> Handler (Eff es) Bool]
hs)
            (\RetryStatus
rs -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es ()
schedule RetryStatus
rs) Env es
env)
            (\RetryStatus
rs -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es a
f RetryStatus
rs) Env es
env)
            RetryStatus
s

recoverAll ::
    Retry :> es =>
    RetryPolicyM (Eff es) ->
    (RetryStatus -> Eff es a) ->
    Eff es a
recoverAll :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryPolicyM (Eff es) -> (RetryStatus -> Eff es a) -> Eff es a
recoverAll = forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es) -> (RetryStatus -> Eff es a) -> Eff es a
Effectful.Retry.resumeRecoverAll RetryStatus
defaultRetryStatus

resumeRecoverAll :: Retry :> es => RetryStatus -> RetryPolicyM (Eff es) -> (RetryStatus -> Eff es a) -> Eff es a
resumeRecoverAll :: forall (es :: [Effect]) a.
(Retry :> es) =>
RetryStatus
-> RetryPolicyM (Eff es) -> (RetryStatus -> Eff es a) -> Eff es a
resumeRecoverAll RetryStatus
retryStatus RetryPolicyM (Eff es)
policy RetryStatus -> Eff es a
f =
    forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
env ->
        forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryStatus -> RetryPolicyM m -> (RetryStatus -> m a) -> m a
Control.Retry.resumeRecoverAll
            RetryStatus
retryStatus
            (forall (es :: [Effect]).
Env es -> RetryPolicyM (Eff es) -> RetryPolicyM IO
policyIO Env es
env RetryPolicyM (Eff es)
policy)
            (\RetryStatus
rs -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (RetryStatus -> Eff es a
f RetryStatus
rs) Env es
env)

skipAsyncExceptions ::
    Retry :> es =>
    [RetryStatus -> Handler (Eff es) Bool]
skipAsyncExceptions :: forall (es :: [Effect]).
(Retry :> es) =>
[RetryStatus -> Handler (Eff es) Bool]
skipAsyncExceptions = [forall {m :: * -> *} {p}. Monad m => p -> Handler m Bool
asyncH, forall {m :: * -> *} {p}. Monad m => p -> Handler m Bool
someAsyncH]
  where
    asyncH :: p -> Handler m Bool
asyncH p
_ = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(AsyncException
_ :: AsyncException) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    someAsyncH :: p -> Handler m Bool
someAsyncH p
_ = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(SomeAsyncException
_ :: SomeAsyncException) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

logRetries ::
    (Retry :> es, Exception e) =>
    (e -> Eff es Bool) ->
    (Bool -> e -> RetryStatus -> Eff es ()) ->
    RetryStatus ->
    Handler (Eff es) Bool
logRetries :: forall (es :: [Effect]) e.
(Retry :> es, Exception e) =>
(e -> Eff es Bool)
-> (Bool -> e -> RetryStatus -> Eff es ())
-> RetryStatus
-> Handler (Eff es) Bool
logRetries e -> Eff es Bool
test Bool -> e -> RetryStatus -> Eff es ()
reporter RetryStatus
status = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \e
err -> do
    Bool
result <- e -> Eff es Bool
test e
err
    Bool -> e -> RetryStatus -> Eff es ()
reporter Bool
result e
err RetryStatus
status
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result

{- TODO
retryOnError
    :: (Error e :> es, Retry :> es)
    => RetryPolicyM (Eff es)
    -> (RetryStatus -> e -> Eff es Bool)
    -> (RetryStatus -> Eff es a)
    -> Eff es a
retryOnError policy chk f = go defaultRetryStatus
  where
    go stat = do
-}