-- |Description: Action Retrying
module Polysemy.Conc.Retry where

import qualified Polysemy.Time as Time
import Polysemy.Time (Time, TimeUnit)

import Polysemy.Conc.Effect.Race (Race)
import qualified Polysemy.Conc.Effect.Sync as Sync
import Polysemy.Conc.Interpreter.Sync (interpretSync)
import qualified Polysemy.Conc.Race as Race

-- |Run an action repeatedly until it returns 'Right' or the timout has been exceeded.
retrying ::
  ∀ e w u t d r a .
  TimeUnit w =>
  TimeUnit u =>
  Members [Race, Time t d] r =>
  -- |The timeout after which the attempt is abandoned.
  w ->
  -- |The waiting interval between two tries.
  u ->
  Sem r (Either e a) ->
  Sem r (Maybe a)
retrying :: w -> u -> Sem r (Either e a) -> Sem r (Maybe a)
retrying w
timeout u
interval Sem r (Either e a)
action =
  w -> Sem r a -> Sem r (Maybe a)
forall u (r :: [(* -> *) -> * -> *]) a.
(TimeUnit u, Member Race r) =>
u -> Sem r a -> Sem r (Maybe a)
Race.timeoutMaybe w
timeout Sem r a
spin
  where
    spin :: Sem r a
spin =
      Sem r (Either e a)
action Sem r (Either e a) -> (Either e a -> Sem r a) -> Sem r a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
a ->
          a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Left e
_ -> do
          u -> Sem r ()
forall t d (r :: [(* -> *) -> * -> *]) u.
(MemberWithError (Time t d) r, TimeUnit u) =>
u -> Sem r ()
Time.sleep @t @d u
interval
          Sem r a
spin

-- |Run an action repeatedly until it returns 'Right' or the timout has been exceeded.
--
-- If the action failed at least once, the last error will be returned in case of timeout.
retryingWithError ::
  ∀ e w u t d r a .
  TimeUnit w =>
  TimeUnit u =>
  Members [Race, Time t d, Embed IO] r =>
  -- |The timeout after which the attempt is abandoned.
  w ->
  -- |The waiting interval between two tries.
  u ->
  Sem r (Either e a) ->
  Sem r (Maybe (Either e a))
retryingWithError :: w -> u -> Sem r (Either e a) -> Sem r (Maybe (Either e a))
retryingWithError w
timeout u
interval Sem r (Either e a)
action =
  Sem (Sync e : r) (Maybe (Either e a)) -> Sem r (Maybe (Either e a))
forall d (r :: [(* -> *) -> * -> *]).
Members '[Race, Embed IO] r =>
InterpreterFor (Sync d) r
interpretSync @e do
    w -> Sem (Sync e : r) a -> Sem (Sync e : r) (Maybe a)
forall u (r :: [(* -> *) -> * -> *]) a.
(TimeUnit u, Member Race r) =>
u -> Sem r a -> Sem r (Maybe a)
Race.timeoutMaybe w
timeout Sem (Sync e : r) a
spin Sem (Sync e : r) (Maybe a)
-> (Maybe a -> Sem (Sync e : r) (Maybe (Either e a)))
-> Sem (Sync e : r) (Maybe (Either e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
a -> Maybe (Either e a) -> Sem (Sync e : r) (Maybe (Either e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> Maybe (Either e a)
forall a. a -> Maybe a
Just (a -> Either e a
forall a b. b -> Either a b
Right a
a))
      Maybe a
Nothing -> (e -> Either e a) -> Maybe e -> Maybe (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Either e a
forall a b. a -> Either a b
Left (Maybe e -> Maybe (Either e a))
-> Sem (Sync e : r) (Maybe e)
-> Sem (Sync e : r) (Maybe (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Sync e : r) (Maybe e)
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r (Maybe d)
Sync.takeTry
  where
    spin :: Sem (Sync e : r) a
spin =
      Sem r (Either e a) -> Sem (Sync e : r) (Either e a)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise Sem r (Either e a)
action Sem (Sync e : r) (Either e a)
-> (Either e a -> Sem (Sync e : r) a) -> Sem (Sync e : r) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
a ->
          a -> Sem (Sync e : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        Left e
e -> do
          Sem (Sync e : r) (Maybe e) -> Sem (Sync e : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync e) r =>
Sem r (Maybe e)
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
Sem r (Maybe d)
Sync.takeTry @e)
          e -> Sem (Sync e : r) Bool
forall d (r :: [(* -> *) -> * -> *]).
MemberWithError (Sync d) r =>
d -> Sem r Bool
Sync.putTry e
e
          u -> Sem (Sync e : r) ()
forall t d (r :: [(* -> *) -> * -> *]) u.
(MemberWithError (Time t d) r, TimeUnit u) =>
u -> Sem r ()
Time.sleep @t @d u
interval
          Sem (Sync e : r) a
spin