avro 0.3.2.0 → 0.3.3.0
raw patch · 3 files changed
+123/−38 lines, 3 files
Files
- avro.cabal +5/−5
- src/Data/Avro/Deriving.hs +78/−11
- src/Data/Avro/JSON.hs +40/−22
avro.cabal view
@@ -2,15 +2,15 @@ -- -- see: https://github.com/sol/hpack ----- hash: a7df532e971306f0e8b7c7ff21ecb95e20f336d396ec72f86154b1df850f7ee7+-- hash: 9e78201d3840bc184e5d8c510138f5a2eedb7ce7dbceab86140bd2d7562b8e1d name: avro-version: 0.3.2.0+version: 0.3.3.0 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell category: Data-homepage: https://github.com/GaloisInc/avro.git#readme-bug-reports: https://github.com/GaloisInc/avro.git/issues+homepage: https://github.com/GaloisInc/avro#readme+bug-reports: https://github.com/GaloisInc/avro/issues author: Thomas M. DuBuisson maintainer: Alexey Raga <alexey.raga@gmail.com> license: BSD3@@ -35,7 +35,7 @@ source-repository head type: git- location: https://github.com/GaloisInc/avro.git+ location: https://github.com/GaloisInc/avro flag dev description: Use development GHC flags
src/Data/Avro/Deriving.hs view
@@ -10,6 +10,7 @@ ( -- * Deriving options DeriveOptions(..), defaultDeriveOptions , mkPrefixedFieldName, mkAsIsFieldName+, mkLazyField, mkStrictPrimitiveField -- * Deriving Haskell types from Avro schema , makeSchema@@ -38,8 +39,8 @@ import Data.Maybe (fromMaybe) import Data.Semigroup ((<>)) import GHC.Generics (Generic)-import Language.Haskell.TH as TH-import Language.Haskell.TH.Lib as TH+import Language.Haskell.TH as TH hiding (notStrict)+import Language.Haskell.TH.Lib as TH hiding (notStrict) import Language.Haskell.TH.Syntax import Data.Avro.Deriving.NormSchema@@ -53,11 +54,27 @@ import qualified Data.Text as T import qualified Data.Vector as V ++-- | Describes the strictness of a field for a derived+-- data type. The field will be derived as if it were+-- written with a @!@.+data FieldStrictness = StrictField | LazyField+ deriving Generic++-- | Describes the representation of a field for a derived+-- data type. The field will be derived as if it were written+-- with an @{-# UNPACK #-}@ pragma.+data FieldUnpackedness = UnpackedField | NonUnpackedField+ deriving Generic+ -- | Derives Avro from a given schema file. -- Generates data types, FromAvro and ToAvro instances. data DeriveOptions = DeriveOptions { -- | How to build field names for generated data types fieldNameBuilder :: TypeName -> Field -> T.Text++ -- | Determines field representation of generated data types+ , fieldRepresentation :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness) } deriving Generic -- | Default deriving options@@ -65,10 +82,12 @@ -- @ -- defaultDeriveOptions = 'DeriveOptions' -- { fieldNameBuilder = 'mkPrefixedFieldName'+-- , fieldStrictness = 'mkLazyField' -- } -- @ defaultDeriveOptions = DeriveOptions- { fieldNameBuilder = mkPrefixedFieldName+ { fieldNameBuilder = mkPrefixedFieldName+ , fieldRepresentation = mkLazyField } -- | Generates a field name that is prefixed with the type name.@@ -83,6 +102,38 @@ mkPrefixedFieldName (TN dn) fld = sanitiseName $ updateFirst T.toLower dn <> updateFirst T.toUpper (fldName fld) ++-- | Marks any field as non-strict in the generated data types.+mkLazyField :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)+mkLazyField _ _ =+ (LazyField, NonUnpackedField)+++-- | Make a field strict and unpacked if it has a primitive representation.+-- Primitive types are types which GHC has either a static or an unlifted+-- representation: `()`, `Boolean`, `Int32`, `Int64`, `Float`, `Double`.+mkStrictPrimitiveField :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)+mkStrictPrimitiveField _ field =+ if shouldStricten+ then (StrictField, unpackedness)+ else (LazyField, NonUnpackedField)+ where+ unpackedness =+ case S.fldType field of+ S.Null -> NonUnpackedField+ S.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+ _ -> False+ -- | Generates a field name that matches the field name in schema -- (sanitised for Haskell, so first letter is lower cased) --@@ -332,7 +383,7 @@ where numericLit = litE . IntegerL . fromIntegral mkMap (HM.toList -> xs) = [e| HM.fromList $(ListE <$> mapM mkKVPair xs) |]- mkKVPair (k, v) = [e| ($(mkText k), $(mkDefaultValue v)) e|]+ mkKVPair (k, v) = [e| ($(mkText k), $(mkDefaultValue v)) |] mkNE (NE.toList -> xs) = [e| NE.fromList $(ListE <$> mapM mkSchema xs) |] @@ -415,26 +466,33 @@ mkField opts prefix field = do ftype <- mkFieldTypeName (fldType field) let fName = mkTextName $ (fieldNameBuilder opts) prefix field- pure (fName, defaultStrictness, ftype)+ (fieldStrictness, fieldUnpackedness) =+ fieldRepresentation opts prefix field+ strictness =+ case fieldStrictness of+ StrictField -> strict fieldUnpackedness+ LazyField -> notStrict + pure (fName, strictness, ftype)+ genNewtype :: Name -> Q Dec #if MIN_VERSION_template_haskell(2,12,0) genNewtype dn = do ders <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] fldType <- [t|ByteString|]- let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), notStrict, 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|], [t|Generic|]] fldType <- [t|ByteString|]- let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), notStrict, fldType)] pure $ NewtypeD [] dn [] Nothing ctor ders #else genNewtype dn = do [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] fldType <- [t|ByteString|]- let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)]+ let ctor = RecC dn [(mkName ("un" ++ nameBase dn), notStrict, fldType)] pure $ NewtypeD [] dn [] ctor [eq, sh] #endif @@ -468,11 +526,20 @@ pure $ DataD [] dn [] [RecC dn flds] [eq, sh] #endif -defaultStrictness :: Strict+notStrict :: Strict #if MIN_VERSION_template_haskell(2,11,0)-defaultStrictness = Bang SourceNoUnpack NoSourceStrictness+notStrict = Bang SourceNoUnpack NoSourceStrictness #else-defaultStrictness = NotStrict+notStrict = NotStrict+#endif++strict :: FieldUnpackedness -> Strict+#if MIN_VERSION_template_haskell(2,11,0)+strict UnpackedField = Bang SourceUnpack SourceStrict+strict NonUnpackedField = Bang SourceNoUnpack SourceStrict+#else+strict UnpackedField = Unpacked+strict NonUnpackedField = IsStrict #endif mkTextName :: Text -> Name
src/Data/Avro/JSON.hs view
@@ -75,32 +75,50 @@ import qualified Data.Avro.Schema as Schema import qualified Data.Avro.Types as Avro +decodeAvroJSON :: Schema -> Aeson.Value -> Result (Avro.Value Schema)+decodeAvroJSON schema json =+ parseAvroJSON union env schema json+ where+ env =+ Schema.buildTypeEnvironment missing schema . Schema.TN+ missing name =+ fail ("Type " <> show name <> " not in schema")++ union (Schema.Union schemas _) Aeson.Null+ | Schema.Null `elem` schemas =+ pure $ Avro.Union schemas Schema.Null Avro.Null+ | otherwise =+ fail "Null not in union."+ union (Schema.Union schemas _) (Aeson.Object obj)+ | null obj =+ fail "Invalid encoding of union: empty object ({})."+ | length obj > 1 =+ fail "Invalid encoding of union: object with too many fields."+ | otherwise =+ let+ branch =+ head (HashMap.keys obj)+ names =+ HashMap.fromList [(Schema.typeName t, t) | t <- NE.toList schemas]+ in case HashMap.lookup branch names of+ Just t -> do+ nested <- parseAvroJSON union env t (obj ! branch)+ return (Avro.Union schemas t nested)+ Nothing -> fail ("Type '" <> Text.unpack branch <> "' not in union: " <> show schemas)+ union Schema.Union{} _ =+ Avro.Error "Invalid JSON representation for union: has to be a JSON object with exactly one field."+ union _ _ =+ error "Impossible: function given non-union schema."+ -- | Convert a 'Aeson.Value' into a type that has an Avro schema. The -- schema is used to validate the JSON and will return an 'Error' if -- the JSON object is not encoded correctly or does not match the schema. fromJSON :: forall a. (FromAvro a) => Aeson.Value -> Result a-fromJSON json = parseAvroJSON union env schema json >>= fromAvro- where schema = untag (Avro.schema :: Tagged a Schema)- env = Schema.buildTypeEnvironment missing schema . Schema.TN- missing name = fail $ "Type " <> show name <> " not in schema."-- union (Schema.Union schemas _) Aeson.Null- | Schema.Null `elem` schemas = pure $ Avro.Union schemas Schema.Null Avro.Null- | otherwise = fail "Null not in union."- union (Schema.Union schemas _) (Aeson.Object obj)- | length obj < 1 = fail "Invalid encoding of union: empty object ({})."- | length obj > 1 = fail "Invalid encoding of union: object with too many fields."- | otherwise =- let branch = head $ HashMap.keys obj- names = HashMap.fromList [(Schema.typeName t, t) | t <- NE.toList schemas]- in case HashMap.lookup branch names of- Just t -> do- nested <- parseAvroJSON union env t $ obj ! branch- return $ Avro.Union schemas t nested- Nothing -> fail $ "Type '" <> Text.unpack branch <> "' not in union: " <> show schemas- union Schema.Union{} _ =- Avro.Error "Invalid JSON representation for union: has to be a JSON object with exactly one field."- union _ _ = error "Impossible: function given non-union schema."+fromJSON json = do+ value <- decodeAvroJSON schema json+ fromAvro value+ where+ schema = untag (Avro.schema :: Tagged a Schema) -- | Parse a 'ByteString' as JSON and convert it to a type with an -- Avro schema. Will return 'Error' if the input is not valid JSON or