avro 0.2.0.0 → 0.2.1.0
raw patch · 16 files changed
+193/−74 lines, 16 filesdep +lensdep +lens-aesondep +transformers
Dependencies added: lens, lens-aeson, transformers
Files
- avro.cabal +15/−11
- src/Data/Avro.hs +3/−2
- src/Data/Avro/Decode.hs +1/−1
- src/Data/Avro/Deriving.hs +43/−2
- src/Data/Avro/Deriving/NormSchema.hs +1/−0
- src/Data/Avro/Encode.hs +6/−1
- src/Data/Avro/FromAvro.hs +5/−0
- src/Data/Avro/HasAvroSchema.hs +3/−0
- src/Data/Avro/Schema.hs +2/−35
- src/Data/Avro/ToAvro.hs +3/−0
- src/Data/Avro/Types.hs +1/−1
- test/Avro/Codec/FloatSpec.hs +57/−0
- test/Avro/Codec/Int64Spec.hs +1/−1
- test/Avro/THSimpleSpec.hs +33/−8
- test/Avro/ToAvroSpec.hs +10/−0
- test/data/small.avsc +9/−12
avro.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: avro-version: 0.2.0.0+version: 0.2.1.0 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell homepage: https://github.com/haskell-works/hw-haskell-avro.git@@ -56,13 +56,13 @@ fail, hashable, mtl,+ pure-zlib, scientific,+ semigroups,+ tagged, text, unordered-containers,- vector,- pure-zlib,- semigroups,- tagged+ vector if flag(templateHaskell) build-depends: template-haskell >= 2.4@@ -84,6 +84,7 @@ , Avro.Codec.BoolSpec , Avro.Codec.CodecRawSpec , Avro.Codec.DoubleSpec+ , Avro.Codec.FloatSpec , Avro.Codec.Int64Spec , Avro.Codec.MaybeSpec , Avro.Codec.NestedSpec@@ -93,9 +94,10 @@ , Avro.ToAvroSpec build-depends: base >=4.6 && < 5- , avro , aeson+ , lens-aeson , array+ , avro , base16-bytestring , binary , bytestring@@ -104,16 +106,18 @@ , extra , fail , hashable+ , hspec+ , lens , mtl+ , pure-zlib+ , QuickCheck , scientific+ , semigroups+ , tagged , text+ , transformers , unordered-containers , vector- , pure-zlib- , semigroups- , tagged- , hspec- , QuickCheck if flag(templateHaskell) build-depends: template-haskell
src/Data/Avro.hs view
@@ -74,7 +74,7 @@ , HasAvroSchema(..) , Avro , (.:)- , (.=), record+ , (.=), record, fixed , Result(..), badValue , decode , decodeWithSchema@@ -178,7 +178,8 @@ record :: Foldable f => Type -> f (Text,T.Value Type) -> T.Value Type record ty = T.Record ty . HashMap.fromList . toList -+fixed :: Type -> B.ByteString -> T.Value Type+fixed = T.Fixed -- @enumToAvro val@ will generate an Avro encoded value of enum suitable -- for serialization ('encode'). -- enumToAvro :: (Show a, Enum a, Bounded a, Generic a) => a -> T.Value Type
src/Data/Avro/Decode.hs view
@@ -161,7 +161,7 @@ case unionLookup i of Nothing -> fail $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (P.map typeName $ NE.toList ts) Just t -> T.Union ts t <$> go t- Fixed {..} -> T.Fixed <$> G.getByteString (fromIntegral size)+ Fixed {..} -> T.Fixed ty <$> G.getByteString (fromIntegral size) getKVBlocks :: Type -> Get [[(Text,T.Value Type)]] getKVBlocks t =
src/Data/Avro/Deriving.hs view
@@ -27,6 +27,7 @@ import Data.Avro.Deriving.NormSchema +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBSC8 import Data.Text (Text)@@ -75,6 +76,11 @@ fromAvro (AT.Record _ r) = $(genFromAvroFieldsExp (mkTextName $ unTN n) fs) r fromAvro value = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value |]+genFromAvro (S.Fixed n _ _ s) =+ [d| instance FromAvro $(conT $ mkDataTypeName n) where+ fromAvro (AT.Fixed _ v) | BS.length v == s = pure $ $(conE (mkDataTypeName n)) v+ fromAvro value = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value+ |] genFromAvro _ = pure [] genFromAvroFieldsExp :: Name -> [Field] -> Q Exp@@ -99,7 +105,7 @@ |] genToAvro :: Schema -> Q [Dec]-genToAvro s@(Enum n _ _ _ vs _) = do+genToAvro s@(Enum n _ _ _ vs _) = toAvroInstance (mkSchemaValueName n) where conP' = flip conP [] . mkAdtCtorName n@@ -125,6 +131,16 @@ ) |] +genToAvro s@(Fixed n _ _ size) =+ toAvroInstance (mkSchemaValueName n)+ where+ toAvroInstance sname =+ [d| instance ToAvro $(conT $ mkDataTypeName n) where+ toAvro = $(do+ x <- newName "x"+ lamE [conP (mkDataTypeName n) [varP x]] [| AT.Fixed $(varE sname) $(varE x) |])+ |]+ schemaDef :: Name -> Schema -> Q [Dec] schemaDef sname sch = setName sname $ [d|@@ -150,13 +166,17 @@ genType (S.Enum n _ _ _ vs _) = do let dname = mkDataTypeName n sequenceA [genEnum dname (mkAdtCtorName n <$> vs)]+genType (S.Fixed n _ _ s) = do+ let dname = mkDataTypeName n+ sequenceA [genNewtype dname]+ genType _ = pure [] mkFieldTypeName :: S.Type -> Q TH.Type mkFieldTypeName t = case t of S.Boolean -> [t| Bool |] S.Long -> [t| Int64 |]- S.Int -> [t| Int |]+ S.Int -> [t| Int32 |] S.Float -> [t| Float |] S.Double -> [t| Double |] S.Bytes -> [t| ByteString |]@@ -212,6 +232,27 @@ ftype <- mkFieldTypeName (fldType field) let fName = mkFieldTextName prefix field pure (fName, defaultStrictness, ftype)++genNewtype :: Name -> Q Dec+#if MIN_VERSION_template_haskell(2,12,0)+genNewtype dn = do+ ders <- sequenceA [[t|Eq|], [t|Show|]]+ fldType <- [t|ByteString|]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ pure $ NewtypeD [] dn [] Nothing ctor [DerivClause Nothing ders]+#elif MIN_VERSION_template_haskell(2,11,0)+genNewtype dn = do+ ders <- sequenceA [[t|Eq|], [t|Show|]]+ fldType <- [t|ByteString|]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ pure $ NewtypeD [] dn [] Nothing ctor ders+#else+genNewtype dn = do+ [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|]]+ fldType <- [t|ByteString|]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ pure $ NewtypeD [] dn [] ctor [eq, sh]+#endif genEnum :: Name -> [Name] -> Q Dec #if MIN_VERSION_template_haskell(2,12,0)
src/Data/Avro/Deriving/NormSchema.hs view
@@ -28,6 +28,7 @@ Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts Map t -> getTypes t e@Enum{} -> [e]+ f@Fixed{} -> [f] _ -> [] -- TODO: Currently ensures normalisation: only in one way
src/Data/Avro/Encode.hs view
@@ -233,5 +233,10 @@ case DL.elemIndex sel (NE.toList opts) of Just idx -> AvroM (putI idx <> putAvro val, S.mkUnion opts) Nothing -> error "Union encoding specifies type not found in schema"- T.Fixed bs -> avro bs T.Enum sch@S.Enum{..} ix t -> AvroM (putI ix, sch)+ T.Fixed ty bs ->+ if (B.length bs == size ty)+ then AvroM (byteString bs, S.Bytes)+ else error $ "Fixed type " <> show (name ty)+ <> " has size " <> show (size ty)+ <> " but the value has length " <> show (B.length bs)
src/Data/Avro/FromAvro.hs view
@@ -70,6 +70,11 @@ instance FromAvro Double where fromAvro (T.Double d) = pure d fromAvro v = badValue v "Double"++instance FromAvro Float where+ fromAvro (T.Float f) = pure f+ fromAvro v = badValue v "Float"+ instance FromAvro a => FromAvro (Maybe a) where fromAvro (T.Union (S.Null :| [_]) _ T.Null) = pure Nothing fromAvro (T.Union (S.Null :| [_]) _ v) = Just <$> fromAvro v
src/Data/Avro/HasAvroSchema.hs view
@@ -45,6 +45,9 @@ instance HasAvroSchema Double where schema = Tagged S.Double +instance HasAvroSchema Float where+ schema = Tagged S.Float+ instance HasAvroSchema Text.Text where schema = Tagged S.String
src/Data/Avro/Schema.hs view
@@ -95,7 +95,7 @@ | Fixed { name :: TypeName , namespace :: Maybe Text , aliases :: [TypeName]- , size :: Integer+ , size :: Int } deriving (Show) @@ -320,7 +320,7 @@ Ty.Record _ flds -> A.Object (HashMap.map toJSON flds) Ty.Union _ _ Ty.Null -> A.Null Ty.Union _ ty val -> object [ typeName ty .= val ]- Ty.Fixed bs -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs)) -- XXX the example wasn't literal - this should be an actual bytestring... somehow.+ Ty.Fixed _ bs -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs)) -- XXX the example wasn't literal - this should be an actual bytestring... somehow. Ty.Enum _ _ txt -> A.String txt data Result a = Success a | Error String@@ -486,36 +486,3 @@ Fixed {..} -> mk name aliases namespace Array {..} -> go item _ -> []---- TODO: Currently ensures normalisation: only in one way--- that is needed for "extractRecord".--- it ensures that an "extracted" record is self-contained and--- all the named types are resolvable within the scope of the schema.--- The other way around (to each record is inlined only once and is referenced--- as a named type after that) is not implemented.-normSchema :: [Schema] -- ^ List of all possible records- -> Schema -- ^ Schema to normalise- -> State (S.Set TypeName) Schema-normSchema rs r = case r of- t@(NamedType tn) -> do- let sn = shortName tn- resolved <- get- if S.member sn resolved- then pure t- else do- modify' (S.insert sn)- pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn)-- Array s -> Array <$> normSchema rs s- Map s -> Map <$> normSchema rs s- Record{name = tn} -> do- let sn = shortName tn- modify' (S.insert sn)- flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r)- pure $ r { fields = flds }- s -> pure s- where- shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn)- setType fld t = fld { fldType = t}- fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s)- findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs
src/Data/Avro/ToAvro.hs view
@@ -47,6 +47,9 @@ instance ToAvro Double where toAvro = T.Double +instance ToAvro Float where+ toAvro = T.Float+ instance ToAvro Text.Text where toAvro = T.String
src/Data/Avro/Types.hs view
@@ -20,6 +20,6 @@ | Map (HashMap Text (Value f)) -- ^ Dynamically enforced monomorphic type | Record f (HashMap Text (Value f)) -- Order and a map | Union (NonEmpty f) f (Value f) -- ^ Set of union options, schema for selected option, and the actual value.- | Fixed {-# UNPACK #-} !ByteString+ | Fixed f {-# UNPACK #-} !ByteString | Enum f {-# UNPACK #-} !Int Text -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol deriving (Eq, Show)
+ test/Avro/Codec/FloatSpec.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.FloatSpec (spec) where++import Data.Avro+import Data.Avro.Schema+import Data.Tagged+import Test.Hspec+import qualified Data.Avro.Types as AT+import qualified Data.ByteString.Lazy as BL+import qualified Test.QuickCheck as Q++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++newtype OnlyFloat = OnlyFloat+ {onlyFloatValue :: Float+ } deriving (Show, Eq)++onlyFloatSchema :: Schema+onlyFloatSchema =+ let fld nm = Field nm [] Nothing Nothing+ in Record "OnlyFloat" (Just "test.contract") [] Nothing Nothing+ [ fld "onlyFloatValue" Float Nothing+ ]++instance HasAvroSchema OnlyFloat where+ schema = pure onlyFloatSchema++instance ToAvro OnlyFloat where+ toAvro sa = record onlyFloatSchema+ [ "onlyFloatValue" .= onlyFloatValue sa ]++instance FromAvro OnlyFloat where+ fromAvro (AT.Record _ r) =+ OnlyFloat <$> r .: "onlyFloatValue"++spec :: Spec+spec = describe "Avro.Codec.FloatSpec" $ do+ it "Can decode 0.89" $ do+ let expectedBuffer = BL.pack [10, -41, 99, 63]+ let value = OnlyFloat 0.89+ encode value `shouldBe` expectedBuffer++ it "Can decode -2.0" $ do+ let expectedBuffer = BL.pack [0, 0, 0, -64]+ let value = OnlyFloat (-2.0)+ encode value `shouldBe` expectedBuffer++ it "Can decode 1.0" $ do+ let expectedBuffer = [0, 0, 128, 63]+ let value = OnlyFloat 1.0+ BL.unpack (encode value) `shouldBe` expectedBuffer++ it "Can decode encoded Float values" $ do+ Q.property $ \(d :: Float) ->+ decode (encode (OnlyFloat d)) == Success (OnlyFloat d)
test/Avro/Codec/Int64Spec.hs view
@@ -19,7 +19,7 @@ import qualified Data.Avro.Types as AT import qualified Data.ByteString.Lazy as BL import qualified Test.QuickCheck as Q-import Debug.Trace+ {-# ANN module ("HLint: ignore Redundant do" :: String) #-}
test/Avro/THSimpleSpec.hs view
@@ -5,11 +5,17 @@ where import Control.Monad-import Data.Aeson (decodeStrict)+import Control.Lens+import Data.Aeson.Lens import Data.Avro import Data.Avro.Deriving import Data.Avro.Schema-import Data.ByteString as BS+import Data.Monoid ((<>))+import qualified Data.Aeson as J+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString.Base16 as Base16 import Test.Hspec @@ -21,16 +27,22 @@ spec = describe "Avro.THSpec: Small Schema" $ do let msgs = [ Endpoint- { endpointIps = ["192.168.1.1", "127.0.0.1"]- , endpointPorts = [PortRange 1 10, PortRange 11 20]+ { endpointIps = ["192.168.1.1", "127.0.0.1"]+ , endpointPorts = [PortRange 1 10, PortRange 11 20]+ , endpointOpaque = Opaque "16-b-long-string"+ , endpointCorrelation = Opaque "opaq-correlation"+ , endpointTag = Left 14 } , Endpoint- { endpointIps = []- , endpointPorts = [PortRange 1 10, PortRange 11 20]+ { endpointIps = []+ , endpointPorts = [PortRange 1 10, PortRange 11 20]+ , endpointOpaque = Opaque "opaque-long-text"+ , endpointCorrelation = Opaque "correlation-data"+ , endpointTag = Right "first-tag" } ] - it "should do roundtrip" $ do+ it "should do roundtrip" $ forM_ msgs $ \msg -> fromAvro (toAvro msg) `shouldBe` pure msg @@ -39,4 +51,17 @@ let encoded = encode msg let decoded = decode encoded - pure msg `shouldBe` decoded+ decoded `shouldBe` pure msg++ it "should convert to JSON" $ do+ forM_ msgs $ \msg -> do+ let json = J.encode (toAvro msg)+ json ^? key "opaque" . _String `shouldBe` Just (encodeOpaque $ endpointOpaque msg)+ json ^? key "correlation" . _String `shouldBe` Just (encodeOpaque $ endpointCorrelation msg)++ json ^? key "tag" . _Value . key "int" . _Integral `shouldBe` endpointTag msg ^? _Left+ json ^? key "tag" . _Value . key "string" . _String `shouldBe` endpointTag msg ^? _Right+ where+ encodeOpaque :: Opaque -> Text+ encodeOpaque v = "\\u" <> T.decodeUtf8 (Base16.encode $ unOpaque v)+
test/Avro/ToAvroSpec.hs view
@@ -24,6 +24,8 @@ , tmTimestamp :: Maybe Int64 , tmForeignId :: Maybe Int64 , tmCompetence :: Maybe Double+ , tmRelevance :: Maybe Float+ , tmSeverity :: Float , tmAttraction :: Double } deriving (Show, Eq) @@ -36,6 +38,8 @@ , fld "timestamp" (mkUnion (Null :| [Long])) Nothing , fld "foreignId" (mkUnion (Null :| [Long])) Nothing , fld "competence" (mkUnion (Null :| [Double])) Nothing+ , fld "relevance" (mkUnion (Null :| [Float])) Nothing+ , fld "severity" Float Nothing , fld "attraction" Double Nothing ] @@ -49,6 +53,8 @@ , "timestamp" .= tmTimestamp m , "foreignId" .= tmForeignId m , "competence" .= tmCompetence m+ , "relevance" .= tmRelevance m+ , "severity" .= tmSeverity m , "attraction" .= tmAttraction m ] @@ -59,6 +65,8 @@ <*> r .: "timestamp" <*> r .: "foreignId" <*> r .: "competence"+ <*> r .: "relevance"+ <*> r .: "severity" <*> r .: "attraction" fromAvro v = badValue v "TypesTestMessage" @@ -69,6 +77,8 @@ , tmTimestamp = Just 7 , tmForeignId = Nothing , tmCompetence = Just 7.5+ , tmRelevance = Just 3.8+ , tmSeverity = -255.77 , tmAttraction = 8.974 }
test/data/small.avsc view
@@ -3,11 +3,14 @@ "name": "Endpoint", "fields": [ {+ "name": "opaque",+ "type": { "name": "Opaque", "type": "fixed", "size": 16 }+ },+ { "name": "correlation", "type": "Opaque" },+ { "name": "tag", "type": ["int", "string"] },+ { "name": "ips",- "type": {- "type": "array",- "items": "string"- }+ "type": { "type": "array", "items": "string" } }, { "name": "ports",@@ -17,14 +20,8 @@ "type": "record", "name": "PortRange", "fields": [- {- "name": "start",- "type": "int"- },- {- "name": "end",- "type": "int"- }+ { "name": "start", "type": "int" },+ { "name": "end", "type": "int" } ] } }