diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +4.0.2 +----- +- Add missing constructors for `WriteType`. + cf. https://github.com/apache/cassandra/commit/5a662ea3ffdbb9563cf3ef959deb13982b084b24 +- GHC 8.8 compatibility. + 4.0.1 ----- - GHC 8.4 compatibility. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,11 +5,30 @@ [3] and [4]. It provides encoding and decoding functionality as well as representations of the various protocol related types. +[3]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v3.spec +[4]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v4.spec + Contributing ------------ If you want to contribute to this project please read the file CONTRIBUTING first. -[3]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v3.spec -[4]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v4.spec +License +======= + +See [LICENSE](./LICENSE). + +Cassandra Logo License +====================== + +Copyright © 2018 Apache Software Foundation + +Licensed under the Apache License, Version 2.0 (the "License"); you may not use +this file except in compliance with the License. You may obtain a copy of the +License at https://www.apache.org/licenses/LICENSE-2.0. Unless required by +applicable law or agreed to in writing, software distributed under the License +is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +KIND, either express or implied. See the License for the specific language +governing permissions and limitations under the License. + diff --git a/cql.cabal b/cql.cabal --- a/cql.cabal +++ b/cql.cabal @@ -1,5 +1,5 @@ name: cql -version: 4.0.1 +version: 4.0.2 synopsis: Cassandra CQL binary protocol. stability: experimental license: OtherLicense diff --git a/src/Database/CQL/Protocol/Codec.hs b/src/Database/CQL/Protocol/Codec.hs --- a/src/Database/CQL/Protocol/Codec.hs +++ b/src/Database/CQL/Protocol/Codec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} module Database.CQL.Protocol.Codec ( encodeByte @@ -81,7 +80,7 @@ import Data.Word import Data.Serialize hiding (decode, encode) import Database.CQL.Protocol.Types -import Network.Socket (SockAddr (..), PortNumber (..)) +import Network.Socket (SockAddr (..), PortNumber) import Prelude import qualified Data.ByteString as B @@ -249,9 +248,9 @@ putWord32host c putWord32host d putWord32be (fromIntegral p) -encodeSockAddr (SockAddrUnix _) = fail "encode-socket: unix address not allowed" +encodeSockAddr (SockAddrUnix _) = error "encode-socket: unix address not supported" #if MIN_VERSION_network(2,6,1) && !MIN_VERSION_network(3,0,0) -encodeSockAddr (SockAddrCan _) = fail "encode-socket: can address not allowed" +encodeSockAddr (SockAddrCan _) = error "encode-socket: can address not supported" #endif decodeSockAddr :: Get SockAddr @@ -431,13 +430,13 @@ put (fromIntegral (decimalPlaces x) :: Int32) integer2bytes (decimalMantissa x) putValue V4 (CqlDate x) = toBytes $ put x -putValue _ v@(CqlDate _) = fail $ "putValue: date: " ++ show v +putValue _ v@(CqlDate _) = error $ "putValue: date: " ++ show v putValue V4 (CqlTime x) = toBytes $ put x -putValue _ v@(CqlTime _) = fail $ "putValue: time: " ++ show v +putValue _ v@(CqlTime _) = error $ "putValue: time: " ++ show v putValue V4 (CqlSmallInt x) = toBytes $ put x -putValue _ v@(CqlSmallInt _) = fail $ "putValue: smallint: " ++ show v +putValue _ v@(CqlSmallInt _) = error $ "putValue: smallint: " ++ show v putValue V4 (CqlTinyInt x) = toBytes $ put x -putValue _ v@(CqlTinyInt _) = fail $ "putValue: tinyint: " ++ show v +putValue _ v@(CqlTinyInt _) = error $ "putValue: tinyint: " ++ show v putValue v (CqlUdt x) = toBytes $ mapM_ (putValue v . snd) x putValue v (CqlList x) = toBytes $ do encodeInt (fromIntegral (length x)) diff --git a/src/Database/CQL/Protocol/Record.hs b/src/Database/CQL/Protocol/Record.hs --- a/src/Database/CQL/Protocol/Record.hs +++ b/src/Database/CQL/Protocol/Record.hs @@ -10,11 +10,11 @@ import Control.Monad import Language.Haskell.TH -typeSynDecl :: Name -> [Type] -> Type -> Dec -#if __GLASGOW_HASKELL__ < 708 -typeSynDecl = TySynInstD +typeSynDecl :: Name -> Type -> Type -> Dec +#if __GLASGOW_HASKELL__ < 808 +typeSynDecl x y z = TySynInstD x (TySynEqn [y] z) #else -typeSynDecl x y z = TySynInstD x (TySynEqn y z) +typeSynDecl x y z = TySynInstD (TySynEqn Nothing (AppT (ConT x) y) z) #endif type family TupleType a @@ -57,23 +57,15 @@ _ -> fail "expecting record type" start :: Dec -> Q [Dec] -#if MIN_VERSION_template_haskell(2,11,0) start (DataD _ tname _ _ cons _) = do -#else -start (DataD _ tname _ cons _) = do -#endif unless (length cons == 1) $ fail "expecting single data constructor" tt <- tupleType (head cons) at <- asTupleDecl (head cons) ar <- asRecrdDecl (head cons) return - [ typeSynDecl (mkName "TupleType") [ConT tname] tt -#if MIN_VERSION_template_haskell(2,11,0) + [ typeSynDecl (mkName "TupleType") (ConT tname) tt , InstanceD Nothing [] (ConT (mkName "Record") $: ConT tname) -#else - , InstanceD [] (ConT (mkName "Record") $: ConT tname) -#endif [ FunD (mkName "asTuple") [at] , FunD (mkName "asRecord") [ar] ] diff --git a/src/Database/CQL/Protocol/Response.hs b/src/Database/CQL/Protocol/Response.hs --- a/src/Database/CQL/Protocol/Response.hs +++ b/src/Database/CQL/Protocol/Response.hs @@ -216,10 +216,10 @@ -- | Part of a @RowsResult@. Describes the result set. data MetaData = MetaData - { columnCount :: !Int32 - , pagingState :: Maybe PagingState - , columnSpecs :: [ColumnSpec] - , primaryKeyIndicies :: [Int32] + { columnCount :: !Int32 + , pagingState :: Maybe PagingState + , columnSpecs :: [ColumnSpec] + , primaryKeyIndices :: [Int32] } deriving (Show) -- | The column specification. Part of 'MetaData' unless 'skipMetaData' in @@ -455,6 +455,11 @@ | WriteBatchLog | WriteUnloggedBatch | WriteCounter + | WriteCas + | WriteView + -- ^ Since 'V4'. + | WriteCdc + -- ^ Since 'V4'. deriving (Eq, Show) decodeError :: Get Error @@ -517,5 +522,8 @@ fromString "BATCH_LOG" = return WriteBatchLog fromString "UNLOGGED_BATCH" = return WriteUnloggedBatch fromString "COUNTER" = return WriteCounter + fromString "CAS" = return WriteCas + fromString "VIEW" = return WriteView + fromString "CDC" = return WriteCdc fromString unknown = fail $ "decode: unknown write-type: " ++ show unknown diff --git a/src/Database/CQL/Protocol/Tuple/TH.hs b/src/Database/CQL/Protocol/Tuple/TH.hs --- a/src/Database/CQL/Protocol/Tuple/TH.hs +++ b/src/Database/CQL/Protocol/Tuple/TH.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Database.CQL.Protocol.Tuple.TH where @@ -19,29 +18,17 @@ vnames <- replicateM n (newName "a") let vtypes = map VarT vnames let tupleType = foldl1 ($:) (TupleT n : vtypes) -#if MIN_VERSION_template_haskell(2,10,0) let ctx = map (AppT (ConT cql)) vtypes -#else - let ctx = map (\t -> ClassP cql [t]) vtypes -#endif td <- tupleDecl n sd <- storeDecl n return -#if MIN_VERSION_template_haskell(2,11,0) [ InstanceD Nothing ctx (tcon "PrivateTuple" $: tupleType) -#else - [ InstanceD ctx (tcon "PrivateTuple" $: tupleType) -#endif [ FunD (mkName "count") [countDecl n] , FunD (mkName "check") [taggedDecl (var "typecheck") vnames] , FunD (mkName "tuple") [td] , FunD (mkName "store") [sd] ] -#if MIN_VERSION_template_haskell(2,11,0) , InstanceD Nothing ctx (tcon "Tuple" $: tupleType) [] -#else - , InstanceD ctx (tcon "Tuple" $: tupleType) [] -#endif ] countDecl :: Int -> Clause @@ -105,19 +92,11 @@ vnames <- replicateM n (newName "a") let vtypes = map VarT vnames let tupleType = foldl1 ($:) (TupleT n : vtypes) -#if MIN_VERSION_template_haskell(2,10,0) let ctx = map (AppT (ConT cql)) vtypes -#else - let ctx = map (\t -> ClassP cql [t]) vtypes -#endif tocql <- toCqlDecl fromcql <- fromCqlDecl return -#if MIN_VERSION_template_haskell(2,11,0) [ InstanceD Nothing ctx (tcon "Cql" $: tupleType) -#else - [ InstanceD ctx (tcon "Cql" $: tupleType) -#endif [ FunD (mkName "ctype") [taggedDecl (con "TupleColumn") vnames] , FunD (mkName "toCql") [tocql] , FunD (mkName "fromCql") [fromcql] diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -15,6 +17,7 @@ import Data.IP import Data.Maybe import Data.Serialize +import Data.Text (Text) import Data.Time import Data.Time.Clock.POSIX import Data.UUID @@ -113,10 +116,10 @@ v3 0 = v3Leaf v3 n = v3Leaf ++ - [ CqlList <$> many n - , CqlSet <$> many n - , CqlMap <$> (zip <$> many n <*> many n) - , CqlTuple <$> many1 n + [ CqlList <$> many n + , CqlSet <$> many n + , CqlMap <$> (zip <$> many n <*> many n) + , CqlTuple <$> many1 n ] v4 0 = v4Leaf ++ v3Leaf @@ -190,3 +193,15 @@ instance Arbitrary (DecimalRaw Integer) where arbitrary = Decimal <$> arbitrary <*> arbitrary + +----------------------------------------------------------------------------- +-- TH code generation test. + +data TestRecord = TestRecord + { testRecordA :: IP + , testRecordB :: Text + , testRecordC :: Int32 + } deriving Show + +recordInstance ''TestRecord +