retry 0.4 → 0.5
raw patch · 3 files changed
+141/−96 lines, 3 filesdep +HUnitdep +QuickCheckdep +data-default-classdep −data-defaultdep ~exceptionsdep ~transformers
Dependencies added: HUnit, QuickCheck, data-default-class, hspec, time
Dependencies removed: data-default
Dependency ranges changed: exceptions, transformers
Files
- retry.cabal +26/−5
- src/Control/Retry.hs +113/−91
- test/main.hs +2/−0
retry.cabal view
@@ -14,7 +14,7 @@ case we should hang back for a bit and retry the query instead of simply raising an exception. -version: 0.4+version: 0.5 synopsis: Retry combinators for monadic actions that may fail license: BSD3 license-file: LICENSE@@ -29,10 +29,31 @@ library exposed-modules: Control.Retry build-depends: - base ==4.*, - exceptions >= 0.5 && < 0.6,- transformers,- data-default+ base ==4.*+ , data-default-class+ , exceptions >= 0.5 && < 0.7+ , transformers < 0.5 hs-source-dirs: src default-language: Haskell2010 ++test-suite test+ type: exitcode-stdio-1.0+ main-is: main.hs+ hs-source-dirs: test,src+ ghc-options: -threaded+ build-depends: + base ==4.* + , exceptions >= 0.5 && < 0.6+ , transformers+ , data-default-class+ , time+ , QuickCheck >= 2.7 && < 2.8+ , HUnit >= 1.2.5.2 && < 1.3+ , hspec >= 1.9 && < 1.10+ default-language: Haskell2010+++++
src/Control/Retry.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}@@ -30,91 +29,122 @@ module Control.Retry ( -- * High Level Operation- RetrySettings (..)- , RetryLimit(..)- , limitedRetries- , unlimitedRetries+ RetryPolicy (..) , retrying , recovering , recoverAll - -- * Utilities- , delay- , performDelay- , flatDelay- , backoffDelay- , backoffDelayFor+ -- * Retry Policies+ , constantDelay+ , exponentialBackoff+ , fibonacciBackoff+ , limitRetries++ -- * Re-export from Data.Monoid++ , (<>)+ ) where ------------------------------------------------------------------------------- import Control.Concurrent import Control.Monad.Catch import Control.Monad.IO.Class-import Data.Default+import Data.Default.Class+import Data.Monoid import Prelude hiding (catch) ------------------------------------------------------------------------------- -data RetryLimit = RLimit Int- | RNoLimit----- | Set a limited number of retries. Default in 'def' is 5.-limitedRetries :: Int -> RetryLimit-limitedRetries = RLimit+-------------------------------------------------------------------------------+-- | A 'RetryPolicy' is a function that takes an iteration number and+-- possibly returns a delay in miliseconds. *Nothing* implies we have+-- reached the retry limit.+--+-- Please note that 'RetryPolicy' is a 'Monoid'. You can collapse+-- multiple strategies into one using 'mappend' or '<>'. The semantics+-- of this combination are as follows:+--+-- 1. If either policy returns 'Nothing', the combined policy returns+-- 'Nothing'. This can be used to @inhibit@ after a number of retries,+-- for example.+--+-- 2. If both policies return a delay, the larger delay will be used.+-- This is quite natural when combining multiple policies to achieve a+-- certain effect.+--+-- Example:+--+-- One can easily define an exponential backoff policy with a limited+-- number of retries:+--+-- >> limitedBackoff = exponentialBackoff 50 <> limitedRetries 5+--+-- Naturally, 'mempty' will retry immediately (delay 0) for an+-- unlimited number of retries, forming the identity for the 'Monoid'.+--+-- The default under 'def' implements a constant 50ms delay, up to 5 times:+--+-- >> def = constantDelay 50000 <> limitRetries 5+--+-- For anything more complex, just define your own 'RetryPolicy':+--+-- >> myPolicy = RetryPolicy $ \ n -> if n > 10 then Just 1000 else Just 10000+newtype RetryPolicy = RetryPolicy { getRetryPolicy :: Int -> Maybe Int } --- | 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-+instance Default RetryPolicy where+ def = constantDelay 50000 <> limitRetries 5 --- | Settings for retry behavior. Simply using 'def' for default--- values should work in most cases.-data RetrySettings = RetrySettings {- numRetries :: RetryLimit- -- ^ Number of retries. Defaults to 5.- , backoff :: Bool- -- ^ Whether to implement exponential backoff in retries. Defaults- -- to True.- , baseDelay :: Int- -- ^ The base delay in miliseconds. Defaults to 50. Without- -- 'backoff', this is the delay. With 'backoff', this base delay- -- will grow by a factor of 2 on each subsequent retry.- }+instance Monoid RetryPolicy where+ mempty = RetryPolicy $ (const (Just 0))+ (RetryPolicy a) `mappend` (RetryPolicy b) = RetryPolicy $ \ n -> do+ a' <- a n+ b' <- b n+ return $! max a' b' -instance Default RetrySettings where- def = RetrySettings (limitedRetries 5) True 50+-------------------------------------------------------------------------------+-- | Retry immediately, but only up to @n@ times.+limitRetries+ :: Int+ -- ^ Maximum number of retries.+ -> RetryPolicy+limitRetries i = RetryPolicy $ \ n -> if n >= i then Nothing else (Just 0) --- | Delay thread using backoff delay for the nth retry.-backoffDelay :: MonadIO m => RetrySettings -> Int -> m ()-backoffDelay set !n = liftIO . threadDelay $ backoffDelayFor (delay set) n+-------------------------------------------------------------------------------+-- | Implement a constant delay with unlimited retries.+constantDelay+ :: Int+ -- ^ Base delay in microseconds+ -> RetryPolicy+constantDelay delay = RetryPolicy (const (Just delay)) --- | Delay for nth iteration of exponential backoff, in microseconds-backoffDelayFor+-------------------------------------------------------------------------------+-- | Grow delay exponentially each iteration.+exponentialBackoff :: Int -- ^ Base delay in microseconds- -> Int- -- ^ Iteration number, starting at 0.- -> Int-backoffDelayFor base n = 2^n * base+ -> RetryPolicy+exponentialBackoff base = RetryPolicy $ \ n -> Just (2^n * base) --- | Delay thread using flat delay-flatDelay :: MonadIO m => RetrySettings -> t -> m ()-flatDelay set@RetrySettings{..} !_ = liftIO (threadDelay $ delay set)---- | Delay in micro seconds-delay :: RetrySettings -> Int-delay RetrySettings{..} = baseDelay * 1000+-------------------------------------------------------------------------------+-- | Implement Fibonacci backoff.+fibonacciBackoff+ :: Int+ -- ^ Base delay in microseconds+ -> RetryPolicy+fibonacciBackoff base = RetryPolicy $ \ n -> Just $ fib (n + 1) (0, base)+ where+ fib 0 (a, _) = a+ fib !m (!a, !b) = fib (m-1) (b, a + b) +------------------------------------------------------------------------------- -- | Retry combinator for actions that don't raise exceptions, but -- signal in their type the outcome has failed. Examples are the -- 'Maybe', 'Either' and 'EitherT' monads.@@ -136,30 +166,30 @@ -- Note how the latest failing result is returned after all retries -- have been exhausted. retrying :: MonadIO m- => RetrySettings- -> (b -> Bool)- -- ^ A function to check whether the result should be- -- retried. If True, we delay and retry the operation.+ => RetryPolicy+ -> (Int -> b -> m Bool)+ -- ^ An action to check whether the result should be retried.+ -- If True, we delay and retry the operation. -> m b -- ^ Action to run -> m b-retrying set@RetrySettings{..} chk f = go 0+retrying (RetryPolicy policy) chk f = go 0 where- retry n = do- performDelay set n- go $! n+1- go n = do res <- f- case chk res of+ chk' <- chk n res+ case chk' of True ->- case numRetries of- RNoLimit -> retry n- RLimit lim -> if n >= lim then return res else retry n+ case (policy n) of+ Just delay -> do+ liftIO (threadDelay delay)+ go $! n+1+ Nothing -> return res False -> return res +------------------------------------------------------------------------------- -- | Retry ALL exceptions that may be raised. To be used with caution; -- this matches the exception on 'SomeException'. --@@ -176,40 +206,29 @@ -- Running action -- *** Exception: this is an error recoverAll :: (MonadIO m, MonadCatch m)- => RetrySettings+ => RetryPolicy -> m a -> m a recoverAll set f = recovering set [h] f where- h = Handler $ \ (_ :: 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+ h _ = Handler $ \ (_ :: SomeException) -> return True +------------------------------------------------------------------------------- -- | Run an action and recover from a raised exception by potentially -- retrying the action a number of times. recovering :: forall m a. (MonadIO m, MonadCatch m)- => RetrySettings+ => RetryPolicy -- ^ Just use 'def' faor default settings- -> [Handler m Bool]+ -> [(Int -> Handler m Bool)] -- ^ Should a given exception be retried? Action will be -- retried if this returns True. -> m a -- ^ Action to perform -> m a-recovering set@RetrySettings{..} hs f = go 0+recovering (RetryPolicy policy) 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@@ -217,15 +236,18 @@ chk <- h e case chk of True ->- case numRetries of- RNoLimit -> retry n- RLimit lim -> if n >= lim then throwM e else retry n+ case policy n of+ Just delay -> do+ liftIO (threadDelay delay)+ go $! n+1+ Nothing -> throwM e False -> throwM e - go n = f `catches` map (transHandler n) hs+ go n = f `catches` map (transHandler n . ($ n)) hs + ------------------ -- Simple Tests -- ------------------@@ -241,6 +263,6 @@ -- test = retrying def [h1,h2] f -- where--- f = putStrLn "Running action" >> throw AnotherException+-- f = putStrLn "Running action" >> throwM AnotherException -- h1 = Handler $ \ (e :: TestException) -> return False -- h2 = Handler $ \ (e :: AnotherException) -> return True
+ test/main.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+