avro 0.4.4.4 → 0.4.5.0
raw patch · 22 files changed
+248/−244 lines, 22 filesdep ~text
Dependency ranges changed: text
Files
- avro.cabal +4/−1
- src/Data/Avro/Decode/Lazy.hs +4/−4
- src/Data/Avro/Decode/Lazy/Deconflict.hs +7/−5
- src/Data/Avro/Decode/Lazy/FromLazyAvro.hs +5/−3
- src/Data/Avro/Decode/Lazy/LazyValue.hs +11/−11
- src/Data/Avro/Decode/Strict/Internal.hs +6/−6
- src/Data/Avro/Deconflict.hs +7/−5
- src/Data/Avro/Deriving.hs +28/−108
- src/Data/Avro/Deriving/Lift.hs +32/−0
- src/Data/Avro/Deriving/NormSchema.hs +8/−4
- src/Data/Avro/EitherN.hs +15/−15
- src/Data/Avro/Encode.hs +3/−3
- src/Data/Avro/FromAvro.hs +5/−3
- src/Data/Avro/HasAvroSchema.hs +1/−1
- src/Data/Avro/JSON.hs +10/−9
- src/Data/Avro/Schema.hs +20/−28
- src/Data/Avro/ToAvro.hs +21/−21
- src/Data/Avro/Types/Value.hs +9/−9
- test/Avro/DefaultsSpec.hs +2/−2
- test/Avro/ReuseFixedSpec.hs +25/−0
- test/Avro/THUnionSpec.hs +7/−6
- test/data/fixed-types.avsc +18/−0
avro.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: avro-version: 0.4.4.4+version: 0.4.5.0 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell category: Data@@ -33,6 +33,7 @@ test/data/overlay/composite.avsc test/data/overlay/expectation.avsc test/data/overlay/primitives.avsc+ test/data/fixed-types.avsc source-repository head type: git@@ -64,6 +65,7 @@ Data.Avro.DecodeRaw Data.Avro.Deconflict Data.Avro.Deriving+ Data.Avro.Deriving.Lift Data.Avro.Deriving.NormSchema Data.Avro.EitherN Data.Avro.Encode@@ -142,6 +144,7 @@ Avro.JSONSpec Avro.NamespaceSpec Avro.NormSchemaSpec+ Avro.ReuseFixedSpec Avro.SchemaSpec Avro.THEncodeContainerSpec Avro.THEnumSpec
src/Data/Avro/Decode/Lazy.hs view
@@ -318,16 +318,16 @@ case runGetOrFail getLong bs of Left (bs', _, err) -> (bs', T.Error err) Right (bs', _, i) ->- case symbolLookup i of+ case symbols V.!? (fromIntegral i) of Nothing -> (bs', T.Error ("Unknown value {" <> show i <> "} for enum " <> Text.unpack (typeName ty) )) Just sym -> (bs', T.Enum ty (fromIntegral i) sym) - Union ts unionLookup ->+ Union ts -> case runGetOrFail getLong bs of Left (bs', _, err) -> (bs', T.Error err) Right (bs', _, i) ->- case unionLookup i of- Nothing -> (bs', T.Error $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (P.map typeName $ NE.toList ts))+ case ts V.!? (fromIntegral i) of+ Nothing -> (bs', T.Error $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (V.map typeName ts)) Just t -> T.Union ts t <$> go t bs' Fixed {..} ->
src/Data/Avro/Decode/Lazy/Deconflict.hs view
@@ -19,6 +19,8 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text+import Data.Vector (Vector)+import qualified Data.Vector as V -- | @deconflict writer reader val@ will convert a value that was -- encoded/decoded with the writer's schema into the form specified by the@@ -68,11 +70,11 @@ | name a == name b && size a == size b = val go a@S.Record {} b@S.Record {} val | name a == name b = deconflictRecord a b val- go (S.Union xs _) (S.Union ys _) (T.Union _ tyVal val) =+ go (S.Union xs) (S.Union ys) (T.Union _ tyVal val) = withSchemaIn tyVal xs $ \sch -> deconflictReaderUnion sch ys val- go nonUnion (S.Union ys _) val =+ go nonUnion (S.Union ys) val = deconflictReaderUnion nonUnion ys val- go (S.Union xs _) nonUnion (T.Union _ tyVal val) =+ go (S.Union xs) nonUnion (T.Union _ tyVal val) = withSchemaIn tyVal xs $ \sch -> deconflictValue sch nonUnion val go eTy dTy val = case val of@@ -102,14 +104,14 @@ Nothing -> T.Error $ "Incorrect payload: union " <> (show . Foldable.toList $ typeName <$> schemas) <> " does not contain schema " <> Text.unpack (typeName schema) Just found -> f found -deconflictReaderUnion :: Type -> NonEmpty Type -> T.LazyValue Type -> T.LazyValue Type+deconflictReaderUnion :: Type -> Vector Type -> T.LazyValue Type -> T.LazyValue Type deconflictReaderUnion valueType unionTypes val = let hdl [] = T.Error $ "No corresponding union value for " <> Text.unpack (typeName valueType) hdl (d:rest) = case deconflictValue valueType d val of T.Error _ -> hdl rest v -> T.Union unionTypes d v- in hdl (NE.toList unionTypes)+ in hdl (V.toList unionTypes) deconflictRecord :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type deconflictRecord writerSchema readerSchema (T.Record ty fldVals) =
src/Data/Avro/Decode/Lazy/FromLazyAvro.hs view
@@ -90,9 +90,11 @@ fromLazyAvro v = badValue v "Float" instance FromLazyAvro a => FromLazyAvro (Maybe a) where- fromLazyAvro (T.Union (S.Null :| [_]) _ T.Null) = pure Nothing- fromLazyAvro (T.Union (S.Null :| [_]) _ v) = Just <$> fromLazyAvro v- fromLazyAvro v = badValue v "Maybe a"+ fromLazyAvro (T.Union ts _ v) = case (V.toList ts, v) of+ ([S.Null, _], T.Null) -> pure Nothing+ ([S.Null, _], v') -> Just <$> fromLazyAvro v'+ _ -> badValue v "Maybe a"+ fromLazyAvro v = badValue v "Maybe a" instance FromLazyAvro a => FromLazyAvro [a] where fromLazyAvro (T.Array vec) = mapM fromLazyAvro $ toList vec
src/Data/Avro/Decode/Lazy/LazyValue.hs view
@@ -1,12 +1,12 @@ module Data.Avro.Decode.Lazy.LazyValue where -import Data.ByteString-import Data.HashMap.Strict (HashMap)-import Data.Int-import Data.List.NonEmpty (NonEmpty)-import Data.Text-import Data.Vector+import Data.ByteString+import Data.HashMap.Strict (HashMap)+import Data.Int+import Data.List.NonEmpty (NonEmpty)+import Data.Text+import Data.Vector data LazyValue f = Null@@ -17,11 +17,11 @@ | Double Double | Bytes ByteString | String Text- | Array (Vector (LazyValue f)) -- ^ Dynamically enforced monomorphic type.- | Map (HashMap Text (LazyValue f)) -- ^ Dynamically enforced monomorphic type- | Record f (HashMap Text (LazyValue f)) -- Order and a map- | Union (NonEmpty f) f (LazyValue f) -- ^ Set of union options, schema for selected option, and the actual value.+ | Array (Vector (LazyValue f)) -- ^ Dynamically enforced monomorphic type.+ | Map (HashMap Text (LazyValue f)) -- ^ Dynamically enforced monomorphic type+ | Record f (HashMap Text (LazyValue f)) -- ^ Order and a map+ | Union (Vector f) f (LazyValue f) -- ^ Set of union options, schema for selected option, and the actual value. | Fixed f ByteString- | Enum f Int Text -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol+ | Enum f Int Text -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol | Error !String deriving (Eq, Show)
src/Data/Avro/Decode/Strict/Internal.hs view
@@ -67,13 +67,13 @@ do let getField Field {..} = (fldName,) <$> go fldType T.Record ty . HashMap.fromList <$> mapM getField fields Enum {..} ->- do val <- getLong- let sym = fromMaybe "" (symbolLookup val) -- empty string for 'missing' symbols (alternative is an error or exception)- pure (T.Enum ty (fromIntegral val) sym)- Union ts unionLookup -> do i <- getLong- case unionLookup i of- Nothing -> fail $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (P.map typeName $ NE.toList ts)+ let sym = fromMaybe "" (symbols V.!? (fromIntegral i)) -- empty string for 'missing' symbols (alternative is an error or exception)+ pure (T.Enum ty (fromIntegral i) sym)+ Union ts ->+ do i <- getLong+ case ts V.!? (fromIntegral i) of+ Nothing -> fail $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (V.map typeName ts) Just t -> T.Union ts t <$> go t Fixed {..} -> T.Fixed ty <$> G.getByteString (fromIntegral size)
src/Data/Avro/Deconflict.hs view
@@ -19,6 +19,8 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text+import Data.Vector (Vector)+import qualified Data.Vector as V -- | @deconflict writer reader val@ will convert a value that was -- encoded/decoded with the writer's schema into the form specified by the@@ -70,11 +72,11 @@ | name a == name b && size a == size b = Right val go a@S.Record {} b@S.Record {} val | name a == name b = deconflictRecord a b val- go (S.Union xs _) (S.Union ys _) (T.Union _ tyVal val) =+ go (S.Union xs) (S.Union ys) (T.Union _ tyVal val) = withSchemaIn tyVal xs $ \sch -> deconflictReaderUnion sch ys val- go nonUnion (S.Union ys _) val =+ go nonUnion (S.Union ys) val = deconflictReaderUnion nonUnion ys val- go (S.Union xs _) nonUnion (T.Union _ tyVal val) =+ go (S.Union xs) nonUnion (T.Union _ tyVal val) = withSchemaIn tyVal xs $ \sch -> deconflictValue sch nonUnion val go eTy dTy val = case val of@@ -104,14 +106,14 @@ Nothing -> Left $ "Incorrect payload: union " <> (show . Foldable.toList $ typeName <$> schemas) <> " does not contain schema " <> Text.unpack (typeName schema) Just found -> f found -deconflictReaderUnion :: Type -> NonEmpty Type -> T.Value Type -> Either String (T.Value Type)+deconflictReaderUnion :: Type -> Vector Type -> T.Value Type -> Either String (T.Value Type) deconflictReaderUnion valueSchema unionTypes val = let hdl [] = Left "Impossible: empty non-empty list." hdl (d:rest) = case deconflictValue valueSchema d val of Right v -> Right (T.Union unionTypes d v) Left _ -> hdl rest- in hdl (NE.toList unionTypes)+ in hdl (V.toList unionTypes) deconflictRecord :: Type -> Type -> T.Value Type -> Either String (T.Value Type) deconflictRecord writerSchema readerSchema (T.Record ty fldVals) =
src/Data/Avro/Deriving.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-} -- | This module lets us derive Haskell types from an Avro schema that -- can be serialized/deserialzed to Avro.@@ -50,7 +50,6 @@ import Data.Semigroup ((<>)) import qualified Data.Text as Text - import GHC.Generics (Generic) import Language.Haskell.TH as TH hiding (notStrict)@@ -72,6 +71,9 @@ import Data.Avro.Decode.Lazy.FromLazyAvro import qualified Data.Avro.Decode.Lazy.LazyValue as LV +import Data.Avro.Deriving.Lift ()+import Language.Haskell.TH.Syntax (lift)+ -- | How to treat Avro namespaces in the generated Haskell types. data NamespaceBehavior = IgnoreNamespaces@@ -312,7 +314,7 @@ -- mySchema = $(makeSchema "schemas/my-schema.avsc") -- @ makeSchema :: FilePath -> Q Exp-makeSchema p = readSchema p >>= schemaDef'+makeSchema p = readSchema p >>= lift makeSchemaFrom :: FilePath -> Text -> Q Exp makeSchemaFrom p name = do@@ -320,7 +322,7 @@ case subdefinition s name of Nothing -> fail $ "No such entity '" <> T.unpack name <> "' defined in " <> p- Just ss -> schemaDef' ss+ Just ss -> lift ss readSchema :: FilePath -> Q Schema readSchema p = do@@ -333,7 +335,7 @@ ---------------------------- FromAvro ----------------------------------------- genFromAvro :: NamespaceBehavior -> Schema -> Q [Dec]-genFromAvro namespaceBehavior (S.Enum n _ _ _ _) =+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 $ S.renderFullname n)|] ) value@@ -364,7 +366,7 @@ -------------------------------- FromLazyAvro --------------------------------- genFromLazyAvro :: NamespaceBehavior -> Schema -> Q [Dec]-genFromLazyAvro namespaceBehavior (S.Enum n _ _ _ _) =+genFromLazyAvro namespaceBehavior (S.Enum n _ _ _) = [d| instance FromLazyAvro $(conT $ mkDataTypeName namespaceBehavior n) where fromLazyAvro (LV.Enum _ i _) = $([| pure . toEnum|]) i fromLazyAvro value = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname n)|] ) value@@ -417,7 +419,7 @@ ------------------------- ToAvro ---------------------------------------------- genToAvro :: DeriveOptions -> Schema -> Q [Dec]-genToAvro opts s@(S.Enum n _ _ vs _) =+genToAvro opts s@(S.Enum n _ _ vs) = toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n) where conP' = flip conP [] . mkAdtCtorName (namespaceBehavior opts) n@@ -426,7 +428,7 @@ toAvro = $([| \x -> let convert = AT.Enum $(varE sname) (fromEnum $([|x|])) in $(caseE [|x|] ((\v -> match (conP' v)- (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> vs))+ (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> V.toList vs)) |]) |] genToAvro opts s@(S.Record n _ _ _ fs) =@@ -460,91 +462,9 @@ schemaDef sname sch = setName sname $ [d| x :: Schema- x = $(schemaDef' sch)+ x = sch -- $(schemaDef' sch) |] -schemaDef' :: S.Type -> ExpQ-schemaDef' = mkSchema- where mkSchema = \case- Null -> [e| Null |]- Boolean -> [e| Boolean |]- Int -> [e| Int |]- Long -> [e| Long |]- Float -> [e| Float |]- Double -> [e| Double |]- Bytes -> [e| Bytes |]- String -> [e| String |]- Array item -> [e| Array $(mkSchema item) |]- Map values -> [e| Map $(mkSchema values) |]- NamedType name -> [e| NamedType $(mkName name) |]- Record {..} -> [e| Record { name = $(mkName name)- , aliases = $(ListE <$> mapM mkName aliases)- , doc = $(mkMaybeText doc)- , order = $(mkOrder order)- , fields = $(ListE <$> mapM mkField fields)- }- |]- Enum {..} -> [e| mkEnum $(mkName name)- $(ListE <$> mapM mkName aliases)- $(mkMaybeText doc)- $(ListE <$> mapM mkText symbols)- |]- Union {..} -> [e| mkUnion $(mkNE options) |]- Fixed {..} -> [e| Fixed { name = $(mkName name)- , aliases = $(ListE <$> mapM mkName aliases)- , size = $(litE $ IntegerL $ fromIntegral size)- }- |]-- mkText text = [e| T.pack $(mkTextLit text) |]-- 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 |]-- mkOrder (Just Ascending) = [e| Just Ascending |]- mkOrder (Just Descending) = [e| Just Descending |]- mkOrder (Just Ignore) = [e| Just Ignore |]- mkOrder Nothing = [e| Nothing |]-- mkField Field {..} =- [e| Field { fldName = $(mkText fldName)- , fldAliases = $(ListE <$> mapM mkText fldAliases)- , fldDoc = $(mkMaybeText fldDoc)- , fldOrder = $(mkOrder fldOrder)- , fldType = $(mkSchema fldType)- , fldDefault = $(fromMaybe [e|Nothing|] $ mkJust . mkDefaultValue <$> fldDefault)- }- |]-- mkJust exp = [e|Just $(exp)|]-- mkDefaultValue = \case- AT.Null -> [e| AT.Null |]- AT.Boolean b -> [e| AT.Boolean $(if b then [e|True|] else [e|False|]) |]- AT.Int n -> [e| AT.Int $(litE $ IntegerL $ fromIntegral n) |]- AT.Long n -> [e| AT.Long $(litE $ IntegerL $ fromIntegral n) |]- AT.Float f -> [e| AT.Long $(litE $ FloatPrimL $ realToFrac f) |]- AT.Double f -> [e| AT.Long $(litE $ FloatPrimL $ realToFrac f) |]- AT.Bytes bs -> [e| AT.Bytes $(mkByteString bs) |]- AT.String s -> [e| AT.String $(mkText s) |]- AT.Array vec -> [e| AT.Array $ V.fromList $(ListE <$> mapM mkDefaultValue (V.toList vec)) |]- AT.Map m -> [e| AT.Map $ $(mkMap m) |]- AT.Record s m -> [e| AT.Record $(mkSchema s) $(mkMap m) |]- AT.Union ts t v -> [e| AT.Union $(mkNE ts) $(mkSchema t) $(mkDefaultValue v) |]- AT.Fixed s bs -> [e| AT.Fixed $(mkSchema s) $(mkByteString bs) |]- AT.Enum s n sym -> [e| AT.Enum $(mkSchema s) $(litE $ IntegerL $ fromIntegral n) $(mkText sym) |]-- mkByteString bs = [e| B.pack $(ListE <$> mapM numericLit (B.unpack bs)) |]- where numericLit = litE . IntegerL . fromIntegral-- mkMap (HM.toList -> xs) = [e| HM.fromList $(ListE <$> mapM mkKVPair xs) |]- mkKVPair (k, v) = [e| ($(mkText k), $(mkDefaultValue v)) |]-- mkNE (NE.toList -> xs) = [e| NE.fromList $(ListE <$> mapM mkSchema xs) |]- -- | A hack around TemplateHaskell limitation: -- It is currently not possible to splice variable name in QQ. -- This function allows to replace hardcoded name into the specified one.@@ -560,9 +480,9 @@ flds <- traverse (mkField opts n) fs let dname = mkDataTypeName (namespaceBehavior opts) n sequenceA [genDataType dname flds]-genType opts (S.Enum n _ _ vs _) = do+genType opts (S.Enum n _ _ vs) = do let dname = mkDataTypeName (namespaceBehavior opts) n- sequenceA [genEnum dname (mkAdtCtorName (namespaceBehavior opts) n <$> vs)]+ sequenceA [genEnum dname (mkAdtCtorName (namespaceBehavior opts) n <$> (V.toList vs))] genType opts (S.Fixed n _ s) = do let dname = mkDataTypeName (namespaceBehavior opts) n sequenceA [genNewtype dname]@@ -577,23 +497,23 @@ S.Double -> [t| Double |] S.Bytes -> [t| ByteString |] S.String -> [t| Text |]- S.Union branches _ -> union branches+ S.Union branches -> union (V.toList branches) S.Record n _ _ _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n) |] S.Map x -> [t| Map Text $(go x) |] S.Array x -> [t| [$(go x)] |] S.NamedType n -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|] S.Fixed n _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|]- S.Enum n _ _ _ _ -> [t| $(conT $ mkDataTypeName namespaceBehavior n)|]+ 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) |]- _ ->+ [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
+ src/Data/Avro/Deriving/Lift.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Avro.Deriving.Lift+where++import qualified Data.Avro.Schema as Schema+import qualified Data.Avro.Types.Value as Avro+import qualified Data.ByteString as ByteString+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import qualified Data.Vector as Vector+import Language.Haskell.TH.Syntax (Lift (..))++instance Lift ByteString.ByteString where+ lift b = [| ByteString.pack $(lift $ ByteString.unpack b) |]++instance Lift Text.Text where+ lift t = [| Text.pack $(lift $ Text.unpack t) |]++instance Lift a => Lift (Vector.Vector a) where+ lift v = [| Vector.fromList $(lift $ Vector.toList v) |]++instance (Lift k, Lift v) => Lift (HashMap.HashMap k v) where+ lift m = [| HashMap.fromList $(lift $ HashMap.toList m) |]++deriving instance Lift f => Lift (Avro.Value f)+deriving instance Lift Schema.Field+deriving instance Lift Schema.Order+deriving instance Lift Schema.TypeName+deriving instance Lift Schema.Type
src/Data/Avro/Deriving/NormSchema.hs view
@@ -14,6 +14,7 @@ import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Vector as V -- | Extracts all the records from the schema (flattens the schema) -- Named types get resolved when needed to include at least one "inlined"@@ -31,7 +32,7 @@ getTypes rec = case rec of r@Record{name, fields} -> (name,r) : (fields >>= (getTypes . fldType)) Array t -> getTypes t- Union (t1 :| ts) _ -> getTypes t1 <> concatMap getTypes ts+ Union ts -> concatMap getTypes (V.toList ts) Map t -> getTypes t e@Enum{name} -> [(name, e)] f@Fixed{name} -> [(name, f)]@@ -54,13 +55,16 @@ Nothing -> error $ "Unable to resolve schema: " <> show (typeName t) - Array s -> Array <$> normSchema s- Map s -> Map <$> normSchema s- Union l f -> flip Union f <$> traverse normSchema l+ Array s -> Array <$> normSchema s+ Map s -> Map <$> normSchema s+ Union l -> Union <$> traverse normSchema l r@Record{name = tn} -> do modify' (M.insert tn (NamedType tn)) flds <- mapM (\fld -> setType fld <$> normSchema (fldType fld)) (fields r) pure $ r { fields = flds }+ r@Fixed{name = tn} -> do+ modify' (M.insert tn (NamedType tn))+ pure r s -> pure s where setType fld t = fld { fldType = t}
src/Data/Avro/EitherN.hs view
@@ -214,27 +214,27 @@ instance (ToAvro a, ToAvro b, ToAvro c) => ToAvro (Either3 a b c) where toAvro e =- let sch@(one :| [two, three]) = options (schemaOf e)+ let sch = options (schemaOf e) in case e of- E3_1 a -> T.Union sch one (toAvro a)- E3_2 b -> T.Union sch two (toAvro b)- E3_3 c -> T.Union sch three (toAvro c)+ E3_1 a -> T.Union sch (schemaOf a) (toAvro a)+ E3_2 b -> T.Union sch (schemaOf b) (toAvro b)+ E3_3 c -> T.Union sch (schemaOf c) (toAvro c) instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d) => ToAvro (Either4 a b c d) where toAvro e =- let sch@(one :| [two, three, four]) = options (schemaOf e)+ let sch = options (schemaOf e) in case e of- E4_1 a -> T.Union sch one (toAvro a)- E4_2 b -> T.Union sch two (toAvro b)- E4_3 c -> T.Union sch three (toAvro c)- E4_4 d -> T.Union sch four (toAvro d)+ E4_1 a -> T.Union sch (schemaOf a) (toAvro a)+ E4_2 b -> T.Union sch (schemaOf b) (toAvro b)+ E4_3 c -> T.Union sch (schemaOf c) (toAvro c)+ E4_4 d -> T.Union sch (schemaOf d) (toAvro d) instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e) => ToAvro (Either5 a b c d e) where toAvro e =- let sch@(one :| [two, three, four, five]) = options (schemaOf e)+ let sch = options (schemaOf e) in case e of- E5_1 a -> T.Union sch one (toAvro a)- E5_2 b -> T.Union sch two (toAvro b)- E5_3 c -> T.Union sch three (toAvro c)- E5_4 d -> T.Union sch four (toAvro d)- E5_5 e -> T.Union sch five (toAvro e)+ E5_1 a -> T.Union sch (schemaOf a) (toAvro a)+ E5_2 b -> T.Union sch (schemaOf b) (toAvro b)+ E5_3 c -> T.Union sch (schemaOf c) (toAvro c)+ E5_4 d -> T.Union sch (schemaOf d) (toAvro d)+ E5_5 e -> T.Union sch (schemaOf e) (toAvro e)
src/Data/Avro/Encode.hs view
@@ -52,9 +52,9 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import Data.Word+import Prelude as P import System.Random.TF.Init (initTFGen) import System.Random.TF.Instances (randoms)-import Prelude as P import Data.Avro.Codec import Data.Avro.EncodeRaw@@ -295,8 +295,8 @@ fs = P.map fldName (fields ty) in AvroM (bs, ty) T.Union opts sel val | F.length opts > 0 ->- case DL.elemIndex sel (NE.toList opts) of- Just idx -> AvroM (putI idx <> putAvro val, S.mkUnion opts)+ case V.elemIndex sel opts of+ Just idx -> AvroM (putI idx <> putAvro val, S.Union opts) Nothing -> error "Union encoding specifies type not found in schema" T.Enum sch@S.Enum{..} ix t -> AvroM (putI ix, sch) T.Fixed ty bs ->
src/Data/Avro/FromAvro.hs view
@@ -84,9 +84,11 @@ fromAvro v = badValue v "Float" instance FromAvro a => FromAvro (Maybe a) where- fromAvro (T.Union (S.Null :| [_]) _ T.Null) = pure Nothing- fromAvro (T.Union (S.Null :| [_]) _ v) = Just <$> fromAvro v- fromAvro v = badValue v "Maybe a"+ fromAvro (T.Union ts _ v) = case (V.toList ts, v) of+ ([S.Null, _], T.Null) -> pure Nothing+ ([S.Null, _], v') -> Just <$> fromAvro v'+ _ -> badValue v "Maybe a"+ fromAvro v = badValue v "Maybe a" instance FromAvro a => FromAvro [a] where fromAvro (T.Array vec) = mapM fromAvro $ toList vec
src/Data/Avro/HasAvroSchema.hs view
@@ -84,7 +84,7 @@ schema = Tagged S.Bytes instance (HasAvroSchema a, HasAvroSchema b) => HasAvroSchema (Either a b) where- schema = Tagged $ mkUnion (untag (schema :: Tagged a Type) :| [untag (schema :: Tagged b Type)])+ schema = Tagged $ S.Union $ V.fromListN 2 [untag (schema :: Tagged a Type), untag (schema :: Tagged b Type)] instance (HasAvroSchema a) => HasAvroSchema (Map.Map Text a) where schema = wrapTag S.Map (schema :: Tagged a Type)
src/Data/Avro/JSON.hs view
@@ -59,7 +59,7 @@ -- @ module Data.Avro.JSON where -import Data.Semigroup ((<>))+import Data.Semigroup ((<>)) import qualified Data.Aeson as Aeson import Data.ByteString.Lazy (ByteString)@@ -70,11 +70,12 @@ import Data.Tagged import qualified Data.Text as Text -import Data.Avro (FromAvro (..), Result (..), ToAvro (..))-import qualified Data.Avro as Avro-import Data.Avro.Schema (Schema, parseAvroJSON)-import qualified Data.Avro.Schema as Schema-import qualified Data.Avro.Types as Avro+import Data.Avro (FromAvro (..), Result (..), ToAvro (..))+import qualified Data.Avro as Avro+import Data.Avro.Schema (Schema, parseAvroJSON)+import qualified Data.Avro.Schema as Schema+import qualified Data.Avro.Types as Avro+import qualified Data.Vector as V decodeAvroJSON :: Schema -> Aeson.Value -> Result (Avro.Value Schema) decodeAvroJSON schema json =@@ -85,12 +86,12 @@ missing name = fail ("Type " <> show name <> " not in schema") - union (Schema.Union schemas _) Aeson.Null+ 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)+ union (Schema.Union schemas) (Aeson.Object obj) | null obj = fail "Invalid encoding of union: empty object ({})." | length obj > 1 =@@ -103,7 +104,7 @@ branch = head $ HashMap.keys obj names =- HashMap.fromList [(Schema.typeName t, t) | t <- NE.toList schemas]+ HashMap.fromList [(Schema.typeName t, t) | t <- V.toList schemas] in case HashMap.lookup (canonicalize branch) names of Just t -> do nested <- parseAvroJSON union env t (obj ! branch)
src/Data/Avro/Schema.hs view
@@ -8,7 +8,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} -- | Avro 'Schema's, represented here as values of type 'Schema',@@ -83,8 +82,6 @@ import GHC.Generics (Generic) -import Text.Show.Functions ()- -- | An Avro schema is either -- -- * A "JSON object in the form @{"type":"typeName" ...}@@@ -118,14 +115,12 @@ , order :: Maybe Order , fields :: [Field] }- | Enum { name :: TypeName- , aliases :: [TypeName]- , doc :: Maybe Text- , symbols :: [Text]- , symbolLookup :: Int64 -> Maybe Text+ | Enum { name :: TypeName+ , aliases :: [TypeName]+ , doc :: Maybe Text+ , symbols :: V.Vector Text }- | Union { options :: NonEmpty Type- , unionLookup :: Int64 -> Maybe Type+ | Union { options :: V.Vector Type } | Fixed { name :: TypeName , aliases :: [TypeName]@@ -149,9 +144,9 @@ Record name1 _ _ _ fs1 == Record name2 _ _ _ fs2 = and [name1 == name2, fs1 == fs2]- Enum name1 _ _ s _ == Enum name2 _ _ s2 _ =+ Enum name1 _ _ s == Enum name2 _ _ s2 = and [name1 == name2, s == s2]- Union a _ == Union b _ = a == b+ Union a == Union b = a == b Fixed name1 _ s == Fixed name2 _ s2 = and [name1 == name2, s == s2] @@ -167,16 +162,13 @@ -> [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+mkEnum name aliases doc symbols = Enum name aliases doc (V.fromList 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 -- type as a direct member of the union. No check is done for this condition! mkUnion :: NonEmpty Type -> Type-mkUnion os = Union os (\i -> IM.lookup (fromIntegral i) mp)- where mp = IM.fromList (zip [0..] $ NE.toList os)+mkUnion = Union . V.fromList . NE.toList -- | A named type in Avro has a name and, optionally, a namespace. --@@ -302,7 +294,7 @@ Array _ -> "array" Map _ -> "map" NamedType name -> renderFullname name- Union (x:|_) _ -> typeName x+ Union ts -> typeName (V.head ts) _ -> renderFullname $ name bt data Field = Field { fldName :: Text@@ -343,7 +335,7 @@ somename -> return $ NamedType $ mkTypeName context somename Nothing A.Array arr | V.length arr > 0 ->- mkUnion . NE.fromList <$> mapM (parseSchemaJSON context) (V.toList arr)+ Union <$> V.mapM (parseSchemaJSON context) arr | otherwise -> fail "Unions must have at least one type." A.Object o -> do logicalType :: Maybe Text <- o .:? "logicalType"@@ -573,8 +565,8 @@ -- ^ 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."+ where defaultUnion (Union ts) val = Ty.Union ts (V.head ts) <$> parseFieldDefault env (V.head ts) val+ defaultUnion _ _ = error "Impossible: not Union." -- | Parse JSON-encoded avro data. parseAvroJSON :: (Type -> A.Value -> Result (Ty.Value Type))@@ -601,9 +593,9 @@ case ty of String -> return $ Ty.String s Enum {..} ->- if s `elem` symbols- then return $ Ty.Enum ty (maybe (error "IMPOSSIBLE BUG") id $ lookup s (zip symbols [0..])) s- else fail $ "JSON string is not one of the expected symbols for enum '" <> show name <> "': " <> T.unpack s+ case s `V.elemIndex` symbols of+ Just i -> pure $ Ty.Enum ty i s+ Nothing -> fail $ "JSON string is not one of the expected symbols for enum '" <> show name <> "': " <> T.unpack s Bytes -> Ty.Bytes <$> parseBytes s Fixed {..} -> do bytes <- parseBytes s@@ -726,7 +718,7 @@ , 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 a@Union{} b@Union{} = and $ V.zipWith matches (options a) (options b) matches t1 t2 = t1 == t2 -- | @extractBindings schema@ traverses a schema and builds a map of all declared@@ -740,7 +732,7 @@ let withRecord = HashMap.fromList $ (name : aliases) `zip` repeat t in HashMap.unions $ withRecord : (extractBindings . fldType <$> fields) e@Enum{..} -> HashMap.fromList $ (name : aliases) `zip` repeat e- Union{..} -> HashMap.unions $ NE.toList $ extractBindings <$> options+ Union{..} -> HashMap.unions $ V.toList $ extractBindings <$> options f@Fixed{..} -> HashMap.fromList $ (name : aliases) `zip` repeat f Array{..} -> extractBindings item Map{..} -> extractBindings values@@ -756,7 +748,7 @@ t@(NamedType n) -> fromMaybe t <$> gets (HashMap.lookup n) a@Array{item} -> (\x -> a { item = x }) <$> go item m@Map{values} -> (\x -> m { values = x }) <$> go values- u@Union{options} -> mkUnion <$> traverse go options+ u@Union{options} -> Union <$> traverse go options r@Record{name, fields} -> do fields' <- traverse expandField fields@@ -775,7 +767,7 @@ 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{..} = mkUnion (NE.map overlayType options)+ overlayType u@Union{..} = Union (V.map overlayType options) overlayType nt@(NamedType _) = rebind nt overlayType other = other
src/Data/Avro/ToAvro.hs view
@@ -1,27 +1,27 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Avro.ToAvro where -import Control.Arrow (first)+import Control.Arrow (first) import Data.Avro.HasAvroSchema-import Data.Avro.Schema as S-import Data.Avro.Types as T-import qualified Data.ByteString as B-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString.Lazy as BL-import qualified Data.HashMap.Strict as HashMap+import Data.Avro.Schema as S+import Data.Avro.Types as T+import qualified Data.ByteString as B+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Strict as HashMap import Data.Int-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Map as Map-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Lazy as TL+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Map as Map import Data.Tagged-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as TL+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U import Data.Word class HasAvroSchema a => ToAvro a where@@ -65,10 +65,10 @@ instance (ToAvro a, ToAvro b) => ToAvro (Either a b) where toAvro e =- let sch@(l:|[r]) = options (schemaOf e)+ let sch = options (schemaOf e) in case e of- Left a -> T.Union sch l (toAvro a)- Right b -> T.Union sch r (toAvro b)+ Left a -> T.Union sch (schemaOf a) (toAvro a)+ Right b -> T.Union sch (schemaOf b) (toAvro b) instance (ToAvro a) => ToAvro (Map.Map Text a) where toAvro = toAvro . HashMap.fromList . Map.toList@@ -90,10 +90,10 @@ instance (ToAvro a) => ToAvro (Maybe a) where toAvro a =- let sch@(l:|[r]) = options (schemaOf a)+ let sch = options (schemaOf a) in case a of Nothing -> T.Union sch S.Null (toAvro ())- Just v -> T.Union sch r (toAvro v)+ Just v -> T.Union sch (schemaOf v) (toAvro v) instance (ToAvro a) => ToAvro [a] where toAvro = T.Array . V.fromList . (toAvro <$>)
src/Data/Avro/Types/Value.hs view
@@ -2,16 +2,16 @@ {-# LANGUAGE DeriveGeneric #-} module Data.Avro.Types.Value where -import Control.DeepSeq (NFData)+import Control.DeepSeq (NFData) -import Data.ByteString-import Data.HashMap.Strict (HashMap)-import Data.Int-import Data.List.NonEmpty (NonEmpty)-import Data.Text-import Data.Vector+import Data.ByteString+import Data.HashMap.Strict (HashMap)+import Data.Int+import Data.List.NonEmpty (NonEmpty)+import Data.Text+import Data.Vector -import GHC.Generics (Generic)+import GHC.Generics (Generic) data Value f = Null@@ -25,7 +25,7 @@ | Array (Vector (Value f)) -- ^ Dynamically enforced monomorphic type. | Map (HashMap Text (Value f)) -- ^ Dynamically enforced monomorphic type | Record f (HashMap Text (Value f)) -- Order and a map- | Union (NonEmpty f) f (Value f) -- ^ Set of union options, schema for selected option, and the actual value.+ | Union (Vector f) f (Value f) -- ^ Set of union options, schema for selected option, and the actual value. | Fixed f {-# UNPACK #-} !ByteString | Enum f {-# UNPACK #-} !Int Text -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol deriving (Eq, Show, Generic, NFData)
test/Avro/DefaultsSpec.hs view
@@ -14,7 +14,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Vector as V -import Test.Hspec+import Test.Hspec {-# ANN module ("HLint: ignore Redundant do" :: String) #-} @@ -35,7 +35,7 @@ msgSchema = schemaOf (undefined :: MaybeTest) fixedSchema = schemaOf (undefined :: FixedTag) defaults = fldDefault <$> fields msgSchema- in defaults `shouldBe` [ Just $ Ty.Union (Null :| [String]) Null Ty.Null+ in defaults `shouldBe` [ Just $ Ty.Union (V.fromList [Null, String]) Null Ty.Null , Just $ Ty.Fixed fixedSchema "\0\42\255" , Just $ Ty.Bytes "\0\37\255" ]
+ test/Avro/ReuseFixedSpec.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+module Avro.ReuseFixedSpec+where++import qualified Data.Aeson as Aeson+import Data.Avro as Avro+import Data.Avro.Deriving+import Data.Avro.Schema (Type (..), fields, fldType, mkUnion)+import Data.ByteString.Lazy as LBS+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.Set as S++import Test.Hspec++deriveAvro "test/data/fixed-types.avsc"++spec :: Spec+spec = describe "Avro.ReuseFixedSpec" $ do+ it "should generate sensible schema" $ do+ let msg = ReuseFixed (FixedData "ABCDEFGHIJKLMNOP") (FixedData "PONMLKJIHGFEDCBA")+ Avro.decode(Avro.encode(msg)) `shouldBe` Success msg+
test/Avro/THUnionSpec.hs view
@@ -5,7 +5,7 @@ module Avro.THUnionSpec where -import qualified Data.List.NonEmpty as NE+import qualified Data.List.NonEmpty as NE import qualified Data.Aeson as Aeson import Data.Avro@@ -15,12 +15,13 @@ import qualified Data.Avro.Types as Avro import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map+import qualified Data.Vector as V -import System.Directory (doesFileExist)+import System.Directory (doesFileExist) -import Test.Hspec+import Test.Hspec -import Paths_avro+import Paths_avro deriveAvro "test/data/unions.avsc" @@ -67,8 +68,8 @@ , 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+ scalarsDefault = Just $ Avro.Union (V.fromList [Schema.String, Schema.Long]) Schema.String (Avro.String "foo")+ nullableDefault = Just $ Avro.Union (V.fromList [Schema.Null, Schema.Int]) Schema.Null Avro.Null fooSchema = record "haskell.avro.example.Foo" [field "stuff" Schema.String Nothing] barSchema = record "haskell.avro.example.Bar"
+ test/data/fixed-types.avsc view
@@ -0,0 +1,18 @@+{+ "name": "ReuseFixed",+ "type": "record",+ "fields": [+ {+ "name": "primary",+ "type": {+ "type": "fixed",+ "name": "FixedData",+ "size": 16+ }+ },+ {+ "name": "secondary",+ "type": "FixedData"+ }+ ]+}