retry 0.1.0.1 → 0.2.0.0

raw patch · 2 files changed

+47/−27 lines, 2 files

Files

• retry.cabal +1/−1
• src/Control/Retry.hs +46/−26

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

@@ -28,12 +28,17 @@     (       -- * High Level Operation       RetrySettings (..)+    , RetryLimit+    , limitedRetries+    , unlimitedRetries+     , retrying     , recovering     , recoverAll      -- * Utilities     , delay+    , performDelay     , flatDelay     , backoffDelay     ) where@@ -48,10 +53,26 @@ -------------------------------------------------------------------------------  +data RetryLimit = RLimit Int+                | RNoLimit+++-- | Set a limited number of retries. Default in 'def' is 5.+limitedRetries :: Int -> RetryLimit+limitedRetries = RLimit+++-- | Set an unlimited number of retries. Note that with this option+-- turned on, the combinator will keep retrying the action+-- indefinitely and might essentially hang in some cases.+unlimitedRetries :: RetryLimit+unlimitedRetries = RNoLimit++ -- | Settings for retry behavior. Simply using 'def' for default -- values should work in most cases. data RetrySettings = RetrySettings {-      numRetries :: Int+      numRetries :: RetryLimit     -- ^ Number of retries. Defaults to 5.     , backoff    :: Bool     -- ^ Whether to implement exponential backoff in retries. Defaults@@ -64,7 +85,7 @@   instance Default RetrySettings where-    def = RetrySettings 5 True 50+    def = RetrySettings (limitedRetries 5) True 50   -- | Delay thread using backoff delay for the nth retry.@@ -110,17 +131,17 @@          -> m b retrying set@RetrySettings{..} chk f = go 0     where+      retry n = do+          performDelay set n+          go $! n+1+       go n = do           res <- f           case chk res of             True ->-              case n >= numRetries of-                True -> return res-                False -> do-                    if backoff-                      then backoffDelay set n-                      else flatDelay set n-                    go $! n+1+              case numRetries of+                RNoLimit -> retry n+                RLimit lim -> if n >= lim then return res else retry n             False -> return res  @@ -149,6 +170,14 @@       h = Handler $ \ (e :: SomeException) -> return True  +-- | Perform 'threadDelay' for the nth retry for the given settings.+performDelay :: MonadIO m => RetrySettings -> Int -> m ()+performDelay set@RetrySettings{..} n =+    if backoff+      then backoffDelay set n+      else flatDelay set n++ -- | Run an action and recover from a raised exception by potentially -- retrying the action a number of times. recovering :: forall m a. MonadCatchIO m@@ -162,6 +191,11 @@            -> m a recovering set@RetrySettings{..} hs f = go 0     where+      retry n = do+          performDelay set n+          go $! n+1++       -- | Convert a (e -> m Bool) handler into (e -> m a) so it can       -- be wired into the 'catches' combinator.       transHandler :: Int -> Handler m Bool -> Handler m a@@ -169,24 +203,10 @@           chk <- h e           case chk of             True ->-              case n >= numRetries of-                True -> throw e-                False -> do-                    if backoff-                      then backoffDelay set n-                      else flatDelay set n-                    go $! n+1+              case numRetries of+                RNoLimit -> retry n+                RLimit lim -> if n >= lim then throw e else retry n             False -> throw e--      -- handle :: forall e. Exception e => Handler m Bool -> Int -> e -> m a-      -- handle (Handler h) n e = do-      --     chk <- h e-      --     case chk of-      --       True ->-      --         case n >= numRetries of-      --           True -> throw e-      --           False -> if backoff then backoffRetry n else flatRetry n-      --       False -> throw e        go n = f `catches` map (transHandler n) hs