retry 0.7.0.1 → 0.7.1

raw patch · 3 files changed

+122/−36 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog.md +7/−0
• retry.cabal +1/−1
• src/Control/Retry.hs +114/−35

@@ -1,3 +1,10 @@+0.7.1+* Various documentation updates.+* Add stepping combinator for manual retries.+* Add applyPolicy and applyAndDelay+* Add Read instance for RetryStatus+* Fix logic bug in rsPreviousDelay in first retry+ 0.7.0.1 * Officially drop support for GHC < 7.6 due to usage of Generics. 

@@ -14,7 +14,7 @@         case we should hang back for a bit and retry the query instead         of simply raising an exception. -version:             0.7.0.1+version:             0.7.1 synopsis:            Retry combinators for monadic actions that may fail license:             BSD3 license-file:        LICENSE

@@ -32,13 +32,12 @@       RetryPolicyM (..)     , RetryPolicy     , retryPolicy-    , RetryStatus-    -- ** Fields for 'RetryStatus'-    , rsIterNumber-    , rsCumulativeDelay-    , rsPreviousDelay+    , RetryStatus (..)     , defaultRetryStatus+    , applyPolicy+    , applyAndDelay +     -- ** Lenses for 'RetryStatus'     , rsIterNumberL     , rsCumulativeDelayL@@ -47,6 +46,7 @@     -- * Applying Retry Policies     , retrying     , recovering+    , stepping     , recoverAll     , logRetries @@ -162,8 +162,8 @@ data RetryStatus = RetryStatus     { rsIterNumber      :: !Int -- ^ Iteration number, where 0 is the first try     , rsCumulativeDelay :: !Int -- ^ Delay incurred so far from retries in microseconds-    , rsPreviousDelay   :: !(Maybe Int) -- ^ Previous attempt's delay. Will always be Nothing on first run.-    } deriving (Show, Eq, Generic)+    , rsPreviousDelay   :: !(Maybe Int) -- ^ Latest attempt's delay. Will always be Nothing on first run.+    } deriving (Read, Show, Eq, Generic)   -------------------------------------------------------------------------------@@ -190,7 +190,46 @@ {-# INLINE rsPreviousDelayL #-}  + -------------------------------------------------------------------------------+-- | Apply policy on status to see what the decision would be.+-- 'Nothing' implies no retry, 'Just' returns updated status.+applyPolicy +    :: Monad m +    => RetryPolicyM m +    -> RetryStatus +    -> m (Maybe RetryStatus)+applyPolicy (RetryPolicyM policy) s = do+    res <- policy s+    case res of+      Just delay -> return $! Just $! RetryStatus +          { rsIterNumber = rsIterNumber s + 1+          , rsCumulativeDelay = rsCumulativeDelay s + delay+          , rsPreviousDelay = Just delay }+      Nothing -> return Nothing+++-------------------------------------------------------------------------------+-- | Apply policy and delay by its amount if it results in a retry.+-- Return updated status.+applyAndDelay+    :: MonadIO m +    => RetryPolicyM m +    -> RetryStatus +    -> m (Maybe RetryStatus)+applyAndDelay policy s = do+    chk <- applyPolicy policy s+    case chk of+      Just rs -> do+        case (rsPreviousDelay rs) of+          Nothing -> return ()+          Just delay -> liftIO $ threadDelay delay+        return (Just rs)+      Nothing -> return Nothing++    ++------------------------------------------------------------------------------- -- | Helper for making simplified policies that don't use the monadic -- context. retryPolicy :: (RetryStatus -> Maybe Int) -> RetryPolicy@@ -314,21 +353,17 @@           -> (RetryStatus -> m b)           -- ^ Action to run           -> m b-retrying (RetryPolicyM policy) chk f = go defaultRetryStatus+retrying policy chk f = go defaultRetryStatus   where     go s = do         res <- f s         chk' <- chk s res         case chk' of           True -> do-            chk <- policy s-            case chk of-              Just delay -> do-                liftIO (threadDelay delay)-                go $! RetryStatus { rsIterNumber = rsIterNumber s + 1-                                  , rsCumulativeDelay = rsCumulativeDelay s + delay-                                  , rsPreviousDelay = Just (maybe 0 (const delay) (rsPreviousDelay s))}+            rs <- applyAndDelay policy s+            case rs of               Nothing -> return res+              Just rs' -> go $! rs'           False -> return res  @@ -386,21 +421,21 @@ -- 'recoverAll' recovering #if MIN_VERSION_exceptions(0, 6, 0)-           :: (MonadIO m, MonadMask m)+    :: (MonadIO m, MonadMask m) #else-           :: (MonadIO m, MonadCatch m)+    :: (MonadIO m, MonadCatch m) #endif-           => RetryPolicyM m-           -- ^ Just use 'def' for default settings-           -> [(RetryStatus -> Handler m Bool)]-           -- ^ Should a given exception be retried? Action will be-           -- retried if this returns True *and* the policy allows it.-           -- This action will be consulted first even if the policy-           -- later blocks it.-           -> (RetryStatus -> m a)-           -- ^ Action to perform-           -> m a-recovering p@(RetryPolicyM policy) hs f = mask $ \restore -> go restore defaultRetryStatus+    => RetryPolicyM m+    -- ^ Just use 'def' for default settings+    -> [(RetryStatus -> Handler m Bool)]+    -- ^ Should a given exception be retried? Action will be+    -- retried if this returns True *and* the policy allows it.+    -- This action will be consulted first even if the policy+    -- later blocks it.+    -> (RetryStatus -> m a)+    -- ^ Action to perform+    -> m a+recovering policy hs f = mask $ \restore -> go restore defaultRetryStatus     where       go restore = loop         where@@ -416,16 +451,60 @@                     chk <- h e'                     case chk of                       True -> do-                        res <- policy s-                        case res of-                          Just delay -> do-                            liftIO $ threadDelay delay-                            loop $! RetryStatus { rsIterNumber = rsIterNumber s + 1-                                                , rsCumulativeDelay = rsCumulativeDelay s + delay-                                                , rsPreviousDelay = Just (maybe 0 (const delay) (rsPreviousDelay s))}+                        rs <- applyAndDelay policy s+                        case rs of+                          Just rs' -> loop $! rs'                           Nothing -> throwM e'                       False -> throwM e'                 | otherwise = recover e hs'++++-------------------------------------------------------------------------------+-- | A version of 'recovering' that tries to run the action only a+-- single time. The control will return immediately upon both success+-- and failure. Useful for implementing retry logic in distributed+-- queues and similar external-interfacing systems.+stepping+#if MIN_VERSION_exceptions(0, 6, 0)+    :: (MonadIO m, MonadMask m)+#else+    :: (MonadIO m, MonadCatch m)+#endif+    => RetryPolicyM m+    -- ^ Just use 'def' for default settings+    -> [(RetryStatus -> Handler m Bool)]+    -- ^ Should a given exception be retried? Action will be+    -- retried if this returns True *and* the policy allows it.+    -- This action will be consulted first even if the policy+    -- later blocks it.+    -> (RetryStatus -> m ())+    -- ^ Action to run with updated status upon failure.+    -> (RetryStatus -> m a)+    -- ^ Main action to perform with current status.+    -> RetryStatus+    -- ^ Current status of this step+    -> m (Maybe a)+stepping policy hs schedule f s = do+    r <- try $ f s+    case r of+      Right x -> return $ Just x+      Left e -> recover (e :: SomeException) hs+    where+      recover e [] = throwM e+      recover e ((($ s) -> Handler h) : hs')+        | Just e' <- fromException e = do+            chk <- h e'+            case chk of+              True -> do                +                res <- applyPolicy policy s+                case res of+                  Just rs -> do+                    schedule $! rs+                    return Nothing+                  Nothing -> throwM e'+              False -> throwM e'+        | otherwise = recover e hs'   -------------------------------------------------------------------------------