cassandra-cql 0.0.0.1 → 0.1.0.0
raw patch · 12 files changed
+679/−47 lines, 12 filesdep +timedep −MaybeTPVP ok
version bump matches the API change (PVP)
Dependencies added: time
Dependencies removed: MaybeT
API changes (from Hackage documentation)
- Database.Cassandra.CQL: execute :: (MonadCassandra m, CasValues values) => Consistency -> Query Rows values -> m [values]
- Database.Cassandra.CQL: instance [overlap ok] IsString (Query style values)
- Database.Cassandra.CQL: instance [overlap ok] Show (Query ($a) ($b))
+ Database.Cassandra.CQL: TimeUUID :: UUID -> TimeUUID
+ Database.Cassandra.CQL: data TimeUUID
+ Database.Cassandra.CQL: executeRow :: (MonadCassandra m, CasValues i, CasValues o) => Consistency -> Query Rows i o -> i -> m (Maybe o)
+ Database.Cassandra.CQL: executeRows :: (MonadCassandra m, CasValues i, CasValues o) => Consistency -> Query Rows i o -> i -> m [o]
+ Database.Cassandra.CQL: instance [overlap ok] (CasType a, Ord a) => CasType (Set a)
+ Database.Cassandra.CQL: instance [overlap ok] (CasType a, Ord a, CasType b) => CasType (Map a b)
+ Database.Cassandra.CQL: instance [overlap ok] CasType Double
+ Database.Cassandra.CQL: instance [overlap ok] CasType Float
+ Database.Cassandra.CQL: instance [overlap ok] CasType Integer
+ Database.Cassandra.CQL: instance [overlap ok] CasType SockAddr
+ Database.Cassandra.CQL: instance [overlap ok] CasType TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] CasType UTCTime
+ Database.Cassandra.CQL: instance [overlap ok] CasType a => CasType [a]
+ Database.Cassandra.CQL: instance [overlap ok] Data TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] Eq TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] IsString (Query style i o)
+ Database.Cassandra.CQL: instance [overlap ok] Ord TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] Read TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] Show (Query ($a) ($b) ($c))
+ Database.Cassandra.CQL: instance [overlap ok] Show TimeUUID
+ Database.Cassandra.CQL: instance [overlap ok] Typeable TimeUUID
- Database.Cassandra.CQL: data Query :: Style -> * -> *
+ Database.Cassandra.CQL: data Query :: Style -> * -> * -> *
- Database.Cassandra.CQL: executeRaw :: (MonadCassandra m, CasValues values) => Query style ignored -> values -> Consistency -> m (Result [ByteString])
+ Database.Cassandra.CQL: executeRaw :: (MonadCassandra m, CasValues i) => Query style any_i any_o -> i -> Consistency -> m (Result [ByteString])
- Database.Cassandra.CQL: executeSchema :: (MonadCassandra m, CasValues values) => Consistency -> Query Schema values -> values -> m (Change, Keyspace, Table)
+ Database.Cassandra.CQL: executeSchema :: (MonadCassandra m, CasValues i) => Consistency -> Query Schema i () -> i -> m (Change, Keyspace, Table)
- Database.Cassandra.CQL: executeWrite :: (MonadCassandra m, CasValues values) => Consistency -> Query Write values -> values -> m ()
+ Database.Cassandra.CQL: executeWrite :: (MonadCassandra m, CasValues i) => Consistency -> Query Write i () -> i -> m ()
- Database.Cassandra.CQL: query :: Text -> Query style values
+ Database.Cassandra.CQL: query :: Text -> Query style i o
Files
- Database/Cassandra/CQL.hs +179/−30
- cassandra-cql.cabal +12/−3
- tests/example.hs +24/−14
- tests/test-decimal.hs +61/−0
- tests/test-double.hs +48/−0
- tests/test-float.hs +48/−0
- tests/test-inet.hs +47/−0
- tests/test-list.hs +72/−0
- tests/test-map.hs +48/−0
- tests/test-set.hs +48/−0
- tests/test-timestamp.hs +42/−0
- tests/test-timeuuid.hs +50/−0
Database/Cassandra/CQL.hs view
@@ -14,23 +14,23 @@ -- -- * bigint - 'Int64' ----- * blob - 'Blob' 'ByteString'+-- * blob - 'Blob' -- -- * boolean - 'Bool' -- -- * counter - 'Counter' ----- * decimal+-- * decimal - 'Integer' ----- * double+-- * double - 'Double' ----- * float+-- * float - 'Float' -- -- * int - 'Int' -- -- * text - 'Text' ----- * timestamp+-- * timestamp - 'UTCTime' -- -- * uuid - 'UUID' --@@ -38,15 +38,15 @@ -- -- * varint ----- * timeuuid+-- * timeuuid - 'TimeUUID' ----- * inet+-- * inet - 'SockAddr' ----- * list\<type\>+-- * list\<a\> - [a] ----- * map\<type, type\>+-- * map\<a, b\> - 'Map' a b ----- * set\<type\>+-- * set\<a\> - 'Set' b -- module Database.Cassandra.CQL ( -- * Initialization@@ -74,7 +74,8 @@ query, Style(..), -- * Operations- execute,+ executeRows,+ executeRow, executeWrite, executeSchema, executeRaw,@@ -83,6 +84,7 @@ CasValues(..), Blob(..), Counter(..),+ TimeUUID(..), metadataTypes ) where @@ -91,7 +93,6 @@ import Control.Concurrent.STM import Control.Exception (IOException, SomeException) import Control.Monad.CatchIO-import Control.Monad.Maybe import Control.Monad.Reader import Control.Monad.State hiding (get, put) import qualified Control.Monad.State as State@@ -101,6 +102,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import Data.Data import Data.Either (lefts) import Data.Int import Data.List@@ -110,18 +112,26 @@ import Data.Sequence (Seq, (|>)) import qualified Data.Sequence as Seq import Data.Serialize hiding (Result)+import Data.Set (Set)+import qualified Data.Set as S+import Foreign.Storable import Data.String import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T+import Data.Time.Calendar+import Data.Time.Clock import Data.Typeable import Data.UUID (UUID) import qualified Data.UUID as UUID import Data.Word import Network.Socket (Socket, HostName, ServiceName, getAddrInfo, socket, AddrInfo(..),- connect, sClose)+ connect, sClose, SockAddr(..)) import Network.Socket.ByteString (send, sendAll, recv) import Numeric+import Unsafe.Coerce+--import qualified Data.ByteString.Char8 as C+--import Text.Hexdump type Server = (HostName, ServiceName) @@ -286,6 +296,7 @@ body <- if length == 0 then pure B.empty else liftIO $ recvAll s (fromIntegral length)+ --liftIO $ putStrLn $ hexdump 0 (C.unpack $ hdrBs `B.append` body) return $ Frame flags stream opcode body where parseHeader = do@@ -458,7 +469,7 @@ ERROR -> throwError (frBody fr) op -> throw $ LocalProtocolError $ "introduce: unexpected opcode " `T.append` T.pack (show op) let Keyspace ksName = piKeyspace pool- let q = query $ "USE " `T.append` ksName :: Query Rows () + let q = query $ "USE " `T.append` ksName :: Query Rows () () res <- executeInternal q () ONE case res of SetKeyspace ks -> return ()@@ -565,6 +576,59 @@ putCas (Counter c) = putWord64be (fromIntegral c) casType _ = CCounter +instance CasType Integer where+ getCas = do+ ws <- B.unpack <$> (getByteString =<< remaining)+ return $+ if null ws+ then 0+ else+ let i = foldl' (\i w -> i `shiftL` 8 + fromIntegral w) 0 ws+ in if head ws >= 0x80+ then i - 1 `shiftL` (length ws * 8)+ else i+ putCas i = putByteString . B.pack $+ if i < 0+ then encode 0x100 $ positivize 0x80 i+ else encode 0x80 i+ where+ encode :: Word8 -> Integer -> [Word8]+ encode limit i = reverse $ enc i+ where+ limit' = fromIntegral limit+ enc i | i == 0 = []+ enc i | i < limit' = [fromIntegral i]+ enc i = fromIntegral i : enc (i `shiftR` 8)+ positivize :: Integer -> Integer -> Integer+ positivize bits i = case bits + i of+ i' | i' >= 0 -> i' + bits+ _ -> positivize (bits `shiftL` 8) i+ casType _ = CDecimal++instance CasType Double where+ getCas = unsafeCoerce <$> getWord64be+ putCas dbl = putWord64be (unsafeCoerce dbl)+ casType _ = CDouble++instance CasType Float where+ getCas = unsafeCoerce <$> getWord32be+ putCas dbl = putWord32be (unsafeCoerce dbl)+ casType _ = CFloat++epoch :: UTCTime+epoch = UTCTime (fromGregorian 1970 1 1) 0++instance CasType UTCTime where+ getCas = do+ ms <- getWord64be+ let difft = realToFrac $ (fromIntegral ms :: Double) / 1000+ return $ addUTCTime difft epoch+ putCas utc = do+ let seconds = realToFrac $ diffUTCTime utc epoch :: Double+ ms = round (seconds * 1000) :: Word64+ putWord64be ms+ casType _ = CTimestamp+ instance CasType Int where getCas = fromIntegral <$> getWord32be putCas = putWord32be . fromIntegral@@ -584,6 +648,83 @@ putCas = putByteString . L.toStrict . UUID.toByteString casType _ = CUuid +data TimeUUID = TimeUUID UUID deriving (Eq, Data, Ord, Read, Show, Typeable)++instance CasType TimeUUID where+ getCas = TimeUUID <$> getCas+ putCas (TimeUUID uuid) = putCas uuid+ casType _ = CTimeuuid++instance CasType SockAddr where+ getCas = do+ len <- remaining+ case len of+ 4 -> SockAddrInet 0 <$> getWord32le+ 16 -> do+ a <- getWord32be+ b <- getWord32be+ c <- getWord32be+ d <- getWord32be+ return $ SockAddrInet6 0 0 (a,b,c,d) 0+ _ -> fail "malformed Inet"+ putCas sa = do+ case sa of+ SockAddrInet _ w -> putWord32le w+ SockAddrInet6 _ _ (a,b,c,d) _ -> putWord32be a >> putWord32be b+ >> putWord32be c >> putWord32be d+ _ -> fail $ "address type not supported in formatting Inet: " ++ show sa+ casType _ = CInet++instance CasType a => CasType [a] where+ getCas = do+ n <- getWord16be+ replicateM (fromIntegral n) $ do+ len <- getWord16be+ bs <- getByteString (fromIntegral len)+ case decodeCas bs of+ Left err -> fail err+ Right x -> return x+ putCas xs = do+ putWord16be (fromIntegral $ length xs)+ forM_ xs $ \x -> do+ let bs = encodeCas x+ putWord16be (fromIntegral $ B.length bs)+ putByteString bs+ casType _ = CList (casType (undefined :: a))++instance (CasType a, Ord a) => CasType (Set a) where+ getCas = S.fromList <$> getCas+ putCas = putCas . S.toList+ casType _ = CSet (casType (undefined :: a))++instance (CasType a, Ord a, CasType b) => CasType (Map a b) where+ getCas = do+ n <- getWord16be+ items <- replicateM (fromIntegral n) $ do+ len_a <- getWord16be+ bs_a <- getByteString (fromIntegral len_a)+ a <- case decodeCas bs_a of+ Left err -> fail err+ Right x -> return x+ len_b <- getWord16be+ bs_b <- getByteString (fromIntegral len_b)+ b <- case decodeCas bs_b of+ Left err -> fail err+ Right x -> return x+ return (a,b)+ return $ M.fromList items+ putCas m = do+ let items = M.toList m+ putWord16be (fromIntegral $ length items)+ forM_ items $ \(a,b) -> do+ let bs_a = encodeCas a+ putWord16be (fromIntegral $ B.length bs_a)+ putByteString bs_a+ let bs_b = encodeCas b+ putWord16be (fromIntegral $ B.length bs_b)+ putByteString bs_b+ casType _ = CMap (casType (undefined :: a)) (casType (undefined :: b))+ instance ProtoElt CType where putElt _ = error "formatting CType is not implemented" getElt = do@@ -633,14 +774,14 @@ data Style = Rows | Write | Schema -data Query :: Style -> * -> * where- Query :: QueryID -> Text -> Query style values+data Query :: Style -> * -> * -> * where+ Query :: QueryID -> Text -> Query style i o deriving Show -instance IsString (Query style values) where+instance IsString (Query style i o) where fromString = query . T.pack -query :: Text -> Query style values+query :: Text -> Query style i o query cql = Query (QueryID . hash . T.encodeUtf8 $ cql) cql data PreparedQuery = PreparedQuery PreparedQueryID Metadata@@ -690,7 +831,7 @@ 0x0005 -> SchemaChange <$> getElt <*> getElt <*> getElt _ -> fail $ "bad result kind: 0x"++showHex kind "" -prepare :: Query style values -> StateT ActiveSession IO PreparedQuery+prepare :: Query style i o -> StateT ActiveSession IO PreparedQuery prepare (Query qid cql) = do cache <- gets actQueryCache case qid `M.lookup` cache of@@ -935,12 +1076,12 @@ 0x0007 -> pure EACH_QUORUM _ -> fail $ "unknown consistency value 0x"++showHex w "" -executeRaw :: (MonadCassandra m, CasValues values) =>- Query style ignored -> values -> Consistency -> m (Result [ByteString])+executeRaw :: (MonadCassandra m, CasValues i) =>+ Query style any_i any_o -> i -> Consistency -> m (Result [ByteString]) executeRaw query i cons = withSession $ \_ -> executeInternal query i cons executeInternal :: CasValues values =>- Query style ignored -> values -> Consistency -> StateT ActiveSession IO (Result [ByteString])+ Query style any_i any_o -> values -> Consistency -> StateT ActiveSession IO (Result [ByteString]) executeInternal query i cons = do pq@(PreparedQuery pqid queryMeta) <- prepare query values <- case encodeValues i (metadataTypes queryMeta) of@@ -961,15 +1102,23 @@ _ -> throw $ LocalProtocolError $ "execute: unexpected opcode " `T.append` T.pack (show (frOpcode fr)) -- | Execute a query that returns rows-execute :: (MonadCassandra m, CasValues values) =>- Consistency -> Query Rows values -> m [values]-execute cons q = do- res <- executeRaw q () cons+executeRows :: (MonadCassandra m, CasValues i, CasValues o) =>+ Consistency -> Query Rows i o -> i -> m [o]+executeRows cons q i = do+ res <- executeRaw q i cons case res of RowsResult meta rows -> decodeRows meta rows _ -> throw $ ProtocolError $ "expected Rows, but got " `T.append` T.pack (show res) `T.append` " for query: " `T.append` T.pack (show q) +-- | Helper for 'executeRows' useful in situations where you are only expecting one row+-- to be returned.+executeRow :: (MonadCassandra m, CasValues i, CasValues o) =>+ Consistency -> Query Rows i o -> i -> m (Maybe o)+executeRow cons q i = do+ rows <- executeRows cons q i+ return $ listToMaybe rows+ decodeRows :: (MonadCatchIO m, CasValues values) => Metadata -> [[ByteString]] -> m [values] decodeRows meta rows0 = do let rows1 = flip map rows0 $ \cols -> decodeValues (zip (metadataTypes meta) cols)@@ -980,8 +1129,8 @@ return $ rows2 -- | Execute a write operation that returns void-executeWrite :: (MonadCassandra m, CasValues values) =>- Consistency -> Query Write values -> values -> m ()+executeWrite :: (MonadCassandra m, CasValues i) =>+ Consistency -> Query Write i () -> i -> m () executeWrite cons q i = do res <- executeRaw q i cons case res of@@ -990,8 +1139,8 @@ `T.append` " for query: " `T.append` T.pack (show q) -- | Execute a schema change, such as creating or dropping a table.-executeSchema :: (MonadCassandra m, CasValues values) =>- Consistency -> Query Schema values -> values -> m (Change, Keyspace, Table)+executeSchema :: (MonadCassandra m, CasValues i) =>+ Consistency -> Query Schema i () -> i -> m (Change, Keyspace, Table) executeSchema cons q i = do res <- executeRaw q i cons case res of
cassandra-cql.cabal view
@@ -1,5 +1,5 @@ name: cassandra-cql-version: 0.0.0.1+version: 0.1.0.0 synopsis: Haskell client for Cassandra's CQL protocol description: Haskell client for Cassandra's CQL protocol@@ -13,6 +13,15 @@ stability: alpha cabal-version: >=1.8 extra-source-files: tests/example.hs+ tests/test-map.hs+ tests/test-set.hs+ tests/test-list.hs+ tests/test-double.hs+ tests/test-float.hs+ tests/test-timestamp.hs+ tests/test-decimal.hs+ tests/test-timeuuid.hs+ tests/test-inet.hs source-repository head type: git@@ -29,9 +38,9 @@ cereal >= 0.3.0.0, bytestring >= 0.10.0.0, cryptohash >= 0.9.0,- MaybeT >= 0.1.0, stm >= 2.4.0,- uuid >= 1.2.0+ uuid >= 1.2.0,+ time >= 1.4.0.0 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-unused-imports -fno-warn-unused-binds
tests/example.hs view
@@ -12,41 +12,51 @@ import Data.UUID import System.Random -dropSongs :: Query Schema ()+dropSongs :: Query Schema () () dropSongs = "drop table songs" -createSongs :: Query Schema ()+createSongs :: Query Schema () () createSongs = "create table songs (id uuid PRIMARY KEY, title ascii, artist text, femaleSinger boolean, timesPlayed int)" -insertSong :: Query Write (UUID, ByteString, Text, Bool, Int)+insertSong :: Query Write (UUID, ByteString, Text, Bool, Int) () insertSong = "insert into songs (id, title, artist, femaleSinger, timesPlayed) values (?, ?, ?, ?, ?)" -getSongs :: Query Rows (UUID, ByteString, Text, Bool, Int)+getSongs :: Query Rows () (UUID, ByteString, Text, Bool, Int) getSongs = "select id, title, artist, femaleSinger, timesPlayed from songs" +getOneSong :: Query Rows UUID (Text, Int)+getOneSong = "select artist, timesPlayed from songs where id=?"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc+ main = do- pool <- createCassandraPool [("localhost", "9042")] "meta"+ {-+ Assuming a 'test' keyspace already exists. Here's some CQL to create it:+ CREATE KEYSPACE test WITH replication = { 'class' : 'SimpleStrategy', 'replication_factor' : '1' };+ -}+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace runCas pool $ do- do- liftIO . print =<< executeSchema QUORUM dropSongs ()- `catch` \exc -> case exc of- ConfigError _ -> return () -- Ignore the error if the table doesn't exist- _ -> liftIO $ throw exc-+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropSongs () liftIO . print =<< executeSchema QUORUM createSongs () u1 <- liftIO randomIO u2 <- liftIO randomIO u3 <- liftIO randomIO executeWrite QUORUM insertSong (u1, "La Grange", "ZZ Top", False, 2)- executeWrite QUORUM insertSong (u2, "Your star", "Evanescence", True, 799)+ executeWrite QUORUM insertSong (u2, "Your Star", "Evanescence", True, 799) executeWrite QUORUM insertSong (u3, "Angel of Death", "Slayer", False, 50) - songs <- execute QUORUM getSongs+ songs <- executeRows QUORUM getSongs () liftIO $ forM_ songs $ \(uuid, title, artist, female, played) -> do putStrLn ""- putStrLn $ "uuid : "++show uuid+ putStrLn $ "id : "++show uuid putStrLn $ "title : "++C.unpack title putStrLn $ "artist : "++T.unpack artist putStrLn $ "female singer : "++show female putStrLn $ "times played : "++show played++ liftIO $ putStrLn ""+ liftIO . print =<< executeRow QUORUM getOneSong u2
+ tests/test-decimal.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table decimals"++createLists :: Query Schema () ()+createLists = "create table decimals (id uuid PRIMARY KEY, item decimal)"++insert :: Query Write (UUID, Integer) ()+insert = "insert into decimals (id, item) values (?, ?)"++select :: Query Rows UUID Integer+select = "select item from decimals where id=?"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ u4 <- liftIO randomIO+ u5 <- liftIO randomIO+ u6 <- liftIO randomIO+ u7 <- liftIO randomIO+ u8 <- liftIO randomIO+ u9 <- liftIO randomIO+ u10 <- liftIO randomIO+ executeWrite QUORUM insert (u1, 0)+ executeWrite QUORUM insert (u2, -1)+ executeWrite QUORUM insert (u3, 12345678901234567890123456789)+ executeWrite QUORUM insert (u4, -12345678901234567890123456789)+ executeWrite QUORUM insert (u5, -65537)+ executeWrite QUORUM insert (u6, -65536)+ executeWrite QUORUM insert (u7, -65535)+ executeWrite QUORUM insert (u8, -32769)+ executeWrite QUORUM insert (u9, -32768)+ executeWrite QUORUM insert (u10, -32767)+ + let us = [u1,u2,u3,u4,u5,u6,u7,u8,u9,u10]+ forM_ us $ \u ->+ liftIO . print =<< executeRow QUORUM select u+
+ tests/test-double.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as C+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table doubles"++createLists :: Query Schema () ()+createLists = "create table doubles (id uuid PRIMARY KEY, item double)"++insert :: Query Write (UUID, Double) ()+insert = "insert into doubles (id, item) values (?, ?)"++select :: Query Rows () Double+select = "select item from doubles"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insert (u1, 100)+ executeWrite QUORUM insert (u2, 0.5)+ executeWrite QUORUM insert (u3, 3.141592654)++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-float.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as C+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table floats"++createLists :: Query Schema () ()+createLists = "create table floats (id uuid PRIMARY KEY, item float)"++insert :: Query Write (UUID, Float) ()+insert = "insert into floats (id, item) values (?, ?)"++select :: Query Rows () Float+select = "select item from floats"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insert (u1, 100)+ executeWrite QUORUM insert (u2, 0.5)+ executeWrite QUORUM insert (u3, 3.141592654)++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-inet.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Applicative+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.UUID+import Network.Socket+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table inets"++createLists :: Query Schema () ()+createLists = "create table inets (id uuid PRIMARY KEY, item inet)"++insert :: Query Write (UUID, SockAddr) ()+insert = "insert into inets (id, item) values (?, ?)"++select :: Query Rows () SockAddr+select = "select item from inets"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ a1 <- liftIO $ addrAddress . head <$> getAddrInfo Nothing (Just "2406:e000:c182:1:949c:ae7d:64a1:1935") Nothing+ a2 <- liftIO $ addrAddress . head <$> getAddrInfo Nothing (Just "192.168.178.29") Nothing+ executeWrite QUORUM insert (u1, a1)+ executeWrite QUORUM insert (u2, a2)++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-list.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as C+import Data.Text (Text)+import qualified Data.Text as T+import Data.UUID+import System.Random++dropListsI :: Query Schema () ()+dropListsI = "drop table listsi"++createListsI :: Query Schema () ()+createListsI = "create table listsi (id uuid PRIMARY KEY, items list<int>)"++insertI :: Query Write (UUID, [Int]) ()+insertI = "insert into listsi (id, items) values (?, ?)"++selectI :: Query Rows () [Int]+selectI = "select items from listsi"++dropListsT :: Query Schema () ()+dropListsT = "drop table listst"++createListsT :: Query Schema () ()+createListsT = "create table listst (id uuid PRIMARY KEY, items list<text>)"++insertT :: Query Write (UUID, [Text]) ()+insertT = "insert into listst (id, items) values (?, ?)"++selectT :: Query Rows () [Text]+selectT = "select items from listst"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropListsI ()+ liftIO . print =<< executeSchema QUORUM createListsI ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insertI (u1, [10,11,12])+ executeWrite QUORUM insertI (u2, [2,4,6,8])+ executeWrite QUORUM insertI (u3, [900,1000,1100])+ + liftIO . print =<< executeRows QUORUM selectI ()++ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropListsT ()+ liftIO . print =<< executeSchema QUORUM createListsT ()+ + u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insertT (u1, ["dog","cat","rabbit"])+ executeWrite QUORUM insertT (u2, ["carrot","tomato"])+ executeWrite QUORUM insertT (u3, ["a","b","c"])+ + liftIO . print =<< executeRows QUORUM selectT ()+
+ tests/test-map.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as C+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table maps"++createLists :: Query Schema () ()+createLists = "create table maps (id uuid PRIMARY KEY, items map<int,text>)"++insert :: Query Write (UUID, Map Int Text) ()+insert = "insert into maps (id, items) values (?, ?)"++select :: Query Rows () (Map Int Text)+select = "select items from maps"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insert (u1, M.fromList [(1, "one"), (2, "two")])+ executeWrite QUORUM insert (u2, M.fromList [(100, "hundred"), (200, "two hundred")])+ executeWrite QUORUM insert (u3, M.fromList [(12, "dozen")])++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-set.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as C+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table sets"++createLists :: Query Schema () ()+createLists = "create table sets (id uuid PRIMARY KEY, items set<text>)"++insert :: Query Write (UUID, Set Text) ()+insert = "insert into sets (id, items) values (?, ?)"++select :: Query Rows () (Set Text)+select = "select items from sets"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ u3 <- liftIO randomIO+ executeWrite QUORUM insert (u1, S.fromList ["one", "two"])+ executeWrite QUORUM insert (u2, S.fromList ["hundred", "two hundred"])+ executeWrite QUORUM insert (u3, S.fromList ["dozen"])++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-timestamp.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table timestamps"++createLists :: Query Schema () ()+createLists = "create table timestamps (id uuid PRIMARY KEY, item timestamp)"++insert :: Query Write (UUID, UTCTime) ()+insert = "insert into timestamps (id, item) values (?, ?)"++select :: Query Rows () UTCTime+select = "select item from timestamps"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ t <- liftIO getCurrentTime+ executeWrite QUORUM insert (u1, t)++ liftIO . print =<< executeRows QUORUM select ()+
+ tests/test-timeuuid.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings, DataKinds #-}++import Database.Cassandra.CQL+import Control.Monad+import Control.Monad.CatchIO+import Control.Monad.Trans (liftIO)+import Data.Int+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.UUID+import System.Random++dropLists :: Query Schema () ()+dropLists = "drop table timeuuids"++createLists :: Query Schema () ()+createLists = "create table timeuuids (id uuid PRIMARY KEY, item timeuuid)"++insertNow :: Query Write UUID ()+insertNow = "insert into timeuuids (id, item) values (?, now())"++insert :: Query Write (UUID, TimeUUID) ()+insert = "insert into timeuuids (id, item) values (?, ?)"++selectOne :: Query Rows UUID TimeUUID+selectOne = "select item from timeuuids where id=?"++select :: Query Rows () TimeUUID+select = "select item from timeuuids"++ignoreDropFailure :: Cas () -> Cas ()+ignoreDropFailure code = code `catch` \exc -> case exc of+ ConfigError _ -> return () -- Ignore the error if the table doesn't exist+ _ -> throw exc++main = do+ pool <- createCassandraPool [("localhost", "9042")] "test" -- servers, keyspace+ runCas pool $ do+ ignoreDropFailure $ liftIO . print =<< executeSchema QUORUM dropLists ()+ liftIO . print =<< executeSchema QUORUM createLists ()++ u1 <- liftIO randomIO+ u2 <- liftIO randomIO+ executeWrite QUORUM insertNow u1+ Just t <- executeRow QUORUM selectOne u1+ executeWrite QUORUM insert (u2, t)++ liftIO . print =<< executeRows QUORUM select ()+