diff --git a/cassy.cabal b/cassy.cabal --- a/cassy.cabal +++ b/cassy.cabal @@ -1,5 +1,5 @@ Name: cassy -Version: 0.6 +Version: 0.7.1 Synopsis: A high level driver for the Cassandra datastore License: BSD3 License-file: LICENSE @@ -56,11 +56,10 @@ -- Extra-source-files: -Cabal-version: >=1.8 - - +Cabal-version: >= 1.16 Library + default-language: Haskell2010 hs-source-dirs: src Exposed-modules: Database.Cassandra.Basic @@ -71,62 +70,47 @@ Database.Cassandra.Pack Build-depends: - base >= 4 && < 5 - , bytestring + base >= 4 && < 5 + , Thrift >= 0.6 + , aeson + , async + , attoparsec >= 0.10 && < 0.13 , binary + , bytestring + , cassandra-thrift >= 0.8 , cereal - , safecopy + , conduit >= 1.1 && < 1.2 , containers - , network - , time + , data-default + , errors + , exceptions , mtl + , network + , resource-pool + , retry >= 0.5 && < 0.6 + , safecopy , stm , syb , text - , attoparsec >= 0.10 && < 0.11 - , aeson - , Thrift >= 0.6 - , cassandra-thrift >= 0.8 - , resource-pool - , data-default - , async - , errors - , monad-control + , time , transformers-base - , lifted-base - , retry >= 0.3 - , conduit >= 0.5 test-suite test type: exitcode-stdio-1.0 main-is: Test.hs ghc-options: -Wall - hs-source-dirs: test src + hs-source-dirs: test Build-depends: base >= 4 && < 5 + , cassy , bytestring - , binary - , cereal - , safecopy - , containers + , text + , Thrift , network + , cassandra-thrift , time - , mtl - , stm - , syb - , text - , attoparsec >= 0.10 && < 0.11 - , aeson - , Thrift >= 0.6 - , cassandra-thrift >= 0.8 - , resource-pool - , data-default - , errors - , monad-control - , transformers-base - , lifted-base - , retry >= 0.3 + , containers , test-framework >= 0.6 , test-framework-quickcheck2 >= 0.2.12.2 diff --git a/src/Database/Cassandra/Basic.hs b/src/Database/Cassandra/Basic.hs --- a/src/Database/Cassandra/Basic.hs +++ b/src/Database/Cassandra/Basic.hs @@ -95,10 +95,9 @@ ------------------------------------------------------------------------------- import Control.Applicative import Control.Concurrent.Async -import Control.Exception.Lifted as E import Control.Monad +import Control.Monad.Catch import Control.Monad.Reader -import Control.Monad.Trans.Control import Control.Retry as R import Data.ByteString.Lazy (ByteString) import Data.Map (Map) @@ -361,16 +360,16 @@ wrapException a = f where f = a - `catch` (\ (T.NotFoundException) -> throw NotFoundException) + `catch` (\ (T.NotFoundException) -> throwM NotFoundException) `catch` (\ (T.InvalidRequestException e) -> - throw . InvalidRequestException $ maybe "" id e) - `catch` (\ T.UnavailableException -> throw UnavailableException) - `catch` (\ T.TimedOutException -> throw TimedOutException) + throwM . InvalidRequestException $ maybe "" id e) + `catch` (\ T.UnavailableException -> throwM UnavailableException) + `catch` (\ T.TimedOutException -> throwM TimedOutException) `catch` (\ (T.AuthenticationException e) -> - throw . AuthenticationException $ maybe "" id e) + throwM . AuthenticationException $ maybe "" id e) `catch` (\ (T.AuthorizationException e) -> - throw . AuthorizationException $ maybe "" id e) - `catch` (\ T.SchemaDisagreementException -> throw SchemaDisagreementException) + throwM . AuthorizationException $ maybe "" id e) + `catch` (\ T.SchemaDisagreementException -> throwM SchemaDisagreementException) ------------------------------------------------------------------------------- @@ -379,7 +378,7 @@ throwing f = do res <- f case res of - Left e -> throw e + Left e -> throwM e Right a -> return a @@ -388,8 +387,8 @@ -- -- 'UnavailableException', 'TimedOutException' and -- 'SchemaDisagreementException' will be automatically retried. -retryCas :: (MonadBaseControl IO m, MonadIO m) - => R.RetrySettings +retryCas :: (MonadCatch m, MonadIO m) + => RetryPolicy -- ^ For default settings, just use 'def' -> m a -- ^ Action to perform diff --git a/src/Database/Cassandra/Marshall.hs b/src/Database/Cassandra/Marshall.hs --- a/src/Database/Cassandra/Marshall.hs +++ b/src/Database/Cassandra/Marshall.hs @@ -107,30 +107,25 @@ ------------------------------------------------------------------------------- import Control.Error -import Control.Exception.Lifted as E import Control.Monad +import Control.Monad.Catch import Control.Monad.Trans -import Control.Monad.Trans.Control -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 -import qualified Data.Binary.Get as BN -import qualified Data.ByteString.Char8 as B -import Data.ByteString.Lazy.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as LB +import Control.Retry as R +import qualified Data.Aeson as A +import Data.ByteString.Lazy.Char8 (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LB import Data.Conduit -import qualified Data.Conduit.List as C -import Data.Int (Int32) -import Data.Map (Map) -import qualified Data.Map as M -import qualified Data.SafeCopy as SC -import qualified Data.Serialize as SL -import Prelude hiding (catch) +import qualified Data.Conduit.List as C +import Data.Int (Int32) +import Data.Map (Map) +import qualified Data.Map as M +import qualified Data.SafeCopy as SC +import qualified Data.Serialize as SL +import Prelude ------------------------------------------------------------------------------- -import Database.Cassandra.Basic hiding (KeySelector (..), delete, - get, getCol, getMulti) -import qualified Database.Cassandra.Basic as CB +import Database.Cassandra.Basic hiding (KeySelector (..), delete, + get, getCol, getMulti) +import qualified Database.Cassandra.Basic as CB import Database.Cassandra.Pack import Database.Cassandra.Types ------------------------------------------------------------------------------- @@ -203,7 +198,7 @@ -- This method may throw a 'CassandraException' for all exceptions other than -- 'NotFoundException'. modify - :: (MonadCassandra m, CasType k) + :: (MonadCassandra m, MonadThrow m, CasType k) => Marshall a -- ^ A serialization methodology. Example: 'casJSON' -> ColumnFamily @@ -234,7 +229,7 @@ case res of Nothing -> execF Nothing Just Column{..} -> execF (hush $ marshallDecode colVal) - Just SuperColumn{..} -> throw $ + Just SuperColumn{..} -> throwM $ OperationNotSupported "modify not implemented for SuperColumn" @@ -244,7 +239,7 @@ -- This method may throw a 'CassandraException' for all exceptions other than -- 'NotFoundException'. modify_ - :: (MonadCassandra m, CasType k) + :: (MonadCassandra m, CasType k, MonadThrow m) => Marshall a -> ColumnFamily -> RowKey @@ -422,7 +417,7 @@ -- given 'Selector'. The 'Selector' must be a 'Range' selector, or -- else this funtion will raise an exception. paginate - :: (MonadCassandra m, MonadBaseControl IO m, CasType k) + :: (MonadCassandra m, MonadCatch m, CasType k) => Marshall a -- ^ Serialization strategy -> ColumnFamily @@ -431,10 +426,10 @@ -> Selector -- ^ 'Range' selector to initially and repeatedly apply. -> ConsistencyLevel - -> RetrySettings + -> RetryPolicy -- ^ Retry strategy for each underlying Cassandra call -> m (PageResult m (k, a)) -paginate m cf k rng@(Range from to ord per) cl retry = do +paginate m cf k rng@(Range _ to ord per) cl retry = do cs <- reverse `liftM` retryCas retry (get m cf k rng cl) case cs of [] -> return $ PDone [] @@ -449,7 +444,7 @@ ------------------------------------------------------------------------------- -- | Convenience layer: Convert a pagination scheme to a conduit 'Source'. -pageToSource :: (MonadBaseControl IO m, Monad m) => PageResult m a -> Source m a +pageToSource :: (Monad m) => PageResult m a -> Source m a pageToSource (PDone as) = C.sourceList as pageToSource (PMore as m) = C.sourceList as >> lift m >>= pageToSource @@ -457,13 +452,13 @@ ------------------------------------------------------------------------------- -- | Just like 'paginate', but we instead return a conduit 'Source'. paginateSource - :: (CasType k, MonadBaseControl IO m, MonadCassandra m) + :: (CasType k, MonadCassandra m, MonadCatch m) => Marshall a -> ColumnFamily -> RowKey -> Selector -> ConsistencyLevel - -> RetrySettings + -> RetryPolicy -> Source m (k, a) paginateSource m cf k rng cl r = do buf <- lift $ paginate m cf k rng cl r diff --git a/src/Database/Cassandra/Types.hs b/src/Database/Cassandra/Types.hs --- a/src/Database/Cassandra/Types.hs +++ b/src/Database/Cassandra/Types.hs @@ -11,9 +11,9 @@ module Database.Cassandra.Types where ------------------------------------------------------------------------------- -import Control.Exception -import Control.Exception.Lifted as E +import Control.Exception (IOException) import Control.Monad +import Control.Monad.Catch import qualified Data.ByteString.Char8 as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as LB @@ -247,8 +247,8 @@ -- | Exception handler that returns @True@ for errors that may be -- resolved after a retry. So they are good candidates for 'retrying' -- queries. -casRetryH :: Monad m => E.Handler m Bool -casRetryH = E.Handler $ \ e -> return $ +casRetryH :: Monad m => Int -> Handler m Bool +casRetryH = const $ Handler $ \ e -> return $ case e of UnavailableException{} -> True TimedOutException{} -> True @@ -257,8 +257,8 @@ -- | 'IOException's should be retried -networkRetryH :: Monad m => E.Handler m Bool -networkRetryH = E.Handler $ \ (_ :: IOException) -> return True +networkRetryH :: Monad m => Int -> Handler m Bool +networkRetryH = const $ Handler $ \ (_ :: IOException) -> return True ------------------------------------------------------------------------------ diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -16,8 +16,7 @@ import qualified Data.Map as M import qualified Data.Text as T import qualified Database.Cassandra.Thrift.Cassandra_Client as C -import Database.Cassandra.Thrift.Cassandra_Types - (ConsistencyLevel (..)) +import Database.Cassandra.Thrift.Cassandra_Types (ConsistencyLevel (..)) import Database.Cassandra.Thrift.Cassandra_Types as T import System.IO.Unsafe import Test.Framework (defaultMain, @@ -59,7 +58,7 @@ deriving instance Arbitrary TBytes deriving instance Arbitrary TCounter deriving instance Arbitrary TInt32 -deriving instance Arbitrary TInt +deriving instance Arbitrary TInt64 deriving instance Arbitrary TUUID deriving instance Arbitrary TLong deriving instance Arbitrary TUtf8