packages feed

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 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 ()+