avro 0.3.5.2 → 0.3.6.0

raw patch · 30 files changed

+996/−506 lines, 30 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• avro.cabal +4/−3
• src/Data/Avro/Decode/Get.hs +5/−1
• src/Data/Avro/Deriving.hs +248/−114
• src/Data/Avro/Deriving/NormSchema.hs +4/−8
• src/Data/Avro/FromAvro.hs +9/−0
• src/Data/Avro/JSON.hs +1/−1
• src/Data/Avro/Schema.hs +382/−196
• src/Data/Avro/ToAvro.hs +6/−0
• test/Avro/Codec/ArraySpec.hs +10/−0
• test/Avro/Codec/BoolSpec.hs +1/−1
• test/Avro/Codec/DoubleSpec.hs +1/−1
• test/Avro/Codec/FloatSpec.hs +1/−1
• test/Avro/Codec/Int64Spec.hs +1/−1
• test/Avro/Codec/MaybeSpec.hs +1/−1
• test/Avro/Codec/NestedSpec.hs +2/−2
• test/Avro/Codec/TextSpec.hs +9/−1
• test/Avro/JSONSpec.hs +13/−6
• test/Avro/NamespaceSpec.hs +66/−0
• test/Avro/NormSchemaSpec.hs +1/−1
• test/Avro/SchemaSpec.hs +8/−22
• test/Avro/THEnumSpec.hs +5/−6
• test/Avro/THReusedSpec.hs +11/−10
• test/Avro/THUnionSpec.hs +30/−17
• test/Avro/ToAvroSpec.hs +1/−1
• test/Example1.hs +2/−2
• test/data/internal-bindings.avsc +0/−105
• test/data/namespace-inference.json +154/−0
• test/data/unions-object-a.json +7/−2
• test/data/unions-object-b.json +9/−2
• test/data/unions.avsc +4/−1

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 670416b0f08afc67a117327ae67a257a6c00faecea07e66d765393ef9e7786fa+-- hash: 227dce7b3b510a3f986c3dd8ba7a73b2e32ef06ef0d81005408e20f9c8eadc2d  name:           avro-version:        0.3.5.2+version:        0.3.6.0 synopsis:       Avro serialization support for Haskell description:    Avro serialization and deserialization support for Haskell category:       Data@@ -23,10 +23,10 @@     test/data/deconflict/writer.avsc     test/data/enums-object.json     test/data/enums.avsc-    test/data/internal-bindings.avsc     test/data/karma.avsc     test/data/logical.avsc     test/data/maybe.avsc+    test/data/namespace-inference.json     test/data/record.avsc     test/data/reused.avsc     test/data/small.avsc@@ -133,6 +133,7 @@       Avro.DefaultsSpec       Avro.EncodeRawSpec       Avro.JSONSpec+      Avro.NamespaceSpec       Avro.NormSchemaSpec       Avro.SchemaSpec       Avro.THEncodeContainerSpec

@@ -147,7 +147,11 @@     G.getByteString (fromIntegral w)  getString :: Get Text-getString = Text.decodeUtf8 <$> getBytes+getString = do+  bytes <- getBytes+  case Text.decodeUtf8' bytes of+    Left unicodeExc -> fail (show unicodeExc)+    Right text -> return text  -- a la Java: --  Bit 31 (the bit that is selected by the mask 0x80000000) represents the

@@ -6,21 +6,29 @@ {-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE ViewPatterns      #-} +-- | This module lets us derive Haskell types from an Avro schema that+-- can be serialized/deserialzed to Avro. module Data.Avro.Deriving-( -- * Deriving options-  DeriveOptions(..), FieldStrictness(..), FieldUnpackedness(..)-, defaultDeriveOptions-, mkPrefixedFieldName, mkAsIsFieldName-, mkLazyField, mkStrictPrimitiveField+  ( -- * Deriving options+    DeriveOptions(..)+  , FieldStrictness(..)+  , FieldUnpackedness(..)+  , NamespaceBehavior(..)+  , defaultDeriveOptions+  , mkPrefixedFieldName+  , mkAsIsFieldName+  , mkLazyField+  , mkStrictPrimitiveField    -- * Deriving Haskell types from Avro schema-, makeSchema-, deriveAvroWithOptions-, deriveAvroWithOptions'-, deriveFromAvroWithOptions-, deriveAvro-, deriveAvro'-, deriveFromAvro+  , makeSchema+  , makeSchemaFrom+  , deriveAvroWithOptions+  , deriveAvroWithOptions'+  , deriveFromAvroWithOptions+  , deriveAvro+  , deriveAvro'+  , deriveFromAvro ) where @@ -39,7 +47,11 @@ import           Data.Map                      (Map) import           Data.Maybe                    (fromMaybe) import           Data.Semigroup                ((<>))+import qualified Data.Text                     as Text++ 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@@ -56,6 +68,26 @@ import qualified Data.Text                     as T import qualified Data.Vector                   as V +-- | How to treat Avro namespaces in the generated Haskell types.+data NamespaceBehavior =+    IgnoreNamespaces+    -- ^ Namespaces are ignored completely. Haskell identifiers are+    -- generated from types' base names. This produces nicer types but+    -- fails on valid Avro schemas where the same base name occurs in+    -- different namespaces.+    --+    -- The Avro type @com.example.Foo@ would generate the Haskell type+    -- @Foo@. If @Foo@ had a field called @bar@, the generated Haskell+    -- record would have a field called @fooBar@.+  | HandleNamespaces+    -- ^ Haskell types and field names are generated with+    -- namespaces. See 'deriveAvroWithNamespaces' for an example of+    -- how this works.+    --+    -- The Avro type @com.example.Foo@ would generate the Haskell type+    -- @Com'example'Foo@. If @Foo@ had a field called @bar@, the+    -- generated Haskell record would have the field+    -- @com'example'FooBar@.  -- | Describes the strictness of a field for a derived -- data type. The field will be derived as if it were@@ -72,24 +104,32 @@ -- | 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+  { -- | 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      -- | Determines field representation of generated data types   , fieldRepresentation  :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)++    -- | Controls how we handle namespaces when defining Haskell type+    -- and field names.+  , namespaceBehavior :: NamespaceBehavior   } deriving Generic  -- | Default deriving options -- -- @ -- defaultDeriveOptions = 'DeriveOptions'---   { fieldNameBuilder = 'mkPrefixedFieldName'---   , fieldStrictness  = 'mkLazyField'+--   { fieldNameBuilder  = 'mkPrefixedFieldName'+--   , fieldStrictness   = 'mkLazyField'+--   , namespaceBehavior = 'IgnoreNamespaces' --   } -- @ defaultDeriveOptions = DeriveOptions   { fieldNameBuilder    = mkPrefixedFieldName   , fieldRepresentation = mkLazyField+  , namespaceBehavior   = IgnoreNamespaces   }  -- | Generates a field name that is prefixed with the type name.@@ -100,10 +140,9 @@ -- @ -- Person { personFirstName :: Text } -- @-mkPrefixedFieldName :: TypeName -> Field -> T.Text-mkPrefixedFieldName (TN dn) fld = sanitiseName $-  updateFirst T.toLower dn <> updateFirst T.toUpper (fldName fld)-+mkPrefixedFieldName :: Text -> Field -> T.Text+mkPrefixedFieldName prefix fld =+  sanitiseName $ updateFirst T.toLower prefix <> updateFirst T.toUpper (fldName fld)  -- | Marks any field as non-strict in the generated data types. mkLazyField :: TypeName -> Field -> (FieldStrictness, FieldUnpackedness)@@ -146,40 +185,92 @@ -- Person { firstName :: Text } -- @ -- You may want to enable 'DuplicateRecordFields' if you want to use this method.- mkAsIsFieldName :: TypeName -> Field -> Text mkAsIsFieldName _ = sanitiseName . updateFirst T.toLower . fldName --- | Generates Haskell classes and 'FromAvro' and 'ToAvro' instances--- given the Avro schema file+-- | Derives Haskell types from the given Avro schema file. These+-- Haskell types support both reading and writing to Avro.+--+-- For an Avro schema with a top-level record called+-- @com.example.Foo@, this generates:+--+--   * a 'Schema' with the name @schema'Foo@ or+--     @schema'com'example'Foo@, depending on the 'namespaceBehavior'+--     setting.+--+--   * Haskell types for each named type defined in the schema+--     * 'HasSchema' instances for each type+--     * 'FromAvro' instances for each type+--     * 'ToAvro' instances for each type+--+-- This function ignores namespaces when generated Haskell type and+-- field names. This will fail on valid Avro schemas which contain+-- types with the same base name in different namespaces. It will also+-- fail for schemas that contain types with base names that are the+-- same except for the capitalization of the first letter.+--+-- The type @com.example.Foo@ will generate a Haskell type @Foo@. If+-- @com.example.Foo@ has a field named @Bar@, the field in the Haskell+-- record will be called @fooBar@. deriveAvroWithOptions :: DeriveOptions -> FilePath -> Q [Dec] deriveAvroWithOptions o p = readSchema p >>= deriveAvroWithOptions' o --- | Generates Haskell classes and 'FromAvro' and 'ToAvro' instances--- given the Avro schema+-- | Derive Haskell types from the given Avro schema.+--+-- For an Avro schema with a top-level definition @com.example.Foo@, this+-- generates:+--+--   * a 'Schema' with the name @schema'Foo@ or+--     @schema'com'example'Foo@ depending on namespace handling+--+--   * Haskell types for each named type defined in the schema+--     * 'HasSchema' instances for each type+--     * 'FromAvro' instances for each type+--     * 'ToAvro' instances for each type deriveAvroWithOptions' :: DeriveOptions -> Schema -> Q [Dec] deriveAvroWithOptions' o s = do   let schemas = extractDerivables s   types     <- traverse (genType o) schemas-  hasSchema <- traverse genHasAvroSchema schemas-  fromAvros <- traverse genFromAvro schemas+  hasSchema <- traverse (genHasAvroSchema $ namespaceBehavior o) schemas+  fromAvros <- traverse (genFromAvro $ namespaceBehavior o) schemas   toAvros   <- traverse (genToAvro o) schemas   pure $ join types <> join hasSchema <> join fromAvros <> join toAvros --- | Derives "read only" Avro from a given schema file.--- Generates data types and FromAvro.+-- | Derives "read only" Avro from a given schema file. For a schema+-- with a top-level definition @com.example.Foo@, this generates:+--+--  * a 'Schema' value with the name @schema'Foo@+--+--  * Haskell types for each named type defined in the schema+--    * 'HasSchema' instances for each type+--    * 'FromAvro' instances for each type deriveFromAvroWithOptions :: DeriveOptions -> FilePath -> Q [Dec]-deriveFromAvroWithOptions o p = do-  schemas   <- extractDerivables <$> readSchema p+deriveFromAvroWithOptions o p = readSchema p >>= deriveFromAvroWithOptions' o++-- | Derive "read only" Haskell types from the given Avro schema with+-- configurable behavior for handling namespaces.+--+-- For an Avro schema with a top-level definition @com.example.Foo@, this+-- generates:+--+--   * a 'Schema' with the name @schema'Foo@ or+--     @schema'com'example'Foo@ depending on namespace handling+--+--   * Haskell types for each named type defined in the schema+--     * 'HasSchema' instances for each type+--     * 'FromAvro' instances for each type+deriveFromAvroWithOptions' :: DeriveOptions -> Schema -> Q [Dec]+deriveFromAvroWithOptions' o s = do+  let schemas = extractDerivables s   types     <- traverse (genType o) schemas-  hasSchema <- traverse genHasAvroSchema schemas-  fromAvros <- traverse genFromAvro schemas+  hasSchema <- traverse (genHasAvroSchema $ namespaceBehavior o) schemas+  fromAvros <- traverse (genFromAvro $ namespaceBehavior o) schemas   pure $ join types <> join hasSchema <> join fromAvros  -- | Same as 'deriveAvroWithOptions' but uses 'defaultDeriveOptions' -- -- @--- deriveAvro' = deriveAvroWithOptions' 'defaultDeriveOptions'+-- deriveAvro = 'deriveAvroWithOptions' 'defaultDeriveOptions' -- @ deriveAvro :: FilePath -> Q [Dec] deriveAvro = deriveAvroWithOptions defaultDeriveOptions@@ -192,8 +283,12 @@ deriveAvro' :: Schema -> Q [Dec] deriveAvro' = deriveAvroWithOptions' defaultDeriveOptions --- | Derives "read only" Avro from a given schema file.--- Generates data types and FromAvro.+-- | Same as 'deriveFromAvroWithOptions' but uses+-- 'defaultDeriveOptions'.+--+-- @+-- deriveFromAvro = deriveFromAvroWithOptions defaultDeriveOptions+-- @ deriveFromAvro :: FilePath -> Q [Dec] deriveFromAvro = deriveFromAvroWithOptions defaultDeriveOptions @@ -207,6 +302,14 @@ makeSchema :: FilePath -> Q Exp makeSchema p = readSchema p >>= schemaDef' +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+    Just ss -> schemaDef' ss+ readSchema :: FilePath -> Q Schema readSchema p = do   qAddDependentFile p@@ -215,23 +318,25 @@     Left err  -> fail $ "Unable to generate AVRO for " <> p <> ": " <> err     Right sch -> pure sch -genFromAvro :: Schema -> Q [Dec]-genFromAvro (S.Enum n _ _ _ _ _) =-  [d| instance FromAvro $(conT $ mkDataTypeName n) where+genFromAvro :: NamespaceBehavior -> Schema -> Q [Dec]+genFromAvro namespaceBehavior (S.Enum n _ _ _ _) =+  [d| instance FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where         fromAvro (AT.Enum _ i _) = $([| pure . toEnum|]) i-        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value+        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname n)|] ) value   |]-genFromAvro (S.Record n _ _ _ _ fs) =-  [d| instance FromAvro $(conT $ mkDataTypeName n) where-        fromAvro (AT.Record _ r) = $(genFromAvroFieldsExp (mkTextName $ unTN n) fs) r-        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value+genFromAvro namespaceBehavior (S.Record n _ _ _ fs) =+  [d| instance FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where+        fromAvro (AT.Record _ r) =+           $(genFromAvroFieldsExp (mkDataTypeName namespaceBehavior n) fs) r+        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname 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 namespaceBehavior (S.Fixed n _ s) =+  [d| instance FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where+        fromAvro (AT.Fixed _ v)+          | BS.length v == s = pure $ $(conE (mkDataTypeName namespaceBehavior n)) v+        fromAvro value = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname n)|] ) value   |]-genFromAvro _                             = pure []+genFromAvro _ _                             = pure []  genFromAvroFieldsExp :: Name -> [Field] -> Q Exp genFromAvroFieldsExp n []     = [| (return . return) $(conE n) |]@@ -243,45 +348,48 @@      )   |] -genHasAvroSchema :: Schema -> Q [Dec]-genHasAvroSchema s = do-  let sname = mkSchemaValueName (name s)+genHasAvroSchema :: NamespaceBehavior -> Schema -> Q [Dec]+genHasAvroSchema namespaceBehavior s = do+  let sname = mkSchemaValueName namespaceBehavior (name s)   sdef <- schemaDef sname s   idef <- hasAvroSchema sname   pure (sdef <> idef)   where     hasAvroSchema sname =-      [d| instance HasAvroSchema $(conT $ mkDataTypeName (name s)) where+      [d| instance HasAvroSchema $(conT $ mkDataTypeName namespaceBehavior (name s)) where             schema = pure $(varE sname)       |] -newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name]-newNames base n = sequence [ newName (base++show i) | i <- [1..n] ]+newNames :: String+            -- ^ base name+         -> Int+            -- ^ count+         -> Q [Name]+newNames base n = sequence [newName (base ++ show i) | i <- [1..n]]  genToAvro :: DeriveOptions -> Schema -> Q [Dec]-genToAvro opts s@(Enum n _ _ _ vs _) =-  toAvroInstance (mkSchemaValueName n)+genToAvro opts s@(Enum n _ _ vs _) =+  toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where-    conP' = flip conP [] . mkAdtCtorName n+    conP' = flip conP [] . mkAdtCtorName (namespaceBehavior opts) n     toAvroInstance sname =-      [d| instance ToAvro $(conT $ mkDataTypeName n) where+      [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where             toAvro = $([| \x ->               let convert = AT.Enum $(varE sname) (fromEnum $([|x|]))               in $(caseE [|x|] ((\v -> match (conP' v)                                (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> vs))               |])       |]--genToAvro opts s@(Record n _ _ _ _ fs) =-  toAvroInstance (mkSchemaValueName n)+genToAvro opts s@(Record n _ _ _ fs) =+  toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where     toAvroInstance sname =-      [d| instance ToAvro $(conT $ mkDataTypeName n) where+      [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where             toAvro = $(genToAvroFieldsExp sname)       |]     genToAvroFieldsExp sname = do       names <- newNames "p_" (length fs)-      let con = conP (mkDataTypeName n) (varP <$> names)+      let con = conP (mkDataTypeName (namespaceBehavior opts) n) (varP <$> names)       lamE [con]             [| record $(varE sname)                 $(let assign (fld, n) = [| T.pack $(mkTextLit (fldName fld)) .= $(varE n) |]@@ -289,14 +397,14 @@                 )             |] -genToAvro opts s@(Fixed n _ _ size) =-  toAvroInstance (mkSchemaValueName n)+genToAvro opts s@(Fixed n _ size) =+  toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where     toAvroInstance sname =-      [d| instance ToAvro $(conT $ mkDataTypeName n) where+      [d| instance ToAvro $(conT $ mkDataTypeName (namespaceBehavior opts) n) where             toAvro = $(do               x <- newName "x"-              lamE [conP (mkDataTypeName n) [varP x]] [| AT.Fixed $(varE sname) $(varE x) |])+              lamE [conP (mkDataTypeName (namespaceBehavior opts) n) [varP x]] [| AT.Fixed $(varE sname) $(varE x) |])       |]  schemaDef :: Name -> Schema -> Q [Dec]@@ -321,7 +429,6 @@           Map values     -> [e| Map $(mkSchema values) |]           NamedType name -> [e| NamedType $(mkName name) |]           Record {..}    -> [e| Record { name      = $(mkName name)-                                       , namespace = $(mkMaybeText namespace)                                        , aliases   = $(ListE <$> mapM mkName aliases)                                        , doc       = $(mkMaybeText doc)                                        , order     = $(mkOrder order)@@ -330,13 +437,11 @@                               |]           Enum {..}      -> [e| mkEnum $(mkName name)                                        $(ListE <$> mapM mkName aliases)-                                       $(mkMaybeText namespace)                                        $(mkMaybeText doc)                                        $(ListE <$> mapM mkText symbols)                               |]           Union {..}     -> [e| mkUnion $(mkNE options) |]           Fixed {..}     -> [e| Fixed { name      = $(mkName name)-                                      , namespace = $(mkMaybeText namespace)                                       , aliases   = $(ListE <$> mapM mkName aliases)                                       , size      = $(litE $ IntegerL $ fromIntegral size)                                       }@@ -344,7 +449,8 @@          mkText text = [e| T.pack $(mkTextLit text) |] -        mkName (TN name) = [e| TN $(mkText name) |]+        mkName (TN name namespace) = [e| TN $(mkText name) $(mkNamespace namespace) |]+        mkNamespace ls = listE $ stringE . T.unpack <$> ls          mkMaybeText (Just text) = [e| Just $(mkText text) |]         mkMaybeText Nothing     = [e| Nothing |]@@ -401,42 +507,45 @@     sn _ d                   = d  genType :: DeriveOptions -> Schema -> Q [Dec]-genType opts (S.Record n _ _ _ _ fs) = do+genType opts (S.Record n _ _ _ fs) = do   flds <- traverse (mkField opts n) fs-  let dname = mkDataTypeName n+  let dname = mkDataTypeName (namespaceBehavior opts) n   sequenceA [genDataType dname flds]-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+genType opts (S.Enum n _ _ vs _) = do+  let dname = mkDataTypeName (namespaceBehavior opts) n+  sequenceA [genEnum dname (mkAdtCtorName (namespaceBehavior opts) n <$> vs)]+genType opts (S.Fixed n _ s) = do+  let dname = mkDataTypeName (namespaceBehavior opts) 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| Int32 |]-  S.Float                       -> [t| Float |]-  S.Double                      -> [t| Double |]-  S.Bytes                       -> [t| ByteString |]-  S.String                      -> [t| Text |]-  S.Union (Null :| [x]) _       -> [t| Maybe $(mkFieldTypeName x) |] -- AppT (ConT $ mkName "Maybe") (mkFieldTypeName x)-  S.Union (x :| [Null]) _       -> [t| Maybe $(mkFieldTypeName x) |] --AppT (ConT $ mkName "Maybe") (mkFieldTypeName x)-  S.Union (x :| [y]) _          -> [t| Either $(mkFieldTypeName x) $(mkFieldTypeName y) |] -- AppT (AppT (ConT (mkName "Either")) (mkFieldTypeName x)) (mkFieldTypeName y)-  S.Union (a :| [b, c]) _       -> [t| Either3 $(mkFieldTypeName a) $(mkFieldTypeName b) $(mkFieldTypeName c) |]-  S.Union (a :| [b, c, d]) _    -> [t| Either4 $(mkFieldTypeName a) $(mkFieldTypeName b) $(mkFieldTypeName c) $(mkFieldTypeName d) |]-  S.Union (a :| [b, c, d, e]) _ -> [t| Either5 $(mkFieldTypeName a) $(mkFieldTypeName b) $(mkFieldTypeName c) $(mkFieldTypeName d) $(mkFieldTypeName e) |]-  S.Union _ _                   -> error "Unions with more than 5 elements are not yet supported"-  S.Record n _ _ _ _ _          -> [t| $(conT $ mkDataTypeName n) |]-  S.Map x                       -> [t| Map Text $(mkFieldTypeName x) |] --AppT (AppT (ConT (mkName "Map")) (ConT $ mkName "Text")) (mkFieldTypeName x)-  S.Array x                     -> [t| [$(mkFieldTypeName x)] |]--AppT (ConT $ Text "[]") (mkFieldTypeName x)-  S.NamedType n                 -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x-  S.Fixed n _ _ _               -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x-  S.Enum n _ _ _ _ _            -> [t| $(conT $ mkDataTypeName n)|]-  _                             -> error $ "Avro type is not supported: " <> show t+mkFieldTypeName :: NamespaceBehavior -> S.Type -> Q TH.Type+mkFieldTypeName namespaceBehavior = \case+  S.Boolean          -> [t| Bool |]+  S.Long             -> [t| Int64 |]+  S.Int              -> [t| Int32 |]+  S.Float            -> [t| Float |]+  S.Double           -> [t| Double |]+  S.Bytes            -> [t| ByteString |]+  S.String           -> [t| Text |]+  S.Union branches _ -> union 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)|]+  t                  -> error $ "Avro type is not supported: " <> show t+  where go = mkFieldTypeName namespaceBehavior+        union = \case+          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) |]+          _                 ->+            error "Unions with more than 5 elements are not yet supported"  updateFirst :: (Text -> Text) -> Text -> Text updateFirst f t =@@ -446,9 +555,9 @@ decodeSchema :: FilePath -> IO (Either String Schema) decodeSchema p = eitherDecode <$> LBS.readFile p -mkAdtCtorName :: TypeName -> Text -> Name-mkAdtCtorName prefix nm =-  concatNames (mkDataTypeName prefix) (mkDataTypeName' nm)+mkAdtCtorName :: NamespaceBehavior -> TypeName -> Text -> Name+mkAdtCtorName namespaceBehavior prefix nm =+  concatNames (mkDataTypeName namespaceBehavior prefix) (mkDataTypeName' nm)  concatNames :: Name -> Name -> Name concatNames a b = mkName $ nameBase a <> nameBase b@@ -458,22 +567,47 @@   let valid c = isAlphaNum c || c == '\'' || c == '_'   in T.concat . T.split (not . valid) -mkSchemaValueName :: TypeName -> Name-mkSchemaValueName (TN n) = mkTextName $ "schema'" <> n+-- | Renders a fully qualified Avro name to a valid Haskell+-- identifier. This does not change capitalization—make sure to+-- capitalize as needed depending on whether the name is a Haskell+-- type, constructor, variable or field.+--+-- With 'HandleNamespaces', namespace components (if any) are+-- separated with @'@. The Avro name @"com.example.foo"@ would be+-- rendered as @com'example'foo@.+--+-- With 'IgnoreNamespaces', only the base name of the type is+-- used. The Avro name @"com.example.foo"@ would be rendered as+-- @"foo"@.+renderName :: NamespaceBehavior+              -- ^ How to handle namespaces when generating the type+              -- name.+           -> TypeName+              -- ^ The name to transform into a valid Haskell+              -- identifier.+           -> Text+renderName namespaceBehavior (TN name namespace) = case namespaceBehavior of+  HandleNamespaces -> Text.intercalate "'" $ namespace <> [name]+  IgnoreNamespaces -> name -mkDataTypeName :: TypeName -> Name-mkDataTypeName = mkDataTypeName' . unTN+mkSchemaValueName :: NamespaceBehavior -> TypeName -> Name+mkSchemaValueName namespaceBehavior typeName =+  mkTextName $ "schema'" <> renderName namespaceBehavior typeName +mkDataTypeName :: NamespaceBehavior -> TypeName -> Name+mkDataTypeName namespaceBehavior = mkDataTypeName' . renderName namespaceBehavior+ mkDataTypeName' :: Text -> Name mkDataTypeName' =   mkTextName . sanitiseName . updateFirst T.toUpper . T.takeWhileEnd (/='.')  mkField :: DeriveOptions -> TypeName -> Field -> Q VarStrictType-mkField opts prefix field = do-  ftype <- mkFieldTypeName (fldType field)-  let fName = mkTextName $ (fieldNameBuilder opts) prefix field+mkField opts typeName field = do+  ftype <- mkFieldTypeName (namespaceBehavior opts) (fldType field)+  let prefix = renderName (namespaceBehavior opts) typeName+      fName = mkTextName $ (fieldNameBuilder opts) prefix field       (fieldStrictness, fieldUnpackedness) =-        fieldRepresentation opts prefix field+        fieldRepresentation opts typeName field       strictness =         case fieldStrictness of           StrictField -> strict fieldUnpackedness

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE OverloadedStrings #-} module Data.Avro.Deriving.NormSchema@@ -38,18 +39,16 @@  -- Ensures normalisation: "extracted" record is self-contained and -- all the named types are resolvable within the scope of the schema.--- TODO: Improve story with namespaces normSchema :: Schema -> State (M.Map TypeName Schema) Schema normSchema r = case r of   t@(NamedType tn) -> do-    let sn = shortName tn     resolved <- get-    case M.lookup sn resolved of+    case M.lookup tn resolved of       Just rs ->         -- use the looked up schema (which might be a full record) and replace         -- it in the state with NamedType for future resolves         -- because only one full definition per schema is needed-        modify' (M.insert sn t) >> pure rs+        modify' (M.insert tn t) >> pure rs          -- NamedType but no corresponding record?! Baaad!       Nothing ->@@ -59,12 +58,9 @@   Map s     -> Map <$> normSchema s   Union l f -> flip Union f <$> traverse normSchema l   r@Record{name = tn}  -> do-    let sn = shortName tn-    modify' (M.insert sn (NamedType tn))+    modify' (M.insert tn (NamedType tn))     flds <- mapM (\fld -> setType fld <$> normSchema (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)

@@ -25,6 +25,7 @@ import qualified Data.Text.Lazy       as TL import           Data.Tagged import qualified Data.Vector          as V+import qualified Data.Vector.Unboxed  as U import           Data.Word  class HasAvroSchema a => FromAvro a where@@ -85,6 +86,14 @@ instance FromAvro a => FromAvro [a] where   fromAvro (T.Array vec) = mapM fromAvro $ toList vec   fromAvro v = badValue v "[a]"++instance FromAvro a => FromAvro (V.Vector a) where+  fromAvro (T.Array vec) = mapM fromAvro vec+  fromAvro v             = badValue v "Vector a"++instance (U.Unbox a, FromAvro a) => FromAvro (U.Vector a) where+  fromAvro (T.Array vec) = U.convert <$> mapM fromAvro vec+  fromAvro v             = badValue v "Unboxed Vector a"  instance FromAvro Text where   fromAvro (T.String txt) = pure txt

@@ -80,7 +80,7 @@   parseAvroJSON union env schema json   where     env =-      Schema.buildTypeEnvironment missing schema . Schema.TN+      Schema.buildTypeEnvironment missing schema     missing name =       fail ("Type " <> show name <> " not in schema") 

@@ -1,8 +1,10 @@ {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns        #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TupleSections         #-} {-# LANGUAGE TypeSynonymInstances  #-} {-# LANGUAGE ViewPatterns          #-}@@ -19,6 +21,7 @@     Schema, Type(..)   , Field(..), Order(..)   , TypeName(..)+  , renderFullname   , mkEnum, mkUnion   , validateSchema   -- * Lower level utilities@@ -33,12 +36,16 @@   , serializeBytes    , parseAvroJSON++  , overlay+  , subdefinition   ) where  import           Control.Applicative import           Control.Monad.Except import qualified Control.Monad.Fail         as MF import           Control.Monad.State.Strict+ import           Data.Aeson                 (FromJSON (..), ToJSON (..), object,                                              (.!=), (.:), (.:!), (.:?), (.=)) import qualified Data.Aeson                 as A@@ -55,7 +62,7 @@ import qualified Data.List                  as L import           Data.List.NonEmpty         (NonEmpty (..)) import qualified Data.List.NonEmpty         as NE-import           Data.Maybe                 (catMaybes, fromMaybe)+import           Data.Maybe                 (catMaybes, fromMaybe, isJust) import           Data.Monoid                (First (..)) import           Data.Semigroup import qualified Data.Set                   as S@@ -92,15 +99,13 @@       | Map   { values :: Type }       | NamedType TypeName       -- Declared types-      | Record { name      :: TypeName-               , namespace :: Maybe Text-               , aliases   :: [TypeName]-               , doc       :: Maybe Text-               , order     :: Maybe Order-               , fields    :: [Field]+      | Record { name    :: TypeName+               , aliases :: [TypeName]+               , doc     :: Maybe Text+               , order   :: Maybe Order+               , fields  :: [Field]                }       | Enum { name         :: TypeName-             , namespace    :: Maybe Text              , aliases      :: [TypeName]              , doc          :: Maybe Text              , symbols      :: [Text]@@ -109,39 +114,49 @@       | Union { options     :: NonEmpty Type               , unionLookup :: Int64 -> Maybe Type               }-      | Fixed { name      :: TypeName-              , namespace :: Maybe Text-              , aliases   :: [TypeName]-              , size      :: Int+      | Fixed { name    :: TypeName+              , aliases :: [TypeName]+              , size    :: Int               }     deriving (Show)  instance Eq Type where   Null == Null = True   Boolean == Boolean = True-  Int   == Int = True+  Int == Int = True   Long == Long = True   Float == Float = True   Double == Double = True   Bytes == Bytes = True   String == String = True+   Array ty == Array ty2 = ty == ty2   Map ty == Map ty2 = ty == ty2   NamedType t == NamedType t2 = t == t2-  Record name1 ns1 _ _ _ fs1 == Record name2 ns2 _ _ _ fs2 =-    and [name1 == name2, ns1 == ns2, fs1 == fs2]-  Enum _ _ _ _ s _ == Enum _ _ _ _ s2 _ = s == s2++  Record name1 _ _ _ fs1 == Record name2 _ _ _ fs2 =+    and [name1 == name2, fs1 == fs2]+  Enum name1 _ _ s _ == Enum name2 _ _ s2 _ =+    and [name1 == name2, s == s2]   Union a _ == Union b _ = a == b-  Fixed _ _ _ s == Fixed _ _ _ s2 = s == s2+  Fixed name1 _ s == Fixed name2 _ s2 =+    and [name1 == name2, s == s2]+   _ == _ = False --- | @mkEnum name aliases namespace docs syms@ Constructs an `Enum` schema using--- the enumeration type's name, aliases (if any), namespace, documentation, and list of--- symbols that inhabit the enumeration.-mkEnum :: TypeName -> [TypeName] -> Maybe Text -> Maybe Text -> [Text] -> Type-mkEnum n as ns d ss = Enum n ns as d ss (\i -> IM.lookup (fromIntegral i) mp)- where- mp = IM.fromList (zip [0..] ss)+-- | Build an 'Enum' value from its components.+mkEnum :: TypeName+          -- ^ The name of the enum (includes namespace).+       -> [TypeName]+          -- ^ Aliases for the enum (if any).+       -> Maybe Text+          -- ^ Optional documentation for the enum.+       -> [Text]+          -- ^ The symbols of the enum.+       -> Type+mkEnum name aliases doc symbols = Enum name aliases doc symbols lookup+ where lookup i = IM.lookup (fromIntegral i) table+       table    = IM.fromList $ [0..] `zip` symbols  -- | @mkUnion subTypes@ Defines a union of the provided subTypes.  N.B. it is -- invalid Avro to include another union or to have more than one of the same@@ -150,43 +165,123 @@ mkUnion os = Union os (\i -> IM.lookup (fromIntegral i) mp)  where mp = IM.fromList (zip [0..] $ NE.toList os) -newtype TypeName = TN { unTN :: T.Text }+-- | A named type in Avro has a name and, optionally, a namespace.+--+-- A name is a string that starts with an ASCII letter or underscore+-- followed by letters, underscores and digits:+--+-- @+-- name ::= [A-Za-z_][A-Za-z0-9_]*+-- @+--+-- Examples include @"_foo7"@, @"Bar_"@ and @"x"@.+--+-- A namespace is a sequence of names with the same lexical+-- structure. When written as a string, the components of a namespace+-- are separated with dots (@"com.example"@).+--+-- 'TypeName' represents a /fullname/—a name combined with a+-- namespace. These are written and parsed as dot-separated+-- strings. The 'TypeName' @TN "Foo" ["com", "example"]@ is rendered+-- as @"com.example.Foo"@.+--+-- Fullnames have to be globally unique inside an Avro schema.+data TypeName = TN { baseName  :: T.Text+                   , namespace :: [T.Text]+                   }   deriving (Eq, Ord) +-- | Show the 'TypeName' as a string literal compatible with its+-- 'IsString' instance. instance Show TypeName where-  show (TN s) = show s+  show = show . renderFullname -instance Semigroup TypeName where-  TN a <> TN b = TN (a <> b)+-- | Render a fullname as a dot separated string.+--+-- @+-- > renderFullname (TN "Foo" ["com", "example"])+-- "com.example.Foo"+-- @+renderFullname :: TypeName -> T.Text+renderFullname TN { baseName, namespace } = T.intercalate "." $ namespace <> [baseName] -instance Monoid TypeName where-  mempty = TN mempty-  mappend = (<>)+-- | Parses a fullname into a 'TypeName', assuming the string+-- representation is valid.+--+-- @+-- > parseFullname "com.example.Foo"+-- TN { baseName = "Foo", components = ["com", "example"] }+-- @+parseFullname :: T.Text -> TypeName+parseFullname (T.splitOn "." -> components) = TN+  { baseName  = last components+  , namespace = init components+  } +-- | Build a type name out of the @name@ and @namespace@ fields of an+-- Avro record, enum or fixed definition.+--+-- This follows the rules laid out in the Avro specification:+--+--  1. If the @"name"@ field contains dots, it is parsed as a+--  /fullname/ (see 'parseFullname') and the @"namespace"@ field is+--  ignored if present.+--+--  2. Otherwise, if both @"name"@ and @"namespace"@ fields are+--  present, they make up the /fullname/+--+--  3. If only the @"name"@ field is specified, the @"namespace"@ is+--  inferred from the namespace of the most tightly enclosing schema+--  or protocol (the "context"). If there is no containing schema, the+--  namespace is null.+mkTypeName :: Maybe TypeName+              -- ^ The name of the enclosing schema or protocol, if+              -- any. This provides the context for inferring+              -- namespaces.+           -> Text+              -- ^ The @"name"@ field of the definition.+           -> Maybe Text+              -- ^ The @"namespace"@ field of the definition, if+              -- present.+           -> TypeName+              -- ^ The resulting /fullname/ of the generated type,+              -- according to the rules laid out above.+mkTypeName context name ns+  | isFullName name = parseFullname name+  | otherwise       = case ns of+      Just ns -> TN name $ T.splitOn "." ns+      Nothing -> TN name $ fromMaybe [] $ namespace <$> context+  where isFullName = isJust . T.find (== '.')++-- | This lets us write 'TypeName's as string literals in a fully+-- qualified style. @"com.example.foo"@ is the name @"foo"@ with the+-- namespace @"com.example"@; @"foo"@ is the name @"foo"@ with no+-- namespace. instance IsString TypeName where-  fromString = TN . fromString+  fromString = parseFullname . fromString  instance Hashable TypeName where-  hashWithSalt s (TN t) = hashWithSalt (hashWithSalt s ("AvroTypeName" :: Text)) t+  hashWithSalt s (renderFullname -> name) =+    hashWithSalt (hashWithSalt s ("AvroTypeName" :: Text)) name  -- |Get the name of the type.  In the case of unions, get the name of the -- first value in the union schema. typeName :: Type -> Text typeName bt =   case bt of-    Null             -> "null"-    Boolean          -> "boolean"-    Int              -> "int"-    Long             -> "long"-    Float            -> "float"-    Double           -> "double"-    Bytes            -> "bytes"-    String           -> "string"-    Array _          -> "array"-    Map   _          -> "map"-    NamedType (TN t) -> t-    Union (x:|_) _   -> typeName x-    _                -> unTN $ name bt+    Null           -> "null"+    Boolean        -> "boolean"+    Int            -> "int"+    Long           -> "long"+    Float          -> "float"+    Double         -> "double"+    Bytes          -> "bytes"+    String         -> "string"+    Array _        -> "array"+    Map   _        -> "map"+    NamedType name -> renderFullname name+    Union (x:|_) _ -> typeName x+    _              -> renderFullname $ name bt  data Field = Field { fldName    :: Text                    , fldAliases :: [Text]@@ -201,135 +296,180 @@   deriving (Eq, Ord, Show)  instance FromJSON Type where-  parseJSON (A.String s) =-    case s of-      "null"    -> return Null-      "boolean" -> return Boolean-      "int"     -> return Int-      "long"    -> return Long-      "float"   -> return Float-      "double"  -> return Double-      "bytes"   -> return Bytes-      "string"  -> return String-      somename  -> return (NamedType (TN somename))-  parseJSON (A.Object o) = do-    mbLogicalType <- o .:? ("logicalType" :: Text) :: Parser (Maybe Text)-    ty            <- o .:  ("type" :: Text)+  parseJSON = parseSchemaJSON Nothing -    case mbLogicalType of+-- | A helper function that parses an Avro schema from JSON, resolving+-- namespaces based on context.+--+-- See 'mkTypeName' for details on how namespaces are resolved.+parseSchemaJSON :: Maybe TypeName+                -- ^ The name of the enclosing type of this schema, if+                -- any. Used to resolve namespaces.+                -> A.Value+                -- ^ An Avro schema encoded in JSON.+                -> Parser Schema+parseSchemaJSON context = \case+  A.String s -> case s of+    "null"    -> return Null+    "boolean" -> return Boolean+    "int"     -> return Int+    "long"    -> return Long+    "float"   -> return Float+    "double"  -> return Double+    "bytes"   -> return Bytes+    "string"  -> return String+    somename  -> return $ NamedType $ mkTypeName context somename Nothing+  A.Array arr+    | V.length arr > 0 ->+      mkUnion . NE.fromList <$> mapM (parseSchemaJSON context) (V.toList arr)+    | otherwise        -> fail "Unions must have at least one type."+  A.Object o -> do+    logicalType :: Maybe Text <- o .:? "logicalType"+    ty                        <- o .: "type"++    case logicalType of       Just _  -> parseJSON (A.String ty)-      Nothing ->-        case ty of-          "map"    -> Map   <$> o .: ("values" :: Text)-          "array"  -> Array <$> o .: ("items"  :: Text)-          "record" ->-            Record <$> o .:  ("name" :: Text)-                  <*> o .:? ("namespace" :: Text)-                  <*> o .:? ("aliases" :: Text) .!= []-                  <*> o .:? ("doc" :: Text)-                  <*> o .:? ("order" :: Text) .!= Just Ascending-                  <*> o .:  ("fields" :: Text)-          "enum"   ->-            mkEnum <$> o .:  ("name" :: Text)-                  <*> o .:? ("aliases" :: Text)  .!= []-                  <*> o .:? ("namespace" :: Text)-                  <*> o .:? ("doc" :: Text)-                  <*> o .:  ("symbols" :: Text)-          "fixed"  ->-            Fixed <$> o .:  ("name" :: Text)-                  <*> o .:? ("namespace" :: Text)-                  <*> o .:? ("aliases" :: Text) .!= []-                  <*> o .:  ("size" :: Text)-          s  -> fail $ "Unrecognized object type: " <> T.unpack s-  parseJSON (A.Array arr) | V.length arr > 0 =-           mkUnion . NE.fromList <$> mapM parseJSON (V.toList arr)-  parseJSON foo = typeMismatch "Invalid JSON for Avro Schema" foo+      Nothing -> case ty of+        "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"+          order   <- o .:? "order" .!= Just Ascending+          fields  <- mapM (parseField typeName) =<< o .: "fields"+          pure $ Record typeName aliases doc order 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+        "fixed"  -> 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+        s        -> fail $ "Unrecognized object type: " <> T.unpack s -instance ToJSON Type where-  toJSON bt =-    case bt of-      Null     -> A.String "null"-      Boolean  -> A.String "boolean"-      Int      -> A.String "int"-      Long     -> A.String "long"-      Float    -> A.String "float"-      Double   -> A.String "double"-      Bytes    -> A.String "bytes"-      String   -> A.String "string"-      Array tn -> object [ "type" .= ("array" :: Text), "items" .= tn ]-      Map tn   -> object [ "type" .= ("map" :: Text), "values" .= tn ]-      NamedType (TN tn) -> A.String tn-      Record {..} ->-        let opts = catMaybes-               [ ("order" .=)     <$> order-               , ("namespace" .=) <$> namespace-               , ("doc" .=)       <$> doc-               ]-         in object $ opts ++-               [ "type"      .= ("record" :: Text)-               , "name"      .= name-               , "aliases"   .= aliases-               , "fields"    .= fields-               ]-      Enum   {..} ->-        let opts = catMaybes-               [ ("namespace" .=) <$> namespace-               , ("doc" .=)       <$> doc-               ]-         in object $ opts ++-               [ "type"      .= ("enum" :: Text)-               , "name"      .= name-               , "aliases"   .= aliases-               , "symbols"   .= symbols-               ]-      Union  {..} -> A.Array $ V.fromList $ P.map toJSON (NE.toList options)-      Fixed  {..} ->-        let opts = catMaybes-               [ ("namespace" .=) <$> namespace ]-         in object $ opts ++-               [ "type"      .= ("fixed" :: Text)-               , "name"      .= name-               , "aliases"   .= aliases-               , "size"      .= size-               ]+  invalid    -> typeMismatch "Invalid JSON for Avro Schema" invalid -instance ToJSON TypeName where-  toJSON (TN t) = A.String t+-- | Parse aliases, inferring the namespace based on the type being aliases.+mkAliases :: TypeName+             -- ^ The name of the type being aliased.+          -> [Text]+             -- ^ The aliases.+          -> [TypeName]+mkAliases context = map $ \ name ->+  mkTypeName (Just context) name Nothing -instance FromJSON TypeName where-  parseJSON (A.String s) = return (TN s)-  parseJSON j            = typeMismatch "TypeName" j+-- | A helper function that parses field definitions, using the name+-- of the record for namespace resolution (see 'mkTypeName' for more+-- details).+parseField :: TypeName+              -- ^ The name of the record this field belongs to.+           -> A.Value+              -- ^ The JSON object defining the field in the schema.+           -> Parser Field+parseField record = \case+  A.Object o -> do+    name  <- o .: "name"+    doc   <- o .:? "doc"+    ty    <- parseSchemaJSON (Just record) =<< o .: "type"+    let err = fail "Haskell Avro bindings does not support default for aliased or recursive types at this time."+    defM  <- o .:! "default"+    def   <- case parseFieldDefault err ty <$> defM of+      Just (Success x) -> return (Just x)+      Just (Error e)   -> fail e+      Nothing          -> return Nothing+    order <- o .:? ("order" :: Text)    .!= Just Ascending -instance FromJSON Field where-  parseJSON (A.Object o) =-    do nm  <- o .: "name"-       doc <- o .:? "doc"-       ty  <- o .: "type"-       let err = fail "Haskell Avro bindings does not support default for aliased or recursive types at this time."-       defM <- o .:! "default"-       def <- case parseFieldDefault err ty <$> defM of-                Just (Success x) -> return (Just x)-                Just (Error e)   -> fail e-                Nothing          -> return Nothing-       od  <- o .:? ("order" :: Text)    .!= Just Ascending-       al  <- o .:? ("aliases" :: Text)  .!= []-       return $ Field nm al doc od ty def+    let mkAlias name = mkTypeName (Just record) name Nothing+    aliases  <- o .:? "aliases"  .!= []+    return $ Field name aliases doc order ty def+  invalid    -> typeMismatch "Field" invalid -  parseJSON j = typeMismatch "Field " j+instance ToJSON Type where+  toJSON = schemaToJSON Nothing -instance ToJSON Field where-  toJSON Field {..} =+-- | Serializes a 'Schema' to JSON.+--+-- The optional name is used as the context for namespace+-- inference. If the context has the namespace @com.example@, then any+-- names in the @com.example@ namespace will be rendered without an+-- explicit namespace.+schemaToJSON :: Maybe TypeName+                -- ^ The context used for keeping track of namespace+                -- inference.+             -> Schema+                -- ^ The schema to serialize to JSON.+             -> A.Value+schemaToJSON context = \case+  Null           -> A.String "null"+  Boolean        -> A.String "boolean"+  Int            -> A.String "int"+  Long           -> A.String "long"+  Float          -> A.String "float"+  Double         -> A.String "double"+  Bytes          -> A.String "bytes"+  String         -> A.String "string"+  Array tn       ->+    object [ "type" .= ("array" :: Text), "items" .= schemaToJSON context tn ]+  Map tn         ->+    object [ "type" .= ("map" :: Text), "values" .= schemaToJSON context tn ]+  NamedType name -> toJSON $ render context name+  Record {..}    ->     let opts = catMaybes-           [ ("order" .=)     <$> fldOrder-           , ("doc" .=)       <$> fldDoc-           , ("default" .=)   <$> fldDefault-           ]-     in object $ opts ++-           [ "name"    .= fldName-           , "type"    .= fldType-           , "aliases" .= fldAliases+          [ ("order" .=) <$> order+          , ("doc" .=)   <$> doc+          ]+    in object $ opts +++       [ "type"    .= ("record" :: Text)+       , "name"    .= render context name+       , "aliases" .= (render (Just name) <$> aliases)+       , "fields"  .= (fieldToJSON name <$> fields)+       ]+  Enum   {..} ->+    let opts = catMaybes [("doc" .=) <$> doc]+    in object $ opts +++       [ "type"    .= ("enum" :: Text)+       , "name"    .= render context name+       , "aliases" .= (render (Just name) <$> aliases)+       , "symbols" .= symbols+       ]+  Union  {..} -> toJSON $ schemaToJSON context <$> options+  Fixed  {..} ->+    object [ "type"    .= ("fixed" :: Text)+           , "name"    .= render context name+           , "aliases" .= (render (Just name) <$> aliases)+           , "size"    .= size            ]+  where render context typeName+          | Just ctx <- context+          , namespace ctx == namespace typeName = baseName typeName+          | otherwise                           = renderFullname typeName +        fieldToJSON context Field {..} =+          let opts = catMaybes+                [ ("order" .=)     <$> fldOrder+                , ("doc" .=)       <$> fldDoc+                , ("default" .=)   <$> fldDefault+                ]+          in object $ opts +++             [ "name"    .= fldName+             , "type"    .= schemaToJSON (Just context) fldType+             , "aliases" .= fldAliases+             ]+ instance ToJSON (Ty.Value Type) where   toJSON av =     case av of@@ -387,7 +527,6 @@   (<>) = mplus instance Monoid (Result a) where   mempty = fail "Empty Result"-  mappend = mplus instance Foldable Result where   foldMap _ (Error _)   = mempty   foldMap f (Success y) = f y@@ -400,7 +539,13 @@ -- | Field defaults are in the normal Avro JSON format except for -- unions. Default values for unions are specified as JSON encodings -- of the first type in the union.-parseFieldDefault :: (Text -> Maybe Type) -> Type -> A.Value -> Result (Ty.Value Type)+parseFieldDefault :: (TypeName -> Maybe Type)+                     -- ^ Lookup function for names defined in schema.+                  -> Schema+                     -- ^ The schema of the default value being parsed.+                  -> A.Value+                     -- ^ JSON encoding of an Avro value.+                  -> Result (Ty.Value Schema) parseFieldDefault env schema value = parseAvroJSON defaultUnion env schema value   where defaultUnion (Union ts@(t :| _) _) val = Ty.Union ts t <$> parseFieldDefault env t val         defaultUnion _ _                       = error "Impossible: not Union."@@ -415,13 +560,13 @@                  -- This function will only ever be passed 'Union'                  -- schemas. It /should/ error out if this is not the                  -- case—it represents a bug in this code.-              -> (Text -> Maybe Type)+              -> (TypeName -> Maybe Type)               -> Type               -> A.Value               -> Result (Ty.Value Type)-parseAvroJSON union env (NamedType (TN tn)) av =-  case env tn of-    Nothing -> fail $ "Could not resolve type name for " <> show tn+parseAvroJSON union env (NamedType name) av =+  case env name of+    Nothing -> fail $ "Could not resolve type name for " <> T.unpack (renderFullname name)     Just t  -> parseAvroJSON union env t av parseAvroJSON union _ u@Union{} av             = union u av parseAvroJSON union env ty av                  =@@ -521,31 +666,24 @@ validateSchema _sch = return () -- XXX TODO  -- | @buildTypeEnvironment schema@ builds a function mapping type names to--- the types declared in the traversed schema.  Notice this function does not--- currently handle namespaces in a correct manner, possibly allowing--- for bad environment lookups when used on complex schemas.-buildTypeEnvironment :: Applicative m => (TypeName -> m Type) -> Type -> TypeName -> m Type+-- the types declared in the traversed schema.+--+-- This mapping includes both the base type names and any aliases they+-- have. Aliases and normal names are not differentiated in any way.+buildTypeEnvironment :: Applicative m+                     => (TypeName -> m Type)+                        -- ^ Callback to handle type names not in the+                        -- schema.+                     -> Schema+                        -- ^ The schema that we're generating a lookup+                        -- function for.+                     -> (TypeName -> m Type) buildTypeEnvironment failure from =-    \forTy -> case HashMap.lookup forTy mp of-                Nothing  -> failure forTy-                Just res -> pure res+    \ forTy -> case HashMap.lookup forTy env of+                 Nothing  -> failure forTy+                 Just res -> pure res   where-  mp = HashMap.fromList $ go from-  go :: Type -> [(TypeName,Type)]-  go ty =-    let mk :: TypeName -> [TypeName] -> Maybe Text -> [(TypeName,Type)]-        mk n as ns =-            let unqual = n:as-                qual   = maybe [] (\x -> P.map (mappend (TN x <> ".")) unqual) ns-            in zip (unqual ++ qual) (repeat ty)-    in case ty of-        Record {..} -> mk name aliases namespace ++ concatMap (go . fldType) fields-        Enum {..}   -> mk name aliases namespace-        Union {..}  -> concatMap go options-        Fixed {..}  -> mk name aliases namespace-        Array {..}  -> go item-        Map {..}    -> go values-        _           -> []+    env = extractBindings from  -- | Checks that two schemas match. This is like equality of schemas, -- except 'NamedTypes' match against other types /with the same name/.@@ -553,15 +691,63 @@ -- This extends recursively: two records match if they have the same -- name, the same number of fields and the fields all match. matches :: Type -> Type -> Bool-matches (NamedType (TN n)) t        = n == typeName t-matches t (NamedType (TN n))        = typeName t == n+matches n@NamedType{} t             = typeName n == typeName t+matches t n@NamedType{}             = typeName t == typeName n matches (Array itemA) (Array itemB) = matches itemA itemB matches a@Record{} b@Record{}       =   and [ name a == name b-      , namespace a == namespace b       , length (fields a) == length (fields b)       , and $ zipWith fieldMatches (fields a) (fields b)       ]   where fieldMatches = matches `on` fldType matches a@Union{} b@Union{}         = and $ NE.zipWith matches (options a) (options b) matches t1 t2                       = t1 == t2++-- | @extractBindings schema@ traverses a schema and builds a map of all declared+-- types.+--+-- Types declared implicitly in record field definitions are also included. No distinction+-- is made between aliases and normal names.+extractBindings :: Type -> HashMap.HashMap TypeName Type+extractBindings = typeBindings HashMap.empty+  where+    insertAll :: (Eq k, Hashable k) => [k] -> v -> HashMap.HashMap k v -> HashMap.HashMap k v+    insertAll keys value table = foldl (\hashmap key -> HashMap.insert key value hashmap) table keys++    fieldBindings :: HashMap.HashMap TypeName Type -> Field -> HashMap.HashMap TypeName Type+    fieldBindings table Field{..} = typeBindings table fldType++    typeBindings :: HashMap.HashMap TypeName Type -> Type -> HashMap.HashMap TypeName Type+    typeBindings table t@Record{..} =+      let withRecord = insertAll (name : aliases) t table+      in HashMap.unions $ map (fieldBindings withRecord) fields+    typeBindings table e@Enum{..}  = insertAll (name : aliases) e table+    typeBindings table Union{..}   = HashMap.unions $ NE.toList $ NE.map (typeBindings table) options+    typeBindings table f@Fixed{..} = insertAll (name : aliases) f table+    typeBindings table _           = table++-- | Merge two schemas to produce a third.+-- Specifically, @overlay schema reference@ fills in 'NamedTypes' in 'schema' using any matching definitions from 'reference'.++overlay :: Type -> Type -> Type+overlay input supplement = overlayType input+  where+    overlayField f@Field{..}      = f { fldType = overlayType fldType }+    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{..}      = u {+                                      options     = NE.map overlayType options,+                                      unionLookup = \i -> case unionLookup i of+                                                            Just named@(NamedType _) -> Just $ rebind named+                                                            other                    -> other+                                   }+    overlayType  nt@(NamedType _) = rebind nt+    overlayType  other            = other++    rebind (NamedType tn) = HashMap.lookupDefault (NamedType tn) tn bindings+    bindings              = extractBindings supplement++-- | Extract the named inner type definition as its own schema.+subdefinition :: Type -> Text -> Maybe Type+subdefinition schema name = mkTypeName Nothing name Nothing `HashMap.lookup` extractBindings schema

@@ -21,6 +21,7 @@ import qualified Data.Text.Lazy       as TL import           Data.Tagged import qualified Data.Vector          as V+import qualified Data.Vector.Unboxed  as U import           Data.Word  class HasAvroSchema a => ToAvro a where@@ -97,3 +98,8 @@ instance (ToAvro a) => ToAvro [a] where   toAvro = T.Array . V.fromList . (toAvro <$>) +instance (ToAvro a) => ToAvro (V.Vector a) where+  toAvro = T.Array . V.map toAvro++instance (U.Unbox a, ToAvro a) => ToAvro (U.Vector a) where+  toAvro = T.Array . V.map toAvro . U.convert

@@ -6,6 +6,8 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Text as T+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U  import Test.Hspec import qualified Test.QuickCheck as Q@@ -19,3 +21,11 @@   it "map roundtrip" $ Q.property $ \(xs :: Map String Int) ->     let xs' = M.mapKeys T.pack xs     in decode (encode xs') == Success xs'++  it "vector roundtrip" $ Q.property $ \(xs :: [Int]) ->+    let vec = V.fromList xs+    in decode (encode vec) == Success vec++  it "unboxed vector roundtrip" $ Q.property $ \(xs :: [Int]) ->+    let vec = U.fromList xs+    in decode (encode vec) == Success vec

@@ -26,7 +26,7 @@ onlyBoolSchema :: Schema onlyBoolSchema =   let fld nm = Field nm [] Nothing Nothing-   in Record "OnlyBool" (Just "test.contract") [] Nothing Nothing+   in Record "test.contract.OnlyBool" [] Nothing Nothing         [ fld "onlyBoolValue" Boolean Nothing         ] 

@@ -20,7 +20,7 @@ onlyDoubleSchema :: Schema onlyDoubleSchema =   let fld nm = Field nm [] Nothing Nothing-  in Record "OnlyDouble" (Just "test.contract") [] Nothing Nothing+  in Record "test.contract.OnlyDouble" [] Nothing Nothing         [ fld "onlyDoubleValue" Double Nothing         ] 

@@ -20,7 +20,7 @@ onlyFloatSchema :: Schema onlyFloatSchema =   let fld nm = Field nm [] Nothing Nothing-  in Record "OnlyFloat" (Just "test.contract") [] Nothing Nothing+  in Record "test.contract.OnlyFloat" [] Nothing Nothing         [ fld "onlyFloatValue" Float Nothing         ] 

@@ -33,7 +33,7 @@ onlyInt64Schema :: Schema onlyInt64Schema =   let fld nm = Field nm [] Nothing Nothing-   in Record "OnlyInt64" (Just "test.contract") [] Nothing Nothing+   in Record "test.contract.OnlyInt64" [] Nothing Nothing         [ fld "onlyInt64Value"    Long Nothing         ] 

@@ -23,7 +23,7 @@ onlyMaybeBoolSchema :: Schema onlyMaybeBoolSchema =   let fld nm = Field nm [] Nothing Nothing-   in Record "onlyMaybeBool" (Just "test.contract") [] Nothing Nothing+   in Record "test.contract.onlyMaybeBool" [] Nothing Nothing         [ fld "onlyMaybeBoolValue" (mkUnion (Null :| [Boolean])) Nothing         ] 

@@ -24,7 +24,7 @@ childTypeSchema :: Schema childTypeSchema =   let fld nm = Field nm [] Nothing Nothing-  in Record "ChildType" (Just "test.contract") [] Nothing Nothing+  in Record "test.contract.ChildType" [] Nothing Nothing         [ fld "childValue1" Long Nothing         , fld "childValue2" Long Nothing         ]@@ -32,7 +32,7 @@ parentTypeSchema :: Schema parentTypeSchema =   let fld nm = Field nm [] Nothing Nothing-  in Record "ParentType" (Just "test.contract") [] Nothing Nothing+  in Record "test.contract.ParentType" [] Nothing Nothing         [ fld "parentValue1" Long             Nothing         , fld "parentValue2" (Array childTypeSchema)  Nothing] 

@@ -6,6 +6,7 @@ import           Data.Avro import           Data.Avro.Schema import           Data.Text+import qualified Data.ByteString.Lazy as BSL import           Data.Tagged import           Test.Hspec import qualified Data.Avro.Types      as AT@@ -20,7 +21,7 @@ onlyTextSchema :: Schema onlyTextSchema =   let fld nm = Field nm [] Nothing Nothing-  in Record "OnlyText" (Just "test.contract") [] Nothing Nothing+  in Record "test.contract.OnlyText" [] Nothing Nothing         [ fld "onlyTextValue" String Nothing         ] @@ -46,3 +47,10 @@   it "Can decode encoded Text values" $ do     Q.property $ \(t :: String) ->       decode (encode (OnlyText (pack t))) == Success (OnlyText (pack t))++  it "Can process corrupted Text values without crashing" $ do+    Q.property $ \bytes ->+      let result                   = decode (BSL.pack bytes) :: Result Text+          isSafeResult (Success _) = True+          isSafeResult (Error _)   = True+      in result `shouldSatisfy` isSafeResult

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy as LBS  import           Data.Avro.Deriving+import           Data.Avro.EitherN import           Data.Avro.JSON  import           Test.Hspec@@ -67,18 +68,24 @@     let expected = EnumWrapper 37 "blarg" EnumReasonInstead     parseJSON enumsExampleJSON `shouldBe` pure expected   let unionsExampleA = Unions-        { unionsScalars = Left "blarg"-        , unionsNullable = Nothing-        , unionsRecords = Left $ Foo { fooStuff = "stuff" }+        { unionsScalars    = Left "blarg"+        , unionsNullable   = Nothing+        , unionsRecords    = Left $ Foo { fooStuff = "stuff" }         , unionsSameFields = Left $ Foo { fooStuff = "foo stuff" }+        , unionsThree      = E3_1 37+        , unionsFour       = E4_2 "foo"+        , unionsFive       = E5_4 $ Foo { fooStuff = "foo stuff" }         }       unionsExampleB = Unions-        { unionsScalars = Right 37-        , unionsNullable = Just 42-        , unionsRecords = Right $ Bar { barStuff = "stuff"+        { unionsScalars    = Right 37+        , unionsNullable   = Just 42+        , unionsRecords    = Right $ Bar { barStuff = "stuff"                                       , barThings = Foo "things"                                       }         , unionsSameFields = Right $ NotFoo { notFooStuff = "not foo stuff" }+        , unionsThree      = E3_3 37+        , unionsFour       = E4_4 $ Foo { fooStuff = "foo stuff" }+        , unionsFive       = E5_5 $ NotFoo { notFooStuff = "not foo stuff" }         }   it "should roundtrip (unions)" $ do     forM_ [unionsExampleA, unionsExampleB] $ \ msg ->

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+module Avro.NamespaceSpec where++import           Control.Monad        (forM_)++import qualified Data.Aeson           as Aeson+import qualified Data.ByteString.Lazy as LBS++import           System.Directory     (doesFileExist, getCurrentDirectory)+import           System.Environment   (setEnv)++import           Test.Hspec++import           Paths_avro++import           Data.Avro.Schema++spec :: Spec+spec = describe "NamespaceSpec.hs: namespace inference in Avro schemas" $ do+  schemas <- runIO $ getFileName "test/data/namespace-inference.json" >>= LBS.readFile+  let parsedSchemas :: [Schema]+      Just parsedSchemas = Aeson.decode schemas+  it "should infer namespaces correctly" $ do+    forM_ parsedSchemas (`shouldBe` expected)+  it "should generate JSON with namespaces inferred" $ do+    -- the first schema in namespace-ifnerence.json is in the exact+    -- format we expect to serialize Schema values+    let expectedJSONSchema :: Aeson.Value+        Just expectedJSONSchema = head <$> Aeson.decode schemas+    Aeson.toJSON expected `shouldBe` expectedJSONSchema++expected :: Schema+expected = Record+  { name    = "com.example.Foo"+  , aliases = ["com.example.FooBar", "com.example.not.Bar"]+  , doc     = Just "An example schema to test namespace handling."+  , order   = Just Ascending+  , fields  = [field "bar" bar, field "baz" $ NamedType "com.example.baz.Baz"]+  }+  where field name schema = Field name [] Nothing (Just Ascending) schema Nothing++        bar = Record+          { name    = "com.example.Bar"+          , aliases = ["com.example.Bar2", "com.example.not.Foo"]+          , doc     = Nothing+          , order   = Just Ascending+          , fields  = [ field "baz" baz+                      , field "bazzy" $ NamedType "com.example.Bazzy"+                      ]+          }++        baz = Record+          { name    = "com.example.baz.Baz"+          , aliases = ["com.example.Bazzy"]+          , doc     = Nothing+          , order   = Just Ascending+          , fields  = [ field "baz"   $ NamedType "com.example.baz.Baz"+                      , field "bazzy" $ NamedType "com.example.Bazzy"+                      ]+          }++getFileName :: FilePath -> IO FilePath+getFileName p = do+  path <- getDataFileName p+  isOk <- doesFileExist path+  pure $ if isOk then path else p

@@ -22,7 +22,7 @@ spec :: Spec spec = describe "Avro.NormSchemaSpec" $ do   it "should have one full inner schema for each type" $-    (fldType <$> fields schema'ContainerChild) `shouldBe` [schema'ReusedChild, NamedType "ReusedChild"]+    (fldType <$> fields schema'ContainerChild) `shouldBe` [schema'ReusedChild, NamedType "Boo.ReusedChild"]    it "should normalise schemas from unions" $      fldType <$> fields schema'Curse `shouldBe` [mkUnion (Null :| [schema'Geo])]

@@ -7,7 +7,7 @@  import           Data.Avro import           Data.Avro.Deriving (makeSchema)-import           Data.Avro.Schema   (buildTypeEnvironment, matches)+import           Data.Avro.Schema   (overlay, matches)  import           Test.Hspec @@ -15,24 +15,10 @@  spec :: Spec spec = describe "Avro.SchemaSpec" $ do-  describe "buildTypeEnvironment" $-    it "should contain definitions for all internal types" $ do-      let schema      = $(makeSchema "test/data/internal-bindings.avsc")-          environment = buildTypeEnvironment err schema-          err name    = fail $ "Missing " ++ show name ++ " in environment."-          expected    =-            [ "InternalBindings"-            , "InField"-            , "NestedInField"-            , "AliasNestedInField"-            , "NestedEnum"-            , "NestedFixed"-            , "InArray"-            , "NestedInArray"-            , "InMap"-            , "NestedInMap"-            , "InUnionA"-            , "InUnionB"-            ]-      definitions <- traverse environment expected-      length definitions `shouldBe` length expected+  describe "overlay" $+    it "should support merging multiple schemas" $ do+      let expected   = $(makeSchema "test/data/overlay/expectation.avsc")+          consumer   = $(makeSchema "test/data/overlay/composite.avsc")+          primitives = $(makeSchema "test/data/overlay/primitives.avsc")++      consumer `overlay` primitives `shouldSatisfy` matches expected

@@ -11,15 +11,14 @@ import           Test.Hspec  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-}--deriveAvro "test/data/enums.avsc"+deriveAvroWithOptions (defaultDeriveOptions { namespaceBehavior = HandleNamespaces }) "test/data/enums.avsc"  spec :: Spec spec = describe "Avro.THEnumSpec: Schema with enums" $ do   it "should do roundtrip" $ do-    let msg = EnumWrapper-              { enumWrapperId   = 42-              , enumWrapperName = "Text"-              , enumWrapperReason = EnumReasonBecause+    let msg = Haskell'avro'example'EnumWrapper+              { haskell'avro'example'EnumWrapperId   = 42+              , haskell'avro'example'EnumWrapperName = "Text"+              , haskell'avro'example'EnumWrapperReason = Haskell'avro'example'EnumReasonBecause               }     fromAvro (toAvro msg) `shouldBe` pure msg

@@ -12,23 +12,24 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} -deriveAvro "test/data/reused.avsc"+deriveAvroWithOptions (defaultDeriveOptions { namespaceBehavior = HandleNamespaces }) "test/data/reused.avsc"  spec :: Spec spec = describe "Avro.THReusedSpec: Schema with named types" $ do-  let container = ContainerChild-                  { containerChildFstIncluded = ReusedChild 100-                  , containerChildSndIncluded = ReusedChild 200+  let container = Boo'ContainerChild+                  { boo'ContainerChildFstIncluded = Boo'ReusedChild 100+                  , boo'ContainerChildSndIncluded = Boo'ReusedChild 200                   }-  let wrapper = ReusedWrapper-                { reusedWrapperFull  = ReusedChild 42-                , reusedWrapperInner = container+  let wrapper = Boo'ReusedWrapper+                { boo'ReusedWrapperFull  = Boo'ReusedChild 42+                , boo'ReusedWrapperInner = container                 }   it "wrapper should do roundtrip" $-    fromAvro (toAvro wrapper)         `shouldBe` pure wrapper+    fromAvro (toAvro wrapper) `shouldBe` pure wrapper    it "child should do rundtrip" $-    fromAvro (toAvro container)       `shouldBe` pure container+    fromAvro (toAvro container) `shouldBe` pure container    it "innermost element should do roundtrip" $-    fromAvro (toAvro (ReusedChild 7)) `shouldBe` pure (ReusedChild 7)+    fromAvro (toAvro (Boo'ReusedChild 7)) `shouldBe` pure (Boo'ReusedChild 7)+

@@ -10,6 +10,7 @@ import qualified Data.Aeson           as Aeson import           Data.Avro import           Data.Avro.Deriving+import           Data.Avro.EitherN import qualified Data.Avro.Schema     as Schema import qualified Data.Avro.Types      as Avro import qualified Data.ByteString.Lazy as LBS@@ -25,40 +26,52 @@ spec :: Spec spec = describe "Avro.THUnionSpec: Schema with unions." $ do   let objA = Unions-        { unionsScalars = Left "foo"-        , unionsNullable = Nothing-        , unionsRecords = Left $ Foo { fooStuff = "stuff" }+        { unionsScalars    = Left "foo"+        , unionsNullable   = Nothing+        , unionsRecords    = Left $ Foo { fooStuff = "stuff" }         , unionsSameFields = Left $ Foo { fooStuff = "more stuff" }+        , unionsThree      = E3_1 37+        , unionsFour       = E4_2 "foo"+        , unionsFive       = E5_4 $ Foo { fooStuff = "foo stuff" }         }       objB = Unions-        { unionsScalars = Right 42-        , unionsNullable = Just 37-        , unionsRecords = Right $ Bar { barStuff = "stuff"-                                      , barThings = Foo { fooStuff = "things" }-                                      }+        { unionsScalars    = Right 42+        , unionsNullable   = Just 37+        , unionsRecords    = Right $ Bar { barStuff  = "stuff"+                                         , barThings = Foo { fooStuff = "things" }+                                       }         , unionsSameFields = Right $ NotFoo { notFooStuff = "different from Foo" }+        , unionsThree      = E3_3 37+        , unionsFour       = E4_4 $ Foo { fooStuff = "foo stuff" }+        , unionsFive       = E5_5 $ NotFoo { notFooStuff = "not foo stuff" }         }        field name schema def = Schema.Field name [] Nothing (Just Schema.Ascending) schema def-      record name namespace fields =-        Schema.Record name namespace [] Nothing (Just Schema.Ascending) fields-      named = Schema.NamedType . Schema.TN+      record name fields =+        Schema.Record name [] Nothing (Just Schema.Ascending) fields+      named = Schema.NamedType -      expectedSchema = record "Unions" (Just "haskell.avro.example")+      foo    = named "haskell.avro.example.Foo"+      notFoo = named "haskell.avro.example.NotFoo"+      expectedSchema = record "haskell.avro.example.Unions"         [ field "scalars"    (Schema.mkUnion (NE.fromList [Schema.String, Schema.Long])) scalarsDefault         , field "nullable"   (Schema.mkUnion (NE.fromList [Schema.Null, Schema.Int]))    nullableDefault         , field "records"    (Schema.mkUnion (NE.fromList [fooSchema, barSchema]))       Nothing-        , field "sameFields" (Schema.mkUnion (NE.fromList [named "Foo", notFooSchema]))  Nothing+        , field "sameFields" (Schema.mkUnion (NE.fromList [foo, notFooSchema]))          Nothing++        , field "three" (Schema.mkUnion (NE.fromList [Schema.Int, Schema.String, Schema.Long]))              Nothing+        , field "four"  (Schema.mkUnion (NE.fromList [Schema.Int, Schema.String, Schema.Long, foo]))         Nothing+        , field "five"  (Schema.mkUnion (NE.fromList [Schema.Int, Schema.String, Schema.Long, foo, notFoo])) Nothing         ]       scalarsDefault  = Just $ Avro.Union (NE.fromList [Schema.String, Schema.Long]) Schema.String (Avro.String "foo")       nullableDefault = Just $ Avro.Union (NE.fromList [Schema.Null, Schema.Int])    Schema.Null   Avro.Null -      fooSchema = record "Foo" Nothing [field "stuff" Schema.String Nothing]-      barSchema = record "Bar" Nothing+      fooSchema = record "haskell.avro.example.Foo" [field "stuff" Schema.String Nothing]+      barSchema = record "haskell.avro.example.Bar"         [ field "stuff"  Schema.String Nothing-        , field "things" (named "Foo") Nothing+        , field "things" (named "haskell.avro.example.Foo") Nothing         ]-      notFooSchema = record "NotFoo" Nothing [field "stuff" Schema.String Nothing]+      notFooSchema = record "haskell.avro.example.NotFoo" [field "stuff" Schema.String Nothing]    unionsSchemaFile <- runIO $ getFileName "test/data/unions.avsc" >>= LBS.readFile   let Just unionsSchemaFromJSON = Aeson.decode unionsSchemaFile

@@ -32,7 +32,7 @@ tmSchema :: Schema tmSchema =   let fld nm = Field nm [] Nothing Nothing-   in Record "TypesTestMessage" (Just "avro.haskell.test") [] Nothing Nothing+   in Record "avro.haskell.test.TypesTestMessage" [] Nothing Nothing         [ fld "id" Long Nothing         , fld "name" String Nothing         , fld "timestamp" (mkUnion (Null :| [Long])) Nothing

@@ -17,11 +17,11 @@ -- Schema's often come from an external JSON definition (.avsc files) or -- embedded in object files. meSchema :: Schema-meSchema = mkEnum "MyEnum" [] Nothing Nothing ["A","B","C","D"]+meSchema = mkEnum "MyEnum" [] Nothing ["A","B","C","D"]  msSchema  :: Schema msSchema =-  Record "MyStruct" Nothing [] Nothing Nothing+  Record "MyStruct" [] Nothing Nothing       [ fld "enumOrString" eOrS (Just $ Ty.String "The Default")       , fld "intvalue" Long Nothing       ]

@@ -1,105 +0,0 @@-{-  "name" : "InternalBindings",-  "type" : "record",-  "doc" : "A test record that includes subdefinitions nested in different ways.",-  "fields" : [-    {-      "name" : "inField",-      "doc" : "A record definition nested in a field of a record.",-      "type" : {-        "name" : "InField",-        "type" : "record",-        "fields" : [-          {-            "name" : "nestedInField",-            "doc" : "A record definition nested in two other records.",-            "type" : {-              "name" : "NestedInField",-              "type" : "record",-              "aliases" : ["AliasNestedInField"],-              "fields" : []-            }-          },-          {-            "name" : "nestedEnum",-            "doc" : "An enum definition nested in a nested record.",-            "type" : {-              "type" : "enum",-              "name" : "NestedEnum",-              "symbols" : ["Foo", "Bar"]-            }-          },-          {-            "name" : "nestedFixed",-            "doc" : "A fixed definition nested in a nested record.",-            "type" : {-              "type" : "fixed",-              "size" : 42,-              "name" : "NestedFixed"-            }-          }-        ]-      }-    },-    {-      "name" : "inArray",-      "doc" : "A record definition nested in an array type.",-      "type" : {-        "type" : "array",-        "items" : {-          "name" : "InArray",-          "type" : "record",-          "fields" : [-            {-              "name" : "nestedInArray",-              "doc" : "A record definition nested inside a record defined in an array.",-              "type" : {-                "name" : "NestedInArray",-                "type" : "record",-                "fields" : []-              }-            }-          ]-        }-      }-    },-    {-      "name" : "inMap",-      "doc" : "A record definition nested in a map type.",-      "type" : {-        "type" : "map",-        "values" : {-          "name" : "InMap",-          "type" : "record",-          "fields" : [-            {-              "name" : "nestedInMap",-              "doc" : "A record definition nested inside a record defined in a map.",-              "type" : {-                "name" : "NestedInMap",-                "type" : "record",-                "fields" : []-              }-            }-          ]-        }-      }-    },-    {-      "name" : "inUnion",-      "doc" : "Record definitions nested in a union.",-      "type" : [-        {-          "name" : "InUnionA",-          "type" : "record",-          "fields" : []-        },-        {-          "name" : "InUnionB",-          "type" : "record",-          "fields" : []-        }-      ]-    }-  ]-}

@@ -0,0 +1,154 @@+[+  {+    "type" : "record",+    "name" : "com.example.Foo",+    "aliases" : ["FooBar", "com.example.not.Bar"],+    "doc" : "An example schema to test namespace handling.",+    "order" : "ascending",+    "fields" : [+      {+        "name" : "bar",+        "aliases" : [],+        "order" : "ascending",+        "type" : {+          "type" : "record",+          "name" : "Bar",+          "order" : "ascending",+          "aliases" : ["Bar2", "com.example.not.Foo"],+          "fields" : [+            {+              "name" : "baz",+              "aliases" : [],+              "order" : "ascending",+              "type" : {+                "type" : "record",+                "order" : "ascending",+                "name" : "com.example.baz.Baz",+                "aliases" : ["com.example.Bazzy"],+                "fields" : [+                  {+                    "name"    : "baz",+                    "type"    : "Baz",+                    "aliases" : [],+                    "order"   : "ascending"+                  },+                  {+                    "name"    : "bazzy",+                    "type"    : "com.example.Bazzy",+                    "aliases" : [],+                    "order"   : "ascending"+                  }+                ]+              }+            },+            {+              "name"    : "bazzy",+              "type"    : "Bazzy",+              "aliases" : [],+              "order"   : "ascending"+            }+          ]+        }+      },+      {+        "name"    : "baz",+        "type"    : "com.example.baz.Baz",+        "aliases" : [],+        "order"   : "ascending"+      }+    ]+  },+  {+    "type" : "record",+    "name" : "Foo",+    "namespace" : "com.example",+    "aliases" : ["FooBar", "com.example.not.Bar"],+    "doc" : "An example schema to test namespace handling.",+    "fields" : [+      {+        "name" : "bar",+        "namespace" : "com.example",+        "type" : {+          "type" : "record",+          "name" : "Bar",+          "aliases" : ["Bar2", "com.example.not.Foo"],+          "fields" : [+            {+              "name" : "baz",+              "type" : {+                "type" : "record",+                "name" : "Baz",+                "namespace" : "com.example.baz",+                "aliases" : ["com.example.Bazzy"],+                "fields" : [+                  {+                    "name" : "baz",+                    "type" : "Baz"+                  },+                  {+                    "name" : "bazzy",+                    "type" : "com.example.Bazzy"+                  }+                ]+              }+            },+            {+              "name" : "bazzy",+              "type" : "Bazzy"+            }+          ]+        }+      },+      {+        "name" : "baz",+        "type" : "com.example.baz.Baz"+      }+    ]+  },+  {+    "type" : "record",+    "name" : "com.example.Foo",+    "namespace" : "should.be.ignored",+    "aliases" : ["FooBar", "com.example.not.Bar"],+    "doc" : "An example schema to test namespace handling.",+    "fields" : [+      {+        "name" : "bar",+        "type" : {+          "type" : "record",+          "name" : "Bar",+          "aliases" : ["Bar2", "com.example.not.Foo"],+          "fields" : [+            {+              "name" : "baz",+              "type" : {+                "type" : "record",+                "name" : "com.example.baz.Baz",+                "namespace" : "should.be.ignored",+                "aliases" : ["com.example.Bazzy"],+                "fields" : [+                  {+                    "name" : "baz",+                    "type" : "Baz"+                  },+                  {+                    "name" : "bazzy",+                    "type" : "com.example.Bazzy"+                  }+                ]+              }+            },+            {+              "name" : "bazzy",+              "type" : "Bazzy"+            }+          ]+        }+      },+      {+        "name" : "baz",+        "type" : "com.example.baz.Baz"+      }+    ]+  }+]

@@ -4,13 +4,18 @@   },   "nullable": null,   "records": {-    "Foo": {+    "haskell.avro.example.Foo": {       "stuff": "stuff"     }   },   "sameFields": {-    "Foo": {+    "haskell.avro.example.Foo": {       "stuff": "foo stuff"     }+  },+  "three": { "int": 37 },+  "four": { "string": "foo" },+  "five": {+    "haskell.avro.example.Foo": { "stuff": "foo stuff" }   } }

@@ -6,7 +6,7 @@     "int": 42   },   "records": {-    "Bar": {+    "haskell.avro.example.Bar": {       "stuff": "stuff",       "things": {         "stuff": "things"@@ -14,8 +14,15 @@     }   },   "sameFields": {-    "NotFoo": {+    "haskell.avro.example.NotFoo": {       "stuff": "not foo stuff"     }+  },+  "three": { "long": 37 },+  "four": {+    "haskell.avro.example.Foo": { "stuff" : "foo stuff" }+  },+  "five": {+    "haskell.avro.example.NotFoo": { "stuff": "not foo stuff" }   } }

@@ -43,6 +43,9 @@           ]         }       ]-    }+    },+    { "name" : "three", "type" : ["int", "string", "long"] },+    { "name" : "four", "type" : ["int", "string", "long", "Foo"] },+    { "name" : "five", "type" : ["int", "string", "long", "Foo", "NotFoo"] }   ] }