avro 0.6.1.2 → 0.6.2.0
raw patch · 16 files changed
+276/−305 lines, 16 filesdep ~doctestPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: doctest
API changes (from Hackage documentation)
- Data.Avro.Encoding.FromAvro: instance Data.Avro.Encoding.FromAvro.FromAvro Data.ByteString.Internal.ByteString
- Data.Avro.Encoding.ToAvro: instance Data.Avro.Encoding.ToAvro.ToAvro Data.ByteString.Internal.ByteString
- Data.Avro.HasAvroSchema: instance Data.Avro.HasAvroSchema.HasAvroSchema Data.ByteString.Internal.ByteString
+ Data.Avro.Encoding.FromAvro: describeValue :: Value -> String
+ Data.Avro.Encoding.FromAvro: instance Data.Avro.Encoding.FromAvro.FromAvro Data.ByteString.Internal.Type.ByteString
+ Data.Avro.Encoding.ToAvro: instance Data.Avro.Encoding.ToAvro.ToAvro Data.ByteString.Internal.Type.ByteString
+ Data.Avro.HasAvroSchema: instance Data.Avro.HasAvroSchema.HasAvroSchema Data.ByteString.Internal.Type.ByteString
Files
- avro.cabal +4/−2
- src/Data/Avro.hs +17/−17
- src/Data/Avro/Codec.hs +6/−7
- src/Data/Avro/Deriving.hs +159/−155
- src/Data/Avro/Deriving/Lift.hs +0/−6
- src/Data/Avro/Deriving/NormSchema.hs +8/−16
- src/Data/Avro/EitherN.hs +8/−0
- src/Data/Avro/Encoding/FromAvro.hs +26/−20
- src/Data/Avro/Encoding/ToAvro.hs +5/−6
- src/Data/Avro/HasAvroSchema.hs +4/−5
- src/Data/Avro/Internal/Container.hs +1/−5
- src/Data/Avro/Internal/Get.hs +1/−9
- src/Data/Avro/Internal/Time.hs +0/−2
- src/Data/Avro/Schema/Deconflict.hs +1/−10
- src/Data/Avro/Schema/ReadSchema.hs +0/−2
- src/Data/Avro/Schema/Schema.hs +36/−43
avro.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: avro-version: 0.6.1.2+version: 0.6.2.0 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell category: Data@@ -57,7 +57,7 @@ common data-binary-ieee754 { build-depends: data-binary-ieee754 } common deepseq { build-depends: deepseq } common directory { build-depends: directory }-common doctest { build-depends: doctest >= 0.16.2 && < 0.21 }+common doctest { build-depends: doctest >= 0.16.2 && < 0.23 } common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } common extra { build-depends: extra } common fail { build-depends: fail }@@ -90,6 +90,8 @@ common config default-language: Haskell2010+ ghc-options: -Wall+ if flag(dev) ghc-options: -Wall -Werror
src/Data/Avro.hs view
@@ -68,7 +68,7 @@ import qualified Data.Avro.Schema.Schema as Schema import Data.Binary.Get (runGetOrFail) import Data.ByteString.Builder (toLazyByteString)-import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy as Lazy import Data.Tagged (untag) {- HLINT ignore "Use section" -}@@ -80,21 +80,21 @@ {-# INLINE readSchemaFromSchema #-} -- | Serialises an individual value into Avro with the schema provided.-encodeValueWithSchema :: ToAvro a => Schema -> a -> BL.ByteString+encodeValueWithSchema :: ToAvro a => Schema -> a -> Lazy.ByteString encodeValueWithSchema s = toLazyByteString . toAvro s {-# INLINE encodeValueWithSchema #-} -- | Serialises an individual value into Avro using the schema -- from its coresponding 'HasAvroSchema' instance.-encodeValue :: (HasAvroSchema a, ToAvro a) => a -> BL.ByteString+encodeValue :: (HasAvroSchema a, ToAvro a) => a -> Lazy.ByteString encodeValue a = encodeValueWithSchema (schemaOf a) a {-# INLINE encodeValue #-} -- | Deserialises an individual value from Avro.-decodeValueWithSchema :: FromAvro a => ReadSchema -> BL.ByteString -> Either String a-decodeValueWithSchema schema payload =- case runGetOrFail (getValue schema) payload of- Right (bs, _, v) -> fromAvro v+decodeValueWithSchema :: FromAvro a => ReadSchema -> Lazy.ByteString -> Either String a+decodeValueWithSchema readSchema payload =+ case runGetOrFail (getValue readSchema) payload of+ Right (_, _, v) -> fromAvro v Left (_, _, e) -> Left e -- | Deserialises an individual value from Avro using the schema from its coresponding 'HasAvroSchema'.@@ -102,7 +102,7 @@ -- __NOTE__: __This function is only to be used when reader and writes schemas are known to be the same.__ -- Because only one schema is known at this point, and it is the reader schema, -- /no decondlicting/ can be performed.-decodeValue :: forall a. (HasAvroSchema a, FromAvro a) => BL.ByteString -> Either String a+decodeValue :: forall a. (HasAvroSchema a, FromAvro a) => Lazy.ByteString -> Either String a decodeValue = decodeValueWithSchema (fromSchema (untag @a schema)) {-# INLINE decodeValue #-} @@ -112,7 +112,7 @@ -- error. This means that the consumer will get all the "good" content from -- the container until the error is detected, then this error and then the list -- is finished.-decodeContainer :: forall a. (HasAvroSchema a, FromAvro a) => BL.ByteString -> [Either String a]+decodeContainer :: forall a. (HasAvroSchema a, FromAvro a) => Lazy.ByteString -> [Either String a] decodeContainer = decodeContainerWithReaderSchema (untag @a schema) {-# INLINE decodeContainer #-} @@ -122,7 +122,7 @@ -- error. This means that the consumer will get all the "good" content from -- the container until the error is detected, then this error and then the list -- is finished.-decodeContainerWithEmbeddedSchema :: forall a. FromAvro a => BL.ByteString -> [Either String a]+decodeContainerWithEmbeddedSchema :: forall a. FromAvro a => Lazy.ByteString -> [Either String a] decodeContainerWithEmbeddedSchema payload = case Container.extractContainerValues (pure . fromSchema) (getValue >=> (either fail pure . fromAvro)) payload of Left err -> [Left err]@@ -137,7 +137,7 @@ -- error. This means that the consumer will get all the "good" content from -- the container until the error is detected, then this error and then the list -- is finished.-decodeContainerWithReaderSchema :: forall a. FromAvro a => Schema -> BL.ByteString -> [Either String a]+decodeContainerWithReaderSchema :: forall a. FromAvro a => Schema -> Lazy.ByteString -> [Either String a] decodeContainerWithReaderSchema readerSchema payload = case Container.extractContainerValues (flip deconflict readerSchema) (getValue >=> (either fail pure . fromAvro)) payload of Left err -> [Left err]@@ -148,7 +148,7 @@ -- This is particularly useful when slicing up containers into one or more -- smaller files. By extracting the original bytestring it is possible to -- avoid re-encoding data.-extractContainerValuesBytes :: BL.ByteString -> Either String (Schema, [Either String BL.ByteString])+extractContainerValuesBytes :: Lazy.ByteString -> Either String (Schema, [Either String Lazy.ByteString]) extractContainerValuesBytes = (fmap . fmap . fmap . fmap) snd . Container.extractContainerValuesBytes (pure . fromSchema) getValue {-# INLINE extractContainerValuesBytes #-}@@ -161,8 +161,8 @@ -- avoid re-encoding data. decodeContainerValuesBytes :: forall a. FromAvro a => Schema- -> BL.ByteString- -> Either String (Schema, [Either String (a, BL.ByteString)])+ -> Lazy.ByteString+ -> Either String (Schema, [Either String (a, Lazy.ByteString)]) decodeContainerValuesBytes readerSchema = Container.extractContainerValuesBytes (flip deconflict readerSchema) (getValue >=> (either fail pure . fromAvro)) {-# INLINE decodeContainerValuesBytes #-}@@ -170,19 +170,19 @@ -- | Encode chunks of values into a container, using 16 random bytes for -- the synchronization markers and a corresponding 'HasAvroSchema' schema. -- Blocks are compressed (or not) according to the given 'Codec' ('nullCodec' or 'deflateCodec').-encodeContainer :: forall a. (HasAvroSchema a, ToAvro a) => Codec -> [[a]] -> IO BL.ByteString+encodeContainer :: forall a. (HasAvroSchema a, ToAvro a) => Codec -> [[a]] -> IO Lazy.ByteString encodeContainer codec = encodeContainerWithSchema codec (untag @a schema) -- | Encode chunks of values into a container, using 16 random bytes for -- the synchronization markers. Blocks are compressed (or not) according -- to the given 'Codec' ('nullCodec' or 'deflateCodec').-encodeContainerWithSchema :: ToAvro a => Codec -> Schema -> [[a]] -> IO BL.ByteString+encodeContainerWithSchema :: ToAvro a => Codec -> Schema -> [[a]] -> IO Lazy.ByteString encodeContainerWithSchema codec sch xss = do sync <- Container.newSyncBytes return $ encodeContainerWithSync codec sch sync xss -- |Encode chunks of objects into a container, using the provided -- ByteString as the synchronization markers.-encodeContainerWithSync :: ToAvro a => Codec -> Schema -> BL.ByteString -> [[a]] -> BL.ByteString+encodeContainerWithSync :: ToAvro a => Codec -> Schema -> Lazy.ByteString -> [[a]] -> Lazy.ByteString encodeContainerWithSync = Container.packContainerValuesWithSync' toAvro {-# INLINE encodeContainerWithSync #-}
src/Data/Avro/Codec.hs view
@@ -12,11 +12,10 @@ import Codec.Compression.Zlib.Internal as Zlib import qualified Data.Binary.Get as G import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy as Lazy -- | Block decompression function for blocks of Avro.-type Decompress a = LBS.ByteString -> G.Get a -> Either String a+type Decompress a = Lazy.ByteString -> G.Get a -> Either String a -- | A `Codec` allows for compression/decompression of a block in an -- Avro container according to the Avro spec.@@ -33,7 +32,7 @@ , codecDecompress :: forall a. Decompress a -- | Compresses a lazy stream of bytes.- , codecCompress :: LBS.ByteString -> LBS.ByteString+ , codecCompress :: Lazy.ByteString -> Lazy.ByteString } -- | `nullCodec` specifies @null@ required by Avro spec.@@ -61,7 +60,7 @@ , codecCompress = deflateCompress } -deflateCompress :: LBS.ByteString -> LBS.ByteString+deflateCompress :: Lazy.ByteString -> Lazy.ByteString deflateCompress = Zlib.compress Zlib.rawFormat Zlib.defaultCompressParams @@ -69,12 +68,12 @@ -- | Internal type to help construct a lazy list of -- decompressed bytes interleaved with errors if any. data Chunk- = ChunkRest LBS.ByteString+ = ChunkRest Lazy.ByteString | ChunkBytes ByteString | ChunkError Zlib.DecompressError -deflateDecompress :: forall a. LBS.ByteString -> G.Get a -> Either String a+deflateDecompress :: forall a. Lazy.ByteString -> G.Get a -> Either String a deflateDecompress bytes parser = do let -- N.B. this list is lazily created which allows us to
src/Data/Avro/Deriving.hs view
@@ -7,10 +7,8 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -{- HLINT ignore "Avoid lambda using `infix`" -}- -- | This module lets us derive Haskell types from an Avro schema that--- can be serialized/deserialzed to Avro.+-- can be serialized/deserialized to Avro. module Data.Avro.Deriving ( -- * Deriving options DeriveOptions(..)@@ -34,55 +32,45 @@ , deriveAvro' -- * Re-exporting a quasiquoter for raw string literals- , r+ , QQ.r ) where -import Control.Monad (join)-import Control.Monad.Identity (Identity)-import Data.Aeson (eitherDecode)-import qualified Data.Aeson as J-import Data.Avro hiding (decode, encode)-import Data.Avro.Encoding.ToAvro (ToAvro (..))-import Data.Avro.Internal.EncodeRaw (putI)-import Data.Avro.Schema.Schema as S-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Char (isAlphaNum)+import Control.Monad ( join )+import Control.Monad.Identity ( Identity )++import Data.Aeson ( eitherDecode )+import Data.ByteString ( ByteString )+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy import qualified Data.Foldable as Foldable-import Data.Int-import Data.List.NonEmpty (NonEmpty ((:|)))-import qualified Data.List.NonEmpty as NE-import Data.Map (Map)-import Data.Maybe (fromMaybe)-import Data.Semigroup ((<>))+import Data.Text (Text) import qualified Data.Text as Text-import Data.Time (Day, DiffTime, LocalTime, UTCTime)-import Data.UUID (UUID)-import Text.RawString.QQ (r)+import qualified Data.Vector as V+import Data.Char ( isAlphaNum )+import Data.Int ( Int32, Int64 )+import Data.Map ( Map )+import Data.Time ( Day, DiffTime, LocalTime, UTCTime )+import Data.UUID ( UUID ) -import qualified Data.Avro.Encoding.FromAvro as AV+import GHC.Generics ( Generic )+import qualified Language.Haskell.TH as TH+import Language.Haskell.TH.Syntax+import qualified Text.RawString.QQ as QQ -import GHC.Generics (Generic) -import Language.Haskell.TH as TH hiding (notStrict)-import Language.Haskell.TH.Lib as TH hiding (notStrict)-import Language.Haskell.TH.Syntax+import qualified Data.Avro.Encoding.FromAvro as AV+import Data.Avro.Encoding.ToAvro ( ToAvro(..) )+import Data.Avro.HasAvroSchema ( HasAvroSchema )+import qualified Data.Avro.HasAvroSchema+import Data.Avro.Internal.EncodeRaw ( putI )+import Data.Avro.Schema.Schema ( Schema, TypeName, Field )+import qualified Data.Avro.Schema.Schema as Schema+import Data.Avro.Deriving.Lift ()+import Data.Avro.Deriving.NormSchema+import Data.Avro.EitherN -import Data.Avro.Deriving.NormSchema-import Data.Avro.EitherN -import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBSC8-import qualified Data.HashMap.Strict as HM-import qualified Data.Set as S-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Vector as V--import Data.Avro.Deriving.Lift ()- -- | How to treat Avro namespaces in the generated Haskell types. data NamespaceBehavior = IgnoreNamespaces@@ -103,7 +91,7 @@ -- @Com'example'Foo@. If @Foo@ had a field called @bar@, the -- generated Haskell record would have the field -- @com'example'FooBar@.- | Custom (T.Text -> [T.Text] -> T.Text)+ | Custom (Text -> [Text] -> Text) -- ^ Provide a custom mapping from the name of the Avro type and -- its namespace that will be used to generate Haskell types and -- fields.@@ -127,7 +115,7 @@ { -- | How to build field names for generated data types. The first -- argument is the type name to use as a prefix, rendered -- according to the 'namespaceBehavior' setting.- fieldNameBuilder :: Text -> Field -> T.Text+ fieldNameBuilder :: Text -> Field -> Text -- | Determines field representation of generated data types , fieldRepresentation :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)@@ -146,6 +134,7 @@ -- , namespaceBehavior = 'IgnoreNamespaces' -- } -- @+defaultDeriveOptions :: DeriveOptions defaultDeriveOptions = DeriveOptions { fieldNameBuilder = mkPrefixedFieldName , fieldRepresentation = mkLazyField@@ -160,9 +149,9 @@ -- @ -- Person { personFirstName :: Text } -- @-mkPrefixedFieldName :: Text -> Field -> T.Text+mkPrefixedFieldName :: Text -> Field -> Text mkPrefixedFieldName prefix fld =- sanitiseName $ updateFirst T.toLower prefix <> updateFirst T.toUpper (fldName fld)+ sanitiseName $ updateFirst Text.toLower prefix <> updateFirst Text.toUpper (Schema.fldName fld) -- | Marks any field as non-strict in the generated data types. mkLazyField :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)@@ -180,19 +169,19 @@ else (LazyField, NonUnpackedField) where unpackedness =- case S.fldType field of- S.Null -> NonUnpackedField- S.Boolean -> NonUnpackedField+ case Schema.fldType field of+ Schema.Null -> NonUnpackedField+ Schema.Boolean -> NonUnpackedField _ -> UnpackedField shouldStricten =- case S.fldType field of- S.Null -> True- S.Boolean -> True- S.Int _ -> True- S.Long _ -> True- S.Float -> True- S.Double -> True+ case Schema.fldType field of+ Schema.Null -> True+ Schema.Boolean -> True+ Schema.Int _ -> True+ Schema.Long _ -> True+ Schema.Float -> True+ Schema.Double -> True _ -> False -- | Generates a field name that matches the field name in schema@@ -206,7 +195,7 @@ -- @ -- You may want to enable 'DuplicateRecordFields' if you want to use this method. mkAsIsFieldName :: Text -> Field -> Text-mkAsIsFieldName _ = sanitiseName . updateFirst T.toLower . fldName+mkAsIsFieldName _ = sanitiseName . updateFirst Text.toLower . Schema.fldName -- | Derives Haskell types from the given Avro schema file. These -- Haskell types support both reading and writing to Avro.@@ -273,7 +262,7 @@ deriveAvro' = deriveAvroWithOptions' defaultDeriveOptions -- | Same as 'deriveAvro' but takes a ByteString rather than FilePath-deriveAvroFromByteString :: LBS.ByteString -> Q [Dec]+deriveAvroFromByteString :: Lazy.ByteString -> Q [Dec] deriveAvroFromByteString bs = case eitherDecode bs of Right schema -> deriveAvroWithOptions' defaultDeriveOptions schema Left err -> fail $ "Unable to generate Avro from bytestring: " <> err@@ -288,7 +277,7 @@ makeSchema :: FilePath -> Q Exp makeSchema p = readSchema p >>= lift -makeSchemaFromByteString :: LBS.ByteString -> Q Exp+makeSchemaFromByteString :: Lazy.ByteString -> Q Exp makeSchemaFromByteString bs = case eitherDecode @Schema bs of Right schema -> lift schema Left err -> fail $ "Unable to generate Avro Schema from bytestring: " <> err@@ -296,9 +285,8 @@ makeSchemaFrom :: FilePath -> Text -> Q Exp makeSchemaFrom p name = do s <- readSchema p-- case subdefinition s name of- Nothing -> fail $ "No such entity '" <> T.unpack name <> "' defined in " <> p+ case Schema.subdefinition s name of+ Nothing -> fail $ "No such entity '" <> Text.unpack name <> "' defined in " <> p Just ss -> lift ss readSchema :: FilePath -> Q Schema@@ -315,29 +303,29 @@ badValueNew v t = Left $ "Unexpected value for '" <> t <> "': " <> show v genFromValue :: NamespaceBehavior -> Schema -> Q [Dec]-genFromValue namespaceBehavior (S.Enum n _ _ _ ) =- [d| instance AV.FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where+genFromValue namespaceBehavior (Schema.Enum n _ _ _ ) =+ [d| instance AV.FromAvro $(TH.conT $ mkDataTypeName namespaceBehavior n) where fromAvro (AV.Enum _ i _) = $([| pure . toEnum|]) i- fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ S.renderFullname n)|] ) value+ fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ Schema.renderFullname n)|] ) value |]-genFromValue namespaceBehavior (S.Record n _ _ fs) =- [d| instance AV.FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where+genFromValue namespaceBehavior (Schema.Record n _ _ fs) =+ [d| instance AV.FromAvro $(TH.conT $ mkDataTypeName namespaceBehavior n) where fromAvro (AV.Record _ r) = $(genFromAvroNewFieldsExp (mkDataTypeName namespaceBehavior n) fs) r- fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ S.renderFullname n)|] ) value+ fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ Schema.renderFullname n)|] ) value |]-genFromValue namespaceBehavior (S.Fixed n _ s _) =- [d| instance AV.FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where+genFromValue namespaceBehavior (Schema.Fixed n _ s _) =+ [d| instance AV.FromAvro $(TH.conT $ mkDataTypeName namespaceBehavior n) where fromAvro (AV.Fixed _ v)- | BS.length v == s = pure $ $(conE (mkDataTypeName namespaceBehavior n)) v- fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ S.renderFullname n)|] ) value+ | Strict.length v == s = pure $ $(TH.conE (mkDataTypeName namespaceBehavior n)) v+ fromAvro value = $( [|\v -> badValueNew v $(mkTextLit $ Schema.renderFullname n)|] ) value |] genFromValue _ _ = pure [] genFromAvroNewFieldsExp :: Name -> [Field] -> Q Exp genFromAvroNewFieldsExp n xs = [| \r ->- $(let ctor = [| pure $(conE n) |]+ $(let ctor = [| pure $(TH.conE n) |] in foldl (\expr (i, _) -> [| $expr <*> AV.fromAvro (r V.! i) |]) ctor (zip [(0 :: Int)..] xs) ) |]@@ -346,14 +334,14 @@ genHasAvroSchema :: NamespaceBehavior -> Schema -> Q [Dec] genHasAvroSchema namespaceBehavior s = do- let sname = mkSchemaValueName namespaceBehavior (name s)+ let sname = mkSchemaValueName namespaceBehavior (Schema.name s) sdef <- schemaDef sname s idef <- hasAvroSchema sname pure (sdef <> idef) where hasAvroSchema sname =- [d| instance HasAvroSchema $(conT $ mkDataTypeName namespaceBehavior (name s)) where- schema = pure $(varE sname)+ [d| instance HasAvroSchema $(TH.conT $ mkDataTypeName namespaceBehavior (Schema.name s)) where+ schema = pure $(TH.varE sname) |] newNames :: String@@ -366,40 +354,40 @@ ------------------------- ToAvro ------------------------------------------------ genToAvro :: DeriveOptions -> Schema -> Q [Dec]-genToAvro opts s@(S.Enum n _ _ _) =+genToAvro opts (Schema.Enum n _ _ _) = encodeAvroInstance (mkSchemaValueName (namespaceBehavior opts) n) where- encodeAvroInstance sname =- [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where+ encodeAvroInstance _ =+ [d| instance ToAvro $(TH.conT $ mkDataTypeName (namespaceBehavior opts) n) where toAvro = $([| \_ x -> putI (fromEnum x) |]) |] -genToAvro opts s@(S.Record n _ _ fs) =+genToAvro opts (Schema.Record n _ _ fs) = encodeAvroInstance (mkSchemaValueName (namespaceBehavior opts) n) where encodeAvroInstance sname =- [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where+ [d| instance ToAvro $(TH.conT $ mkDataTypeName (namespaceBehavior opts) n) where toAvro = $(encodeAvroFieldsExp sname) |]- encodeAvroFieldsExp sname = do+ encodeAvroFieldsExp _ = do names <- newNames "p_" (length fs)- wn <- varP <$> newName "_"- let con = conP (mkDataTypeName (namespaceBehavior opts) n) (varP <$> names)- lamE [wn, con]- [| mconcat $( let build (fld, n) = [| toAvro (fldType fld) $(varE n) |]- in listE $ build <$> zip fs names+ wn <- TH.varP <$> newName "_"+ let con = TH.conP (mkDataTypeName (namespaceBehavior opts) n) (TH.varP <$> names)+ TH.lamE [wn, con]+ [| mconcat $( let build (fld, nm) = [| toAvro (Schema.fldType fld) $(TH.varE nm) |]+ in TH.listE $ build <$> zip fs names ) |] -genToAvro opts s@(S.Fixed n _ _ _) =+genToAvro opts (Schema.Fixed n _ _ _) = encodeAvroInstance (mkSchemaValueName (namespaceBehavior opts) n) where encodeAvroInstance sname =- [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where+ [d| instance ToAvro $(TH.conT $ mkDataTypeName (namespaceBehavior opts) n) where toAvro = $(do x <- newName "x" wc <- newName "_"- lamE [varP wc, conP (mkDataTypeName (namespaceBehavior opts) n) [varP x]] [| toAvro $(varE sname) $(varE x) |])+ TH.lamE [TH.varP wc, TH.conP (mkDataTypeName (namespaceBehavior opts) n) [TH.varP x]] [| toAvro $(TH.varE sname) $(TH.varE x) |]) |] genToAvro _ _ = pure [] @@ -421,79 +409,98 @@ sn _ d = d genType :: DeriveOptions -> Schema -> Q [Dec]-genType opts (S.Record n _ _ fs) = do+genType opts (Schema.Record n _ _ fs) = do flds <- traverse (mkField opts n) fs let dname = mkDataTypeName (namespaceBehavior opts) n sequenceA [genDataType dname flds]-genType opts (S.Enum n _ _ vs) = do+genType opts (Schema.Enum n _ _ vs) = do let dname = mkDataTypeName (namespaceBehavior opts) n sequenceA [genEnum dname (mkAdtCtorName (namespaceBehavior opts) n <$> V.toList vs)]-genType opts (S.Fixed n _ s _) = do+genType opts (Schema.Fixed n _ _ _) = do let dname = mkDataTypeName (namespaceBehavior opts) n sequenceA [genNewtype dname] genType _ _ = pure [] -mkFieldTypeName :: NamespaceBehavior -> S.Schema -> Q TH.Type+mkFieldTypeName :: NamespaceBehavior -> Schema -> Q TH.Type mkFieldTypeName namespaceBehavior = \case- S.Null -> [t| () |]- S.Boolean -> [t| Bool |]+ Schema.Null -> [t| () |]+ Schema.Boolean -> [t| Bool |] - S.Long (Just (DecimalL (Decimal p s)))- -> [t| Decimal $(litT $ numTyLit p) $(litT $ numTyLit s) |]- S.Long (Just TimeMicros)- -> [t| DiffTime |]- S.Long (Just TimestampMicros)- -> [t| UTCTime |]- S.Long (Just TimestampMillis)- -> [t| UTCTime |]- S.Long (Just LocalTimestampMillis)- -> [t| LocalTime |]- S.Long (Just LocalTimestampMicros)- -> [t| LocalTime |]- S.Long Nothing -> [t| Int64 |]+ Schema.Long (Just (Schema.DecimalL (Schema.Decimal p s)))+ -> [t| Schema.Decimal $(TH.litT $ TH.numTyLit p) $(TH.litT $ TH.numTyLit s) |]+ Schema.Long (Just Schema.TimeMicros)+ -> [t| DiffTime |]+ Schema.Long (Just Schema.TimestampMicros)+ -> [t| UTCTime |]+ Schema.Long (Just Schema.TimestampMillis)+ -> [t| UTCTime |]+ Schema.Long (Just Schema.LocalTimestampMillis)+ -> [t| LocalTime |]+ Schema.Long (Just Schema.LocalTimestampMicros)+ -> [t| LocalTime |]+ Schema.Long Nothing+ -> [t| Int64 |] - S.Int (Just Date) -> [t| Day |]- S.Int (Just TimeMillis)- -> [t| DiffTime |]- S.Int _ -> [t| Int32 |]- S.Float -> [t| Float |]- S.Double -> [t| Double |]- S.Bytes _ -> [t| ByteString |]- S.String Nothing -> [t| Text |]- S.String (Just UUID) -> [t| UUID |]- S.Union branches -> union (Foldable.toList branches)- S.Record n _ _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n) |]- S.Map x -> [t| Map Text $(go x) |]- S.Array x -> [t| [$(go x)] |]- S.NamedType n -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|]- S.Fixed n _ _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|]- S.Enum n _ _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|]- where go = mkFieldTypeName namespaceBehavior- union = \case- [] ->- error "Empty union types are not supported"- [x] -> [t| Identity $(go x) |]- [Null, x] -> [t| Maybe $(go x) |]- [x, Null] -> [t| Maybe $(go x) |]- [x, y] -> [t| Either $(go x) $(go y) |]- [a, b, c] -> [t| Either3 $(go a) $(go b) $(go c) |]- [a, b, c, d] -> [t| Either4 $(go a) $(go b) $(go c) $(go d) |]- [a, b, c, d, e] -> [t| Either5 $(go a) $(go b) $(go c) $(go d) $(go e) |]- [a, b, c, d, e, f] -> [t| Either6 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) |]- [a, b, c, d, e, f, g] -> [t| Either7 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g)|]- [a, b, c, d, e, f, g, h] -> [t| Either8 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h)|]- [a, b, c, d, e, f, g, h, i] -> [t| Either9 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h) $(go i)|]- [a, b, c, d, e, f, g, h, i, j] -> [t| Either10 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h) $(go i) $(go j)|]- ls ->- error $ "Unions with more than 10 elements are not yet supported: Union has " <> (show . length) ls <> " elements"+ Schema.Int (Just Schema.Date)+ -> [t| Day |]+ Schema.Int (Just Schema.TimeMillis)+ -> [t| DiffTime |]+ Schema.Int _+ -> [t| Int32 |]+ Schema.Float+ -> [t| Float |]+ Schema.Double+ -> [t| Double |]+ Schema.Bytes _+ -> [t| ByteString |]+ Schema.String Nothing+ -> [t| Text |]+ Schema.String (Just Schema.UUID) ->+ [t| UUID |]+ Schema.Union branches+ -> union (Foldable.toList branches)+ Schema.Record n _ _ _+ -> [t| $(TH.conT $ mkDataTypeName namespaceBehavior n) |]+ Schema.Map x+ -> [t| Map Text $(go x) |]+ Schema.Array x+ -> [t| [$(go x)] |]+ Schema.NamedType n+ -> [t| $(TH.conT $ mkDataTypeName namespaceBehavior n)|]+ Schema.Fixed n _ _ _+ -> [t| $(TH.conT $ mkDataTypeName namespaceBehavior n)|]+ Schema.Enum n _ _ _+ -> [t| $(TH.conT $ mkDataTypeName namespaceBehavior n)|]+ where+ go = mkFieldTypeName namespaceBehavior+ union = \case+ []+ -> error "Empty union types are not supported"+ [x]+ -> [t| Identity $(go x) |]+ [Schema.Null, x]+ -> [t| Maybe $(go x) |]+ [x, Schema.Null]+ -> [t| Maybe $(go x) |]+ [x, y] -> [t| Either $(go x) $(go y) |]+ [a, b, c] -> [t| Either3 $(go a) $(go b) $(go c) |]+ [a, b, c, d] -> [t| Either4 $(go a) $(go b) $(go c) $(go d) |]+ [a, b, c, d, e] -> [t| Either5 $(go a) $(go b) $(go c) $(go d) $(go e) |]+ [a, b, c, d, e, f] -> [t| Either6 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) |]+ [a, b, c, d, e, f, g] -> [t| Either7 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g)|]+ [a, b, c, d, e, f, g, h] -> [t| Either8 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h)|]+ [a, b, c, d, e, f, g, h, i] -> [t| Either9 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h) $(go i)|]+ [a, b, c, d, e, f, g, h, i, j] -> [t| Either10 $(go a) $(go b) $(go c) $(go d) $(go e) $(go f) $(go g) $(go h) $(go i) $(go j)|]+ ls ->+ error $ "Unions with more than 10 elements are not yet supported: Union has " <> (show . length) ls <> " elements" updateFirst :: (Text -> Text) -> Text -> Text updateFirst f t =- let (l, ls) = T.splitAt 1 t+ let (l, ls) = Text.splitAt 1 t in f l <> ls decodeSchema :: FilePath -> IO (Either String Schema)-decodeSchema p = eitherDecode <$> LBS.readFile p+decodeSchema p = eitherDecode <$> Lazy.readFile p mkAdtCtorName :: NamespaceBehavior -> TypeName -> Text -> Name mkAdtCtorName namespaceBehavior prefix nm =@@ -505,7 +512,7 @@ sanitiseName :: Text -> Text sanitiseName = let valid c = isAlphaNum c || c == '\'' || c == '_'- in T.concat . T.split (not . valid)+ in Text.concat . Text.split (not . valid) -- | Renders a fully qualified Avro name to a valid Haskell -- identifier. This does not change capitalization—make sure to@@ -526,7 +533,7 @@ -- ^ The name to transform into a valid Haskell -- identifier. -> Text-renderName namespaceBehavior (TN name namespace) = case namespaceBehavior of+renderName namespaceBehavior (Schema.TN name namespace) = case namespaceBehavior of HandleNamespaces -> Text.intercalate "'" $ namespace <> [name] IgnoreNamespaces -> name Custom f -> f name namespace@@ -540,11 +547,11 @@ mkDataTypeName' :: Text -> Name mkDataTypeName' =- mkTextName . sanitiseName . updateFirst T.toUpper . T.takeWhileEnd (/='.')+ mkTextName . sanitiseName . updateFirst Text.toUpper . Text.takeWhileEnd (/='.') mkField :: DeriveOptions -> TypeName -> Field -> Q VarStrictType mkField opts typeName field = do- ftype <- mkFieldTypeName (namespaceBehavior opts) (fldType field)+ ftype <- mkFieldTypeName (namespaceBehavior opts) (Schema.fldType field) let prefix = renderName (namespaceBehavior opts) typeName fName = mkTextName $ fieldNameBuilder opts prefix field (fieldStrictness, fieldUnpackedness) =@@ -624,10 +631,7 @@ #endif mkTextName :: Text -> Name-mkTextName = mkName . T.unpack--mkLit :: String -> ExpQ-mkLit = litE . StringL+mkTextName = mkName . Text.unpack -mkTextLit :: Text -> ExpQ-mkTextLit = litE . StringL . T.unpack+mkTextLit :: Text -> TH.ExpQ+mkTextLit = TH.litE . StringL . Text.unpack
src/Data/Avro/Deriving/Lift.hs view
@@ -7,12 +7,6 @@ module Data.Avro.Deriving.Lift where import qualified Data.Avro.Schema.Schema as Schema-import qualified Data.ByteString as ByteString-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as Text-import qualified Data.Vector as Vector-import qualified Language.Haskell.TH.Lib as TH-import qualified Language.Haskell.TH.Syntax as TH import Language.Haskell.TH.Syntax (Lift (..)) import Instances.TH.Lift ()
src/Data/Avro/Deriving/NormSchema.hs view
@@ -6,15 +6,7 @@ import Control.Monad.State.Strict import Data.Avro.Schema.Schema import qualified Data.Foldable as Foldable-import qualified Data.List as L-import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map.Strict as M-import Data.Maybe (catMaybes, fromMaybe)-import Data.Semigroup ((<>))-import qualified Data.Set as S-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Vector as V -- | Extracts all the records from the schema (flattens the schema) -- Named types get resolved when needed to include at least one "inlined"@@ -23,10 +15,10 @@ -- namespaces (including inlined into full names) will be ignored -- during names resolution. extractDerivables :: Schema -> [Schema]-extractDerivables s = flip evalState state . normSchema . snd <$> rawRecs+extractDerivables s = flip evalState initial . normSchema . snd <$> rawRecs where rawRecs = getTypes s- state = M.fromList rawRecs+ initial = M.fromList rawRecs getTypes :: Schema -> [(TypeName, Schema)] getTypes rec = case rec of@@ -60,15 +52,15 @@ Array s -> Array <$> normSchema s Map s -> Map <$> normSchema s Union l -> Union <$> traverse normSchema l- r@Record{name = tn} -> do- modify' (M.insert tn (NamedType tn))+ Record { name } -> do+ modify' (M.insert name (NamedType name)) flds <- mapM (\fld -> setType fld <$> normSchema (fldType fld)) (fields r) pure $ r { fields = flds }- r@Fixed{name = tn} -> do- modify' (M.insert tn (NamedType tn))+ Fixed { name } -> do+ modify' (M.insert name (NamedType name)) pure r- r@Enum{name = tn} -> do- modify' (M.insert tn (NamedType tn))+ Enum { name } -> do+ modify' (M.insert name (NamedType name)) pure r s -> pure s where
src/Data/Avro/EitherN.hs view
@@ -443,6 +443,7 @@ fromAvro (AV.Union _ 1 b) = E3_2 <$> fromAvro b fromAvro (AV.Union _ 2 c) = E3_3 <$> fromAvro c fromAvro (AV.Union _ n _) = Left ("Unable to decode Either3 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either3 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d) => FromAvro (Either4 a b c d) where fromAvro (AV.Union _ 0 a) = E4_1 <$> fromAvro a@@ -450,6 +451,7 @@ fromAvro (AV.Union _ 2 c) = E4_3 <$> fromAvro c fromAvro (AV.Union _ 3 d) = E4_4 <$> fromAvro d fromAvro (AV.Union _ n _) = Left ("Unable to decode Either4 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either4 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e) => FromAvro (Either5 a b c d e) where fromAvro (AV.Union _ 0 a) = E5_1 <$> fromAvro a@@ -458,6 +460,7 @@ fromAvro (AV.Union _ 3 d) = E5_4 <$> fromAvro d fromAvro (AV.Union _ 4 e) = E5_5 <$> fromAvro e fromAvro (AV.Union _ n _) = Left ("Unable to decode Either5 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either5 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f) => FromAvro (Either6 a b c d e f) where fromAvro (AV.Union _ 0 a) = E6_1 <$> fromAvro a@@ -467,6 +470,7 @@ fromAvro (AV.Union _ 4 e) = E6_5 <$> fromAvro e fromAvro (AV.Union _ 5 f) = E6_6 <$> fromAvro f fromAvro (AV.Union _ n _) = Left ("Unable to decode Either6 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either6 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g) => FromAvro (Either7 a b c d e f g) where fromAvro (AV.Union _ 0 a) = E7_1 <$> fromAvro a@@ -477,6 +481,7 @@ fromAvro (AV.Union _ 5 f) = E7_6 <$> fromAvro f fromAvro (AV.Union _ 6 g) = E7_7 <$> fromAvro g fromAvro (AV.Union _ n _) = Left ("Unable to decode Either7 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either7 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h) => FromAvro (Either8 a b c d e f g h) where fromAvro (AV.Union _ 0 a) = E8_1 <$> fromAvro a@@ -488,6 +493,7 @@ fromAvro (AV.Union _ 6 g) = E8_7 <$> fromAvro g fromAvro (AV.Union _ 7 h) = E8_8 <$> fromAvro h fromAvro (AV.Union _ n _) = Left ("Unable to decode Either8 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either8 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h, FromAvro i) => FromAvro (Either9 a b c d e f g h i) where fromAvro (AV.Union _ 0 a) = E9_1 <$> fromAvro a@@ -500,6 +506,7 @@ fromAvro (AV.Union _ 7 h) = E9_8 <$> fromAvro h fromAvro (AV.Union _ 8 i) = E9_9 <$> fromAvro i fromAvro (AV.Union _ n _) = Left ("Unable to decode Either9 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either9 from value " <> AV.describeValue n) instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h, FromAvro i, FromAvro j) => FromAvro (Either10 a b c d e f g h i j) where fromAvro (AV.Union _ 0 a) = E10_1 <$> fromAvro a@@ -513,6 +520,7 @@ fromAvro (AV.Union _ 8 i) = E10_9 <$> fromAvro i fromAvro (AV.Union _ 9 j) = E10_10 <$> fromAvro j fromAvro (AV.Union _ n _) = Left ("Unable to decode Either10 from a position #" <> show n)+ fromAvro n = Left ("Unable to decode Either10 from value " <> AV.describeValue n) putIndexedValue :: ToAvro a => Int -> V.Vector Schema -> a -> Builder putIndexedValue i opts x = putI i <> toAvro (V.unsafeIndex opts i) x
src/Data/Avro/Encoding/FromAvro.hs view
@@ -8,34 +8,29 @@ -- ** For internal use , Value(..) , getValue++, describeValue ) where import Control.DeepSeq (NFData)-import Control.Monad (forM, replicateM)+import Control.Monad (forM, replicateM, void, when) import Control.Monad.Identity (Identity (..))-import Control.Monad.ST (ST)-import qualified Data.Aeson as A import qualified Data.Avro.Internal.Get as Get import Data.Avro.Internal.Time import Data.Avro.Schema.Decimal as D import Data.Avro.Schema.ReadSchema (ReadSchema) import qualified Data.Avro.Schema.ReadSchema as ReadSchema import qualified Data.Avro.Schema.Schema as Schema-import Data.Binary.Get (Get, getByteString, runGetOrFail)-import qualified Data.ByteString as B+import Data.Binary.Get (Get, getByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL-import qualified Data.Char as Char import Data.Foldable (traverse_) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Int-import Data.List.NonEmpty (NonEmpty) import qualified Data.Map as Map import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Time as Time import qualified Data.UUID as UUID@@ -76,7 +71,7 @@ describeValue :: Value -> String describeValue = \case Null -> "Null"- Boolean b -> "Boolean"+ Boolean _ -> "Boolean" Int s _ -> "Int (" <> show s <> ")" Long s _ -> "Long (" <> show s <> ")" Float s _ -> "Float (" <> show s <> ")"@@ -200,7 +195,6 @@ Right $ millisToLocalTime (toInteger n) fromAvro x = Left ("Unable to decode LocalTime from: " <> show (describeValue x)) {-# INLINE fromAvro #-}- instance FromAvro a => FromAvro [a] where fromAvro (Array vec) = mapM fromAvro $ V.toList vec@@ -306,21 +300,33 @@ v <- getField env t pure $ Union sch ix v ++-- | Read a Map from blocks of KV pairs getKVBlocks :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get [[(Text, Value)]] getKVBlocks env t = do- blockLength <- abs <$> Get.getLong- if blockLength == 0- then return []- else do vs <- replicateM (fromIntegral blockLength) ((,) <$> Get.getString <*> getField env t)- (vs:) <$> getKVBlocks env t+ lengthIndicator <- Get.getLong+ if lengthIndicator == 0 then+ return []+ else do+ -- When the block's count is negative, its absolute value is used, and the count is followed immediately by a+ -- long block size indicating the number of bytes in the block.+ when (lengthIndicator < 0) $ void Get.getLong -- number of bytes in block (ignored)+ let blockLength = abs lengthIndicator+ vs <- replicateM (fromIntegral blockLength) ((,) <$> Get.getString <*> getField env t)+ (vs:) <$> getKVBlocks env t {-# INLINE getKVBlocks #-} +-- | Read an array from blocks. getBlocksOf :: HashMap Schema.TypeName ReadSchema -> ReadSchema -> Get [[Value]] getBlocksOf env t = do- blockLength <- abs <$> Get.getLong- if blockLength == 0- then return []+ lengthIndicator <- Get.getLong+ if lengthIndicator == 0 then+ return [] else do+ -- When the block's count is negative, its absolute value is used, and the count is followed immediately by a+ -- long block size indicating the number of bytes in the block.+ when (lengthIndicator < 0) $ void Get.getLong -- number of bytes in block (ignored)+ let blockLength = abs lengthIndicator vs <- replicateM (fromIntegral blockLength) (getField env t) (vs:) <$> getBlocksOf env t @@ -329,7 +335,7 @@ moos <- fmap concat . forM fs $ \f -> case ReadSchema.fldStatus f of ReadSchema.Ignored -> [] <$ getField env (ReadSchema.fldType f)- ReadSchema.AsIs i -> (\f -> [(i,f)]) <$> getField env (ReadSchema.fldType f)+ ReadSchema.AsIs i -> (\fld -> [(i,fld)]) <$> getField env (ReadSchema.fldType f) ReadSchema.Defaulted i v -> pure [(i, convertValue v)] --undefined return $ V.create $ do
src/Data/Avro/Encoding/ToAvro.hs view
@@ -7,8 +7,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -module Data.Avro.Encoding.ToAvro-where+module Data.Avro.Encoding.ToAvro where import Control.Monad.Identity (Identity (..)) import qualified Data.Array as Ar@@ -29,13 +28,11 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromJust) import Data.Text (Text)-import qualified Data.Text as T import qualified Data.Text.Encoding as T #if MIN_VERSION_text(2,0,0) import qualified Data.Text.Foreign as T #endif import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL import qualified Data.Time as Time import qualified Data.UUID as UUID import qualified Data.Vector as V@@ -52,7 +49,7 @@ record :: Schema -> [(Text, Encoder)] -> Builder record (S.Record _ _ _ fs) vs =- foldMap (mapField provided) fs+ foldMap (mapField provided) fs where provided :: HashMap Text Encoder provided = HashMap.fromList vs@@ -65,6 +62,8 @@ mapField :: HashMap Text Encoder -> S.Field -> Builder mapField env fld = maybe (failField fld) (flip runEncoder (S.fldType fld)) (HashMap.lookup (S.fldName fld) env)+record _ _ =+ error "Error in Schema passed to record. It was not of type Record." -- | Describes how to encode Haskell data types into Avro bytes class ToAvro a where@@ -251,7 +250,7 @@ toAvro s _ = error ("Unable to encode Maybe as " <> show s) instance (ToAvro a) => ToAvro (Identity a) where- toAvro (S.Union opts) e@(Identity a) =+ toAvro (S.Union opts) (Identity a) = if V.length opts == 1 then putI 0 <> toAvro (V.unsafeIndex opts 0) a else error ("Unable to encode Identity as a single-value union: " <> show opts)
src/Data/Avro/HasAvroSchema.hs view
@@ -8,9 +8,8 @@ import qualified Data.Array as Ar import Data.Avro.Schema.Decimal as D import Data.Avro.Schema.Schema as S-import qualified Data.ByteString as B-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as Strict+import qualified Data.ByteString.Lazy as Lazy import qualified Data.HashMap.Strict as HashMap import Data.Int import Data.Ix (Ix)@@ -81,10 +80,10 @@ instance HasAvroSchema TL.Text where schema = Tagged S.String' -instance HasAvroSchema B.ByteString where+instance HasAvroSchema Strict.ByteString where schema = Tagged S.Bytes' -instance HasAvroSchema BL.ByteString where+instance HasAvroSchema Lazy.ByteString where schema = Tagged S.Bytes' instance (KnownNat p, KnownNat s) => HasAvroSchema (D.Decimal p s) where
src/Data/Avro/Internal/Container.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}@@ -23,15 +22,12 @@ import Data.Binary.Get (Get) import qualified Data.Binary.Get as Get import Data.ByteString (ByteString)-import qualified Data.ByteString as B import Data.ByteString.Builder (Builder, lazyByteString, toLazyByteString) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC-import Data.Either (isRight) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Int (Int32, Int64)-import Data.List (foldl', unfoldr) import qualified Data.Map.Strict as Map import Data.Text (Text) import System.Random.TF.Init (initTFGen)@@ -97,7 +93,7 @@ decodeRawBlocks :: BL.ByteString -> Either String (Schema, [Either String (Int, BL.ByteString)]) decodeRawBlocks bs = case Get.runGetOrFail getContainerHeader bs of- Left (bs', _, err) -> Left err+ Left (_, _, err) -> Left err Right (bs', _, containerHeader@ContainerHeader {..}) -> let blocks = allBlocks containerHeader bs' in Right (containedSchema, blocks)
src/Data/Avro/Internal/Get.hs view
@@ -11,24 +11,16 @@ module Data.Avro.Internal.Get where -import qualified Codec.Compression.Zlib as Z-import Control.Monad (replicateM, when)+import Control.Monad (replicateM) import Data.Binary.Get (Get) import qualified Data.Binary.Get as G import Data.Binary.IEEE754 as IEEE import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BC import Data.Int-import qualified Data.Map as Map-import Data.Maybe-import Data.Monoid ((<>))-import qualified Data.Set as Set import Data.Text (Text)-import qualified Data.Text as Text import qualified Data.Text.Encoding as Text-import qualified Data.Vector as V import Prelude as P import Data.Avro.Internal.DecodeRaw
src/Data/Avro/Internal/Time.hs view
@@ -3,10 +3,8 @@ -- Utility functions to work with times -import Data.Fixed (Fixed (..)) import Data.Maybe (fromJust) import Data.Time-import Data.Time.Clock import Data.Time.Clock.POSIX (posixSecondsToUTCTime) #if MIN_VERSION_time(1,9,0) import Data.Time.Format.Internal
src/Data/Avro/Schema/Deconflict.hs view
@@ -6,26 +6,17 @@ import Control.Applicative ((<|>)) import Data.Avro.Schema.Schema as S import qualified Data.Foldable as Foldable-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap import Data.List (find)-import Data.List.NonEmpty (NonEmpty (..))-import qualified Data.List.NonEmpty as NE-import qualified Data.Map as M import Data.Maybe (isNothing)-import Data.Semigroup ((<>)) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import Data.Vector (Vector) import qualified Data.Vector as V import Data.Avro.Schema.ReadSchema (FieldStatus (..), ReadField, ReadSchema) import qualified Data.Avro.Schema.ReadSchema as Read -import Debug.Trace- -- | @deconflict writer reader@ will produce a schema that can decode -- with the writer's schema into the form specified by the reader's schema. --@@ -60,7 +51,7 @@ deconflict (S.Map w) (S.Map r) = Read.Map <$> deconflict w r deconflict w@S.Enum{} r@S.Enum{}- | name w == name r && symbols w `contains` symbols r = pure Read.Enum+ | name w == name r && symbols r `contains` symbols w = pure Read.Enum { Read.name = name r , Read.aliases = aliases w <> aliases r , Read.doc = doc r
src/Data/Avro/Schema/ReadSchema.hs view
@@ -21,10 +21,8 @@ import Control.DeepSeq (NFData) import Data.Avro.Schema.Schema (LogicalTypeBytes, LogicalTypeFixed, LogicalTypeInt, LogicalTypeLong, LogicalTypeString, Order, TypeName) import qualified Data.Avro.Schema.Schema as S-import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text)-import qualified Data.Text as T import qualified Data.Vector as V import GHC.Generics (Generic)
src/Data/Avro/Schema/Schema.hs view
@@ -70,25 +70,19 @@ import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (Parser, typeMismatch) import qualified Data.ByteString as B-import qualified Data.ByteString.Base16 as Base16 import qualified Data.Char as Char import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Hashable import Data.Int-import qualified Data.IntMap as IM-import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes, fromMaybe, isJust)-import Data.Monoid (First (..)) import Data.Semigroup-import qualified Data.Set as S import Data.String import Data.Text (Text) import qualified Data.Text as T-import Data.Text.Encoding as T import qualified Data.Vector as V import Prelude as P @@ -150,9 +144,13 @@ } deriving (Ord, Show, Generic, NFData) +pattern Int' :: Schema pattern Int' = Int Nothing+pattern Long' :: Schema pattern Long' = Long Nothing+pattern Bytes' :: Schema pattern Bytes' = Bytes Nothing+pattern String' :: Schema pattern String' = String Nothing data Field = Field { fldName :: Text@@ -433,9 +431,9 @@ -> TypeName -- ^ The resulting /fullname/ of the generated type, -- according to the rules laid out above.-mkTypeName context name ns+mkTypeName context name namespace_ | isFullName name = parseFullname name- | otherwise = case ns of+ | otherwise = case namespace_ of Just ns -> TN name $ filter (/= "") (T.splitOn "." ns) Nothing -> TN name $ maybe [] namespace context where isFullName = isJust . T.find (== '.')@@ -589,23 +587,21 @@ "map" -> Map <$> (parseSchemaJSON context =<< o .: "values") "array" -> Array <$> (parseSchemaJSON context =<< o .: "items") "record" -> do- name <- o .: "name"- namespace <- o .:? "namespace"- let typeName = mkTypeName context name namespace- mkAlias name = mkTypeName (Just typeName) name Nothing- aliases <- mkAliases typeName <$> (o .:? "aliases" .!= [])- doc <- o .:? "doc"- fields <- mapM (parseField typeName) =<< (o .: "fields")- pure $ Record typeName aliases doc fields+ name <- o .: "name"+ namespace <- o .:? "namespace"+ let recName = mkTypeName context name namespace+ aliases <- mkAliases recName <$> (o .:? "aliases" .!= [])+ doc <- o .:? "doc"+ fields <- mapM (parseField recName) =<< (o .: "fields")+ pure $ Record recName aliases doc fields "enum" -> do- name <- o .: "name"- namespace <- o .:? "namespace"- let typeName = mkTypeName context name namespace- mkAlias name = mkTypeName (Just typeName) name Nothing- aliases <- mkAliases typeName <$> (o .:? "aliases" .!= [])- doc <- o .:? "doc"- symbols <- o .: "symbols"- pure $ mkEnum typeName aliases doc symbols+ name <- o .: "name"+ namespace <- o .:? "namespace"+ let enumName = mkTypeName context name namespace+ aliases <- mkAliases enumName <$> (o .:? "aliases" .!= [])+ doc <- o .:? "doc"+ symbols <- o .: "symbols"+ pure $ mkEnum enumName aliases doc symbols "fixed" -> parseFixed o "null" -> pure Null "boolean" -> pure Boolean@@ -621,13 +617,12 @@ where parseFixed o = do- name <- o .: "name"- namespace <- o .:? "namespace"- let typeName = mkTypeName context name namespace- mkAlias name = mkTypeName (Just typeName) name Nothing- aliases <- mkAliases typeName <$> (o .:? "aliases" .!= [])- size <- o .: "size"- pure $ Fixed typeName aliases size Nothing+ name <- o .: "name"+ namespace <- o .:? "namespace"+ let fixedName = mkTypeName context name namespace+ aliases <- mkAliases fixedName <$> (o .:? "aliases" .!= [])+ size <- o .: "size"+ pure $ Fixed fixedName aliases size Nothing -- | Parse aliases, inferring the namespace based on the type being aliases. mkAliases :: TypeName@@ -658,8 +653,6 @@ Just (Error e) -> fail e Nothing -> return Nothing order <- o .:? "order" .!= Just Ascending-- let mkAlias name = mkTypeName (Just record) name Nothing aliases <- o .:? "aliases" .!= [] return $ Field name aliases doc order ty def invalid -> typeMismatch "Field" invalid@@ -751,12 +744,12 @@ -> [ "logicalType" .= ("decimal" :: Text) , "precision" .= prec, "scale" .= sc ] in object (basic ++ extended)- where render context typeName- | Just ctx <- context- , namespace ctx == namespace typeName = baseName typeName- | otherwise = renderFullname typeName+ where render context1 typeName1+ | Just ctx <- context1+ , namespace ctx == namespace typeName1 = baseName typeName1+ | otherwise = renderFullname typeName1 - fieldToJSON context Field {..} =+ fieldToJSON context1 Field {..} = let opts = catMaybes [ ("order" .=) <$> fldOrder , ("doc" .=) <$> fldDoc@@ -764,7 +757,7 @@ ] in object $ opts ++ [ "name" .= fldName- , "type" .= schemaToJSON (Just context) fldType+ , "type" .= schemaToJSON (Just context1) fldType , "aliases" .= fldAliases ] @@ -1041,7 +1034,7 @@ t@(NamedType n) -> fromMaybe t <$> gets (HashMap.lookup n) a@Array{item} -> (\x -> a { item = x }) <$> go item m@Map{values} -> (\x -> m { values = x }) <$> go values- u@Union{options} -> Union <$> traverse go options+ Union{options} -> Union <$> traverse go options r@Record{name, fields} -> do fields' <- traverse expandField fields@@ -1064,11 +1057,11 @@ overlayType a@Array{..} = a { item = overlayType item } overlayType m@Map{..} = m { values = overlayType values } overlayType r@Record{..} = r { fields = map overlayField fields }- overlayType u@Union{..} = Union (fmap overlayType options)- overlayType nt@(NamedType _) = rebind nt+ overlayType Union{..} = Union (fmap overlayType options)+ overlayType (NamedType nt) = rebind nt overlayType other = other - rebind (NamedType tn) = HashMap.lookupDefault (NamedType tn) tn bindings+ rebind tn = HashMap.lookupDefault (NamedType tn) tn bindings bindings = extractBindings supplement -- | Extract the named inner type definition as its own schema.