retry (empty) → 0.1.0.0

raw patch · 4 files changed

+285/−0 lines, 4 filesdep +MonadCatchIO-transformersdep +basedep +data-defaultsetup-changed

Dependencies added: MonadCatchIO-transformers, base, data-default, mtl, syb

Files

LICENSE +30/−0
Setup.hs +2/−0
retry.cabal +38/−0
src/Control/Retry.hs +215/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2013, Ozgun Ataman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ozgun Ataman nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ retry.cabal view

@@ -0,0 +1,38 @@+name:                retry++description: ++        This package exposes combinators that can wrap arbitrary+        monadic actions. They run the action and potentially retry+        running it with some configurable delay for a configurable+        number of times.++        The purpose is to make it easier to work with IO and+        especially network IO actions that often experience temporary+        failure and warrant retrying of the original action. For+        example, a database query may time out for a while, in which+        case we should hang back for a bit and retry the query instead+        of simply raising an exception.++version:             0.1.0.0+synopsis:            Retry combinators for monadic actions that may fail+license:             BSD3+license-file:        LICENSE+author:              Ozgun Ataman+maintainer:          ozgun.ataman@soostone.com+copyright:           Ozgun Ataman, Soostone Inc+category:            Control+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:     Control.Retry+  build-depends:       +    base ==4.*, +    MonadCatchIO-transformers >= 0.3,+    mtl >= 0.2,+    data-default,+    syb >= 0.3+  hs-source-dirs:      src+  default-language:    Haskell2010+

+ src/Control/Retry.hs view

@@ -0,0 +1,215 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Retry+-- Copyright   :  Ozgun Ataman <ozgun.ataman@soostone.com>+-- License     :  BSD3+--+-- Maintainer  :  Ozgun Ataman+-- Stability   :  provisional+--+-- This module exposes combinators that can wrap arbitrary monadic+-- actions. They run the action and potentially retry running it with+-- some configurable delay for a configurable number of times.+--+-- The express purpose of this library is to make it easier to work+-- with IO and especially network IO actions that often experience+-- temporary failure that warrant retrying of the original action. For+-- example, a database query may time out for a while, in which case+-- we should delay a bit and retry the query.+----------------------------------------------------------------------------+++module Control.Retry+    (+      -- * High Level Operation+      RetrySettings (..)+    , retrying+    , recovering+    , recoverAll++    -- * Utilities+    , delay+    , flatDelay+    , backoffDelay+    ) where++-------------------------------------------------------------------------------+import           Control.Concurrent+import           Control.Exception     (SomeException)+import           Control.Monad.CatchIO+import           Control.Monad.Trans+import           Data.Default+import           Data.Generics+import           Prelude               hiding (catch)+-------------------------------------------------------------------------------+++-- | Settings for retry behavior. Simply using 'def' for default+-- values should work in most cases.+data RetrySettings = RetrySettings {+      numRetries :: Int+    -- ^ 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 Default RetrySettings where+    def = RetrySettings 5 True 50+++-- | Delay thread using backoff delay for the nth retry.+backoffDelay :: (Integral b, MonadIO m) => RetrySettings -> b -> m ()+backoffDelay set@RetrySettings{..} !n = liftIO (threadDelay (2^n * delay set))++-- | Delay thread using flat delay+flatDelay :: MonadIO m => RetrySettings -> t -> m ()+flatDelay set@RetrySettings{..} !n = liftIO (threadDelay $ delay set)++-- | Delay in micro seconds+delay :: RetrySettings -> Int+delay RetrySettings{..} = baseDelay * 1000+++-- | 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.+--+-- Let's write a function that always fails and watch this combinator+-- retry it 5 additional times following the initial run:+--+-- >>> import Data.Maybe+-- >>> let f = putStrLn "Running action" >> return Nothing+-- >>> retrying def isNothing f+-- Running action+-- Running action+-- Running action+-- Running action+-- Running action+-- Running action+-- Nothing+--+-- 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.+         -> m b+         -- ^ Action to run+         -> m b+retrying set@RetrySettings{..} chk f = go 0+    where+      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+            False -> return res++++-- | Retry ALL exceptions that may be raised. To be used with caution;+-- this matches the exception on 'SomeException'.+--+-- See how the action below is run once and retried 5 more times+-- before finally failing for good:+--+-- >>> let f = putStrLn "Running action" >> error "this is an error"+-- >>> recoverAll def f+-- Running action+-- Running action+-- Running action+-- Running action+-- Running action+-- Running action+-- *** Exception: this is an error+recoverAll :: MonadCatchIO m+         => RetrySettings+         -> m a+         -> m a+recoverAll set f = recovering set [h] f+    where+      h = Handler $ \ (e :: 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. MonadCatchIO m+           => RetrySettings+           -- ^ Just use 'def' faor default settings+           -> [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+    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 n >= numRetries of+                True -> throw e+                False -> do+                    if backoff+                      then backoffDelay set n+                      else flatDelay set n+                    go $! n+1+            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++++                              ------------------+                              -- Simple Tests --+                              ------------------++++-- data TestException = TestException deriving (Show, Typeable)+-- data AnotherException = AnotherException deriving (Show, Typeable)++-- instance Exception TestException+-- instance Exception AnotherException+++-- test = retrying def [h1,h2] f+--     where+--       f = putStrLn "Running action" >> throw AnotherException+--       h1 = Handler $ \ (e :: TestException) -> return False+--       h2 = Handler $ \ (e :: AnotherException) -> return True++