retry 0.5.1 → 0.6
raw patch · 2 files changed
+83/−29 lines, 2 filesdep ~basedep ~exceptionsdep ~hspec
Dependency ranges changed: base, exceptions, hspec
Files
- retry.cabal +4/−4
- src/Control/Retry.hs +79/−25
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.5.1+version: 0.6 synopsis: Retry combinators for monadic actions that may fail license: BSD3 license-file: LICENSE@@ -31,7 +31,7 @@ build-depends: base ==4.* , data-default-class- , exceptions >= 0.5 && < 0.7+ , exceptions >= 0.5 && < 0.9 , transformers < 0.5 hs-source-dirs: src default-language: Haskell2010@@ -44,13 +44,13 @@ ghc-options: -threaded build-depends: base ==4.* - , exceptions >= 0.5 && < 0.6+ , exceptions , transformers , data-default-class , time , QuickCheck >= 2.7 && < 2.8 , HUnit >= 1.2.5.2 && < 1.3- , hspec >= 1.9 && < 1.10+ , hspec >= 1.9 default-language: Haskell2010
src/Control/Retry.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- |@@ -34,12 +36,14 @@ , retrying , recovering , recoverAll+ , logRetries -- * Retry Policies , constantDelay , exponentialBackoff , fibonacciBackoff , limitRetries+ , limitRetriesByDelay , capDelay -- * Re-export from Data.Monoid@@ -60,7 +64,7 @@ ------------------------------------------------------------------------------- -- | A 'RetryPolicy' is a function that takes an iteration number and--- possibly returns a delay in miliseconds. *Nothing* implies we have+-- possibly returns a delay in microseconds. *Nothing* implies we have -- reached the retry limit. -- -- Please note that 'RetryPolicy' is a 'Monoid'. You can collapse@@ -80,7 +84,7 @@ -- One can easily define an exponential backoff policy with a limited -- number of retries: ----- >> limitedBackoff = exponentialBackoff 50 <> limitedRetries 5+-- >> limitedBackoff = exponentialBackoff 50 <> limitRetries 5 -- -- Naturally, 'mempty' will retry immediately (delay 0) for an -- unlimited number of retries, forming the identity for the 'Monoid'.@@ -116,6 +120,20 @@ -------------------------------------------------------------------------------+-- | Add an upperbound to a policy such that once the given time-delay+-- amount has been reached or exceeded, the policy will stop retrying+-- and fail.+limitRetriesByDelay+ :: Int+ -- ^ Time-delay limit in microseconds. + -> RetryPolicy+ -> RetryPolicy+limitRetriesByDelay i p = RetryPolicy $ \ n -> getRetryPolicy p n >>= limit+ where+ limit delay = if delay >= i then Nothing else Just delay+++------------------------------------------------------------------------------- -- | Implement a constant delay with unlimited retries. constantDelay :: Int@@ -146,8 +164,12 @@ ---------------------------------------------------------------------------------- | Set an upperbound for any delays that may be directed by the--- given policy.+-- | Set a time-upperbound for any delays that may be directed by the+-- given policy. This function does not terminate the retrying. The policy+-- `capDelay maxDelay (exponentialBackoff n)` will never stop retrying. It+-- will reach a state where it retries forever with a delay of `maxDelay`+-- between each one. To get termination you need to use one of the+-- 'limitRetries' function variants. capDelay :: Int -- ^ A maximum delay in microseconds@@ -166,7 +188,7 @@ -- -- >>> import Data.Maybe -- >>> let f = putStrLn "Running action" >> return Nothing--- >>> retrying def isNothing f+-- >>> retrying def (const $ return . isNothing) f -- Running action -- Running action -- Running action@@ -217,7 +239,12 @@ -- Running action -- Running action -- *** Exception: this is an error-recoverAll :: (MonadIO m, MonadCatch m)+recoverAll+#if MIN_VERSION_exceptions(0, 6, 0)+ :: (MonadIO m, MonadMask m)+#else+ :: (MonadIO m, MonadCatch m)+#endif => RetryPolicy -> m a -> m a@@ -229,35 +256,62 @@ ------------------------------------------------------------------------------- -- | 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)+recovering+#if MIN_VERSION_exceptions(0, 6, 0)+ :: (MonadIO m, MonadMask m)+#else+ :: (MonadIO m, MonadCatch m)+#endif => RetryPolicy- -- ^ Just use 'def' faor default settings+ -- ^ Just use 'def' for default settings -> [(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 (RetryPolicy policy) hs f = go 0+recovering (RetryPolicy policy) hs f = mask $ \restore -> go restore 0 where-- -- | 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- transHandler n (Handler h) = Handler $ \ e -> do- chk <- h e- case chk of- True ->- 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 . ($ n)) hs+ go restore = loop+ where+ loop n = do+ r <- try $ restore f+ case r of+ Right x -> return x+ Left e -> recover (e :: SomeException) hs+ where+ recover e [] = throwM e+ recover e ((($ n) -> Handler h) : hs')+ | Just e' <- fromException e = do+ chk <- h e'+ if chk+ then case policy n of+ Just delay -> do+ liftIO $ threadDelay delay+ loop $! n+1+ Nothing -> throwM e'+ else throwM e'+ | otherwise = recover e hs' +-------------------------------------------------------------------------------+-- | Helper function for constructing handler functions of the form required+-- by 'recovering'.+logRetries+ :: (Monad m, Show e, Exception e)+ => (e -> m Bool)+ -- ^ Test for whether action is to be retried+ -> (String -> m ())+ -- ^ How to report the generated warning message.+ -> Int+ -- ^ Retry number+ -> Handler m Bool+logRetries f report n = Handler $ \ e -> do+ res <- f e+ let msg = "[retry:" <> show n <> "] Encountered " <> show e <> ". " <>+ if res then "Retrying." else "Crashing."+ report msg+ return res ------------------