Permalink
Browse files

Add retrying combinator

  • Loading branch information...
1 parent 0fc39f2 commit 8e1108be5b1fc54a9d36995c3208c3d0896fd7f6 @ozataman ozataman committed Feb 21, 2013
Showing with 80 additions and 1 deletion.
  1. +3 −1 cassy.cabal
  2. +5 −0 src/Database/Cassandra/Marshall.hs
  3. +72 −0 src/Database/Cassandra/Retry.hs
View
@@ -58,6 +58,7 @@ Library
Database.Cassandra.Pool
Database.Cassandra.Types
Database.Cassandra.Pack
+ Database.Cassandra.Retry
Build-depends:
base >= 4 && < 5
@@ -80,7 +81,7 @@ Library
, data-default
, async
, errors
-
+ , MonadCatchIO-transformers >= 0.3
test-suite test
type: exitcode-stdio-1.0
@@ -107,6 +108,7 @@ test-suite test
, resource-pool
, data-default
, errors
+ , MonadCatchIO-transformers >= 0.3
, test-framework >= 0.6
, test-framework-quickcheck2 >= 0.2.12.2
@@ -65,6 +65,10 @@ module Database.Cassandra.Marshall
, modify_
, delete
+ -- * Retrying Queries
+ , RetrySettings (..)
+ , retrying
+
-- * Necessary Types
, ColumnName
, ModifyOperation (..)
@@ -119,6 +123,7 @@ import Database.Cassandra.Basic hiding (KeySelector (..), delete,
get, getCol, getMulti)
import qualified Database.Cassandra.Basic as CB
import Database.Cassandra.Pack
+import Database.Cassandra.Retry
import Database.Cassandra.Types
-------------------------------------------------------------------------------
@@ -0,0 +1,72 @@
+{-# LANGUAGE RecordWildCards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Database.Cassandra.Retry
+-- Copyright : Ozgun Ataman <ozataman@gmail.com>
+-- License : BSD3
+--
+-- Maintainer : Ozgun Ataman
+-- Stability : experimental
+--
+-- Utilites for working with Cassandra
+----------------------------------------------------------------------------
+
+
+module Database.Cassandra.Retry where
+
+
+-------------------------------------------------------------------------------
+import Control.Concurrent
+import Control.Monad.CatchIO
+import Control.Monad.Trans
+import Data.Default
+-------------------------------------------------------------------------------
+
+
+-- | Settings for retry behavior. Just 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 powers of 2 on each subsequent retry.
+ }
+
+
+instance Default RetrySettings where
+ def = RetrySettings 5 True 50
+
+
+-- | A flexible action retrying combinator.
+retrying :: (Functor m, Exception e, MonadCatchIO m)
+ => RetrySettings
+ -- ^ For default settings, just use 'def'
+ -> (e -> Bool)
+ -- ^ Should a given exception be retried?
+ -> m b
+ -- ^ Action to perform
+ -> m b
+retrying RetrySettings{..} h f = go 0
+ where
+ delay = baseDelay * 1000
+ backoffRetry n = liftIO (threadDelay (2^n * delay)) >> go (n+1)
+ flatRetry n = liftIO (threadDelay delay) >> go (n+1)
+ go n = do
+ res <- try f
+ case res of
+ Right a -> return a
+ Left e ->
+ case h e of
+ True ->
+ case n >= numRetries of
+ True -> throw e
+ False -> if backoff then backoffRetry n else flatRetry n
+ False -> throw e
+
+
+

0 comments on commit 8e1108b

Please sign in to comment.