Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Pull retry functionality out into a separate package

  • Loading branch information...
commit 5fb1026f10ad21168b0410b0e91fa31f9112028f 1 parent e50f619
@ozataman ozataman authored
View
3  cassy.cabal
@@ -58,7 +58,6 @@ Library
Database.Cassandra.Pool
Database.Cassandra.Types
Database.Cassandra.Pack
- Database.Cassandra.Retry
Build-depends:
base >= 4 && < 5
@@ -82,6 +81,7 @@ Library
, async
, errors
, MonadCatchIO-transformers >= 0.3
+ , retry
test-suite test
type: exitcode-stdio-1.0
@@ -109,6 +109,7 @@ test-suite test
, data-default
, errors
, MonadCatchIO-transformers >= 0.3
+ , retry
, test-framework >= 0.6
, test-framework-quickcheck2 >= 0.2.12.2
View
6 src/Database/Cassandra/Basic.hs
@@ -35,8 +35,6 @@ module Database.Cassandra.Basic
, delete
-- * Retrying Queries
- , R.RetrySettings (..)
- , R.retrying
, retryCas
, casRetryH
, networkRetryH
@@ -96,6 +94,7 @@ import Control.Exception
import Control.Monad
import qualified Control.Monad.CatchIO as MCIO
import Control.Monad.Reader
+import Control.Retry as R
import Data.ByteString.Lazy (ByteString)
import Data.Map (Map)
import qualified Data.Map as M
@@ -109,7 +108,6 @@ import Prelude hiding (catch)
-------------------------------------------------------------------------------
import Database.Cassandra.Pack
import Database.Cassandra.Pool
-import qualified Database.Cassandra.Retry as R
import Database.Cassandra.Types
-------------------------------------------------------------------------------
@@ -392,4 +390,4 @@ retryCas :: MCIO.MonadCatchIO m
-> m a
-- ^ Action to perform
-> m a
-retryCas set f = R.retrying set [casRetryH, networkRetryH] f
+retryCas set f = R.recovering set [casRetryH, networkRetryH] f
View
4 src/Database/Cassandra/Marshall.hs
@@ -66,8 +66,6 @@ module Database.Cassandra.Marshall
, delete
-- * Retrying Queries
- , R.RetrySettings (..)
- , R.retrying
, CB.retryCas
, casRetryH
@@ -107,6 +105,7 @@ module Database.Cassandra.Marshall
import Control.Error
import Control.Exception
import Control.Monad
+import Control.Retry as R
import qualified Data.Aeson as A
import qualified Data.Attoparsec as Atto (IResult (..), parse)
import qualified Data.Binary as BN
@@ -125,7 +124,6 @@ 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 as R
import Database.Cassandra.Types
-------------------------------------------------------------------------------
View
123 src/Database/Cassandra/Retry.hs
@@ -1,123 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
------------------------------------------------------------------------------
--- |
--- 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.Exception (SomeException)
-import Control.Monad.CatchIO
-import Control.Monad.Trans
-import Data.Default
-import Data.Generics
-import Prelude hiding (catch)
--------------------------------------------------------------------------------
-
-
--- | 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
-
-
--- | Retry ALL exceptions that may be raised. To be used with caution.
-retryAll :: MonadCatchIO m
- => RetrySettings
- -> m a
- -> m a
-retryAll set f = retrying set [h] f
- where
- h = Handler $ \ (e :: SomeException) -> return True
-
-
--- | A flexible action retrying combinator.
-retrying :: forall m a. MonadCatchIO m
- => RetrySettings
- -- ^ For default settings, just use 'def'
- -> [Handler m Bool]
- -- ^ Should a given exception be retried? Action will be
- -- retried if this returns True.
- -> m a
- -- ^ Action to perform
- -> m a
-retrying RetrySettings{..} hs 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)
-
-
- -- | 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 -> if backoff then backoffRetry n else flatRetry 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
-
-
-
- ------------------
- -- 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
-
-
Please sign in to comment.
Something went wrong with that request. Please try again.