avro 0.4.0.0 → 0.4.1.0

raw patch · 14 files changed

+652/−123 lines, 14 filesdep +bifunctorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bifunctors

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• avro.cabal +9/−2
• src/Data/Avro/Decode.hs +24/−24
• src/Data/Avro/Decode/Lazy.hs +13/−10
• src/Data/Avro/Decode/Lazy/FromLazyAvro.hs +125/−0
• src/Data/Avro/Deriving.hs +74/−32
• src/Data/Avro/EitherN.hs +150/−14
• src/Data/Avro/FromAvro.hs +43/−40
• src/Data/Avro/Schema.hs +5/−0
• test/Avro/Decode/Lazy/ContainerSpec.hs +1/−1
• test/data/enums-object.json +1/−0
• test/data/namespace-inference.json +154/−0
• test/data/unions-object-a.json +21/−0
• test/data/unions-object-b.json +28/−0

@@ -1,5 +1,9 @@ # Revision history for avro +## HEAD  -- 2018-11-07++* Fixed an omitted data fixture from the cabal sdist+ ## 0.1.0.0  -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: fcff216c51da7f4f507714e81688ee3d9c149e101ffbe1b7051f4559eb2feebb+-- hash: e0011cbcce3a1d5f4de5830d2b9f6acb6f32dcacc90e79bf61dbec2530bbf88d  name:           avro-version:        0.4.0.0+version:        0.4.1.0 synopsis:       Avro serialization support for Haskell description:    Avro serialization and deserialization support for Haskell category:       Data@@ -21,17 +21,21 @@     ChangeLog.md     test/data/deconflict/reader.avsc     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/overlay/composite.avsc     test/data/overlay/expectation.avsc     test/data/overlay/primitives.avsc     test/data/record.avsc     test/data/reused.avsc     test/data/small.avsc+    test/data/unions-object-a.json+    test/data/unions-object-b.json     test/data/unions.avsc  source-repository head@@ -56,6 +60,7 @@       Data.Avro.Decode.Lazy       Data.Avro.Decode.Lazy.Convert       Data.Avro.Decode.Lazy.Deconflict+      Data.Avro.Decode.Lazy.FromLazyAvro       Data.Avro.Decode.Lazy.LazyValue       Data.Avro.Decode.Strict       Data.Avro.Decode.Strict.Internal@@ -86,6 +91,7 @@     , array     , base >=4.8 && <5.0     , base16-bytestring+    , bifunctors     , binary     , bytestring     , containers@@ -156,6 +162,7 @@     , avro     , base >=4.6 && <5     , base16-bytestring+    , bifunctors     , binary     , bytestring     , containers

@@ -14,38 +14,38 @@   , GetAvro(..)   ) where -import qualified Codec.Compression.Zlib     as Z-import           Control.Monad              (replicateM, when)-import qualified Data.Aeson                 as A-import qualified Data.Array                 as Array-import           Data.Binary.Get            (Get, runGetOrFail)-import qualified Data.Binary.Get            as G-import           Data.Binary.IEEE754        as IEEE+import qualified Codec.Compression.Zlib           as Z+import           Control.Monad                    (replicateM, when)+import qualified Data.Aeson                       as A+import qualified Data.Array                       as Array+import           Data.Binary.Get                  (Get, runGetOrFail)+import qualified Data.Binary.Get                  as G+import           Data.Binary.IEEE754              as IEEE import           Data.Bits-import           Data.ByteString            (ByteString)-import qualified Data.ByteString.Lazy       as BL-import qualified Data.ByteString.Lazy.Char8 as BC-import qualified Data.HashMap.Strict        as HashMap+import           Data.ByteString                  (ByteString)+import qualified Data.ByteString.Lazy             as BL+import qualified Data.ByteString.Lazy.Char8       as BC+import qualified Data.HashMap.Strict              as HashMap import           Data.Int-import           Data.List                  (foldl')-import qualified Data.List.NonEmpty         as NE-import qualified Data.Map                   as Map+import           Data.List                        (foldl')+import qualified Data.List.NonEmpty               as NE+import qualified Data.Map                         as Map import           Data.Maybe-import           Data.Monoid                ((<>))-import qualified Data.Set                   as Set-import           Data.Text                  (Text)-import qualified Data.Text                  as Text-import qualified Data.Text.Encoding         as Text-import qualified Data.Vector                as V-import           Prelude                    as P+import           Data.Monoid                      ((<>))+import qualified Data.Set                         as Set+import           Data.Text                        (Text)+import qualified Data.Text                        as Text+import qualified Data.Text.Encoding               as Text+import qualified Data.Vector                      as V+import           Prelude                          as P  import           Data.Avro.Decode.Get import           Data.Avro.DecodeRaw-import           Data.Avro.Schema     as S-import qualified Data.Avro.Types      as T+import           Data.Avro.Schema                 as S+import qualified Data.Avro.Types                  as T import           Data.Avro.Zag -import Data.Avro.Decode.Strict.Internal+import           Data.Avro.Decode.Strict.Internal  -- |Decode bytes into a 'Value' as described by Schema. decodeAvro :: Schema -> BL.ByteString -> Either String (T.Value Type)

@@ -23,6 +23,10 @@   , getContainerValuesBytes'   , getAvroOf   , GetAvro(..)+  , FromLazyAvro(..)+  , (.~:)+  , T.LazyValue(..)+  , badValue   ) where  import qualified Codec.Compression.Zlib     as Z@@ -62,12 +66,11 @@ import qualified Data.Avro.Decode.Strict.Internal as DecodeStrict  import Data.Avro.Decode.Get-import Data.Avro.Decode.Lazy.Convert    (toStrictValue)-import Data.Avro.Decode.Lazy.Deconflict as C+import Data.Avro.Decode.Lazy.Convert      (toStrictValue)+import Data.Avro.Decode.Lazy.Deconflict   as C+import Data.Avro.Decode.Lazy.FromLazyAvro import Data.Avro.FromAvro -import Debug.Trace- -- | Decodes the container as a lazy list of values of the requested type. -- -- The schema for the requested type will be de-conflicted with the schema@@ -77,7 +80,7 @@ -- error. This means that the consumer will get all the "good" content from -- the container until the error is detected, then this error and then the list -- is finished.-decodeContainer :: forall a. FromAvro a => BL.ByteString -> [Either String a]+decodeContainer :: forall a. FromLazyAvro a => BL.ByteString -> [Either String a] decodeContainer bs =   let vals = either (\err -> [Left err]) concat (decodeContainer' bs)   in takeWhileInclusive isRight vals@@ -102,7 +105,7 @@ -- continue after errors (most likely it will not be correct). -- -- 'decodeContainer' function makes a choice to stop after the first error.-decodeContainer' :: forall a. FromAvro a => BL.ByteString -> Either String [[Either String a]]+decodeContainer' :: forall a. FromLazyAvro a => BL.ByteString -> Either String [[Either String a]] decodeContainer' = decodeContainerWithSchema' (untag (schema :: Tagged a Schema))  -- | Same as 'decodeContainer' but uses provided schema as a reader schema for the container@@ -110,7 +113,7 @@ -- -- It is up to the user to make sure that the provided schema is compatible with 'a' -- and with the container's writer schema.-decodeContainerWithSchema :: FromAvro a => Schema -> BL.ByteString -> [Either String a]+decodeContainerWithSchema :: FromLazyAvro a => Schema -> BL.ByteString -> [Either String a] decodeContainerWithSchema s bs =   either (\err -> [Left err]) concat (decodeContainerWithSchema' s bs) @@ -119,12 +122,12 @@ -- -- It is up to the user to make sure that the provided schema is compatible with 'a' -- and with the container's writer schema.-decodeContainerWithSchema' :: FromAvro a => Schema -> BL.ByteString -> Either String [[Either String a]]+decodeContainerWithSchema' :: FromLazyAvro a => Schema -> BL.ByteString -> Either String [[Either String a]] decodeContainerWithSchema' readerSchema bs = do   (writerSchema, vals) <- getContainerValues bs   pure $ (fmap . fmap) (convertValue writerSchema) vals   where-    convertValue w v = toStrictValue (C.deconflict w readerSchema v) >>= (resultToEither . fromAvro)+    convertValue w v = resultToEither $ fromLazyAvro (C.deconflict w readerSchema v) -- >>= (resultToEither . fromLazyAvro)  -- |Decode bytes into a 'Value' as described by Schema. decodeAvro :: Schema -> BL.ByteString -> T.LazyValue Type@@ -200,7 +203,7 @@     checkMarker sync bs =       case BL.splitAt nrSyncBytes bs of         (marker, _) | marker /= sync -> Left "Invalid marker, does not match sync bytes."-        (_, rest)   -> Right rest+        (_, rest)                    -> Right rest  getContainerValuesWith :: (Schema -> BL.ByteString -> (BL.ByteString, T.LazyValue Type))                  -> BL.ByteString

@@ -0,0 +1,125 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Avro.Decode.Lazy.FromLazyAvro++where++import           Control.Arrow                   (first)+import           Data.Avro.Decode.Lazy.LazyValue as T+import qualified Data.Avro.Encode                as E+import           Data.Avro.HasAvroSchema+import           Data.Avro.Schema                as S+import qualified Data.ByteString                 as B+import           Data.ByteString.Lazy            (ByteString)+import qualified Data.ByteString.Lazy            as BL+import           Data.Foldable                   (toList)+import qualified Data.HashMap.Strict             as HashMap+import           Data.Int+import           Data.List.NonEmpty              (NonEmpty (..))+import qualified Data.Map                        as Map+import           Data.Monoid                     ((<>))+import           Data.Tagged+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++-- |  'FromLazyAvro' is a clone of 'FromAvro' except that+-- it works for lazy values ('LazyValue').+--+-- Decoding from 'LazyValue` directly+-- without converting to strict `Value` and then 'FromAvro'+-- can be very beneficial from the performance point of view.+class HasAvroSchema a => FromLazyAvro a where+  fromLazyAvro :: LazyValue Type -> Result a++--  | Same as '(.:)' but works on `LazyValue`.+(.~:) :: FromLazyAvro a => HashMap.HashMap Text (LazyValue Type) -> Text -> Result a+(.~:) obj key =+  case HashMap.lookup key obj of+    Nothing -> fail $ "Requested field not available: " <> show key+    Just v  -> fromLazyAvro v++instance (FromLazyAvro a, FromLazyAvro b) => FromLazyAvro (Either a b) where+  fromLazyAvro e@(T.Union _ branch x)+    | S.matches branch schemaA = Left  <$> fromLazyAvro x+    | S.matches branch schemaB = Right <$> fromLazyAvro x+    | otherwise              = badValue e "Either"+    where Tagged schemaA = schema :: Tagged a Type+          Tagged schemaB = schema :: Tagged b Type+  fromLazyAvro x = badValue x "Either"++instance FromLazyAvro Bool where+  fromLazyAvro (T.Boolean b) = pure b+  fromLazyAvro v             = badValue v "Bool"++instance FromLazyAvro B.ByteString where+  fromLazyAvro (T.Bytes b) = pure b+  fromLazyAvro v           = badValue v "ByteString"++instance FromLazyAvro BL.ByteString where+  fromLazyAvro (T.Bytes b) = pure (BL.fromStrict b)+  fromLazyAvro v           = badValue v "Lazy ByteString"++instance FromLazyAvro Int where+  fromLazyAvro (T.Int i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)+                      = pure (fromIntegral i)+  fromLazyAvro (T.Long i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)+                      = pure (fromIntegral i)+  fromLazyAvro v          = badValue v "Int"++instance FromLazyAvro Int32 where+  fromLazyAvro (T.Int i) = pure (fromIntegral i)+  fromLazyAvro v         = badValue v "Int32"++instance FromLazyAvro Int64 where+  fromLazyAvro (T.Long i) = pure i+  fromLazyAvro (T.Int i)  = pure (fromIntegral i)+  fromLazyAvro v          = badValue v "Int64"++instance FromLazyAvro Double where+  fromLazyAvro (T.Double d) = pure d+  fromLazyAvro v            = badValue v "Double"++instance FromLazyAvro Float where+  fromLazyAvro (T.Float f) = pure f+  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"++instance FromLazyAvro a => FromLazyAvro [a] where+  fromLazyAvro (T.Array vec) = mapM fromLazyAvro $ toList vec+  fromLazyAvro v             = badValue v "[a]"++instance FromLazyAvro a => FromLazyAvro (V.Vector a) where+  fromLazyAvro (T.Array vec) = mapM fromLazyAvro vec+  fromLazyAvro v             = badValue v "Vector a"++instance (U.Unbox a, FromLazyAvro a) => FromLazyAvro (U.Vector a) where+  fromLazyAvro (T.Array vec) = U.convert <$> mapM fromLazyAvro vec+  fromLazyAvro v             = badValue v "Unboxed Vector a"++instance FromLazyAvro Text where+  fromLazyAvro (T.String txt) = pure txt+  fromLazyAvro v              = badValue v "Text"++instance FromLazyAvro TL.Text where+  fromLazyAvro (T.String txt) = pure (TL.fromStrict txt)+  fromLazyAvro v              = badValue v "Lazy Text"++instance (FromLazyAvro a) => FromLazyAvro (Map.Map Text a) where+  fromLazyAvro (T.Record _ mp) = mapM fromLazyAvro $ Map.fromList (HashMap.toList mp)+  fromLazyAvro (T.Map mp)      = mapM fromLazyAvro $ Map.fromList (HashMap.toList mp)+  fromLazyAvro v               = badValue v "Map Text a"++instance (FromLazyAvro a) => FromLazyAvro (HashMap.HashMap Text a) where+  fromLazyAvro (T.Record _ mp) = mapM fromLazyAvro mp+  fromLazyAvro (T.Map mp)      = mapM fromLazyAvro mp+  fromLazyAvro v               = badValue v "HashMap Text a"

@@ -32,42 +32,45 @@ ) where -import           Control.Monad                 (join)-import           Data.Aeson                    (eitherDecode)-import qualified Data.Aeson                    as J-import           Data.Avro                     hiding (decode, encode)-import           Data.Avro.Schema              as S-import qualified Data.Avro.Types               as AT-import           Data.ByteString               (ByteString)-import qualified Data.ByteString               as B-import           Data.Char                     (isAlphaNum)+import           Control.Monad                      (join)+import           Data.Aeson                         (eitherDecode)+import qualified Data.Aeson                         as J+import           Data.Avro                          hiding (decode, encode)+import           Data.Avro.Schema                   as S+import qualified Data.Avro.Types                    as AT+import           Data.ByteString                    (ByteString)+import qualified Data.ByteString                    as B+import           Data.Char                          (isAlphaNum) import           Data.Int-import           Data.List.NonEmpty            (NonEmpty ((:|)))-import qualified Data.List.NonEmpty            as NE-import           Data.Map                      (Map)-import           Data.Maybe                    (fromMaybe)-import           Data.Semigroup                ((<>))-import qualified Data.Text                     as Text+import           Data.List.NonEmpty                 (NonEmpty ((:|)))+import qualified Data.List.NonEmpty                 as NE+import           Data.Map                           (Map)+import           Data.Maybe                         (fromMaybe)+import           Data.Semigroup                     ((<>))+import qualified Data.Text                          as Text  -import           GHC.Generics                  (Generic)+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                as TH hiding (notStrict)+import           Language.Haskell.TH.Lib            as TH hiding (notStrict) import           Language.Haskell.TH.Syntax  import           Data.Avro.Deriving.NormSchema import           Data.Avro.EitherN -import qualified Data.ByteString               as BS-import qualified Data.ByteString.Lazy          as LBS-import qualified Data.ByteString.Lazy.Char8    as LBSC8-import qualified Data.HashMap.Strict           as HM-import qualified Data.Set                      as S-import           Data.Text                     (Text)-import qualified Data.Text                     as T-import qualified Data.Vector                   as V+import qualified Data.ByteString                    as BS+import qualified Data.ByteString.Lazy               as LBS+import qualified Data.ByteString.Lazy.Char8         as LBSC8+import qualified Data.HashMap.Strict                as HM+import qualified Data.Set                           as S+import           Data.Text                          (Text)+import qualified Data.Text                          as T+import qualified Data.Vector                        as V +import           Data.Avro.Decode.Lazy.FromLazyAvro+import qualified Data.Avro.Decode.Lazy.LazyValue    as LV+ -- | How to treat Avro namespaces in the generated Haskell types. data NamespaceBehavior =     IgnoreNamespaces@@ -185,7 +188,7 @@ -- Person { firstName :: Text } -- @ -- You may want to enable 'DuplicateRecordFields' if you want to use this method.-mkAsIsFieldName :: TypeName -> Field -> Text+mkAsIsFieldName :: Text -> Field -> Text mkAsIsFieldName _ = sanitiseName . updateFirst T.toLower . fldName  -- | Derives Haskell types from the given Avro schema file. These@@ -233,8 +236,9 @@   types     <- traverse (genType o) schemas   hasSchema <- traverse (genHasAvroSchema $ namespaceBehavior o) schemas   fromAvros <- traverse (genFromAvro $ namespaceBehavior o) schemas+  fromLazyAvros <- traverse (genFromLazyAvro $ namespaceBehavior o) schemas   toAvros   <- traverse (genToAvro o) schemas-  pure $ join types <> join hasSchema <> join fromAvros <> join toAvros+  pure $ join types <> join hasSchema <> join fromAvros <> join fromLazyAvros <> join toAvros  -- | Derives "read only" Avro from a given schema file. For a schema -- with a top-level definition @com.example.Foo@, this generates:@@ -265,7 +269,8 @@   types     <- traverse (genType o) schemas   hasSchema <- traverse (genHasAvroSchema $ namespaceBehavior o) schemas   fromAvros <- traverse (genFromAvro $ namespaceBehavior o) schemas-  pure $ join types <> join hasSchema <> join fromAvros+  fromLazyAvros <- traverse (genFromLazyAvro $ namespaceBehavior o) schemas+  pure $ join types <> join hasSchema <> join fromAvros <> join fromLazyAvros  -- | Same as 'deriveAvroWithOptions' but uses 'defaultDeriveOptions' --@@ -318,6 +323,8 @@     Left err  -> fail $ "Unable to generate AVRO for " <> p <> ": " <> err     Right sch -> pure sch +---------------------------- FromAvro -----------------------------------------+ genFromAvro :: NamespaceBehavior -> Schema -> Q [Dec] genFromAvro namespaceBehavior (S.Enum n _ _ _ _) =   [d| instance FromAvro $(conT $ mkDataTypeName namespaceBehavior n) where@@ -348,6 +355,39 @@      )   |] +-------------------------------- FromLazyAvro ---------------------------------+genFromLazyAvro :: NamespaceBehavior -> Schema -> Q [Dec]+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+  |]+genFromLazyAvro namespaceBehavior (S.Record n _ _ _ fs) =+  [d| instance FromLazyAvro $(conT $ mkDataTypeName namespaceBehavior n) where+        fromLazyAvro (LV.Record _ r) =+           $(genFromLazyAvroFieldsExp (mkDataTypeName namespaceBehavior n) fs) r+        fromLazyAvro value           = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname n)|] ) value+  |]+genFromLazyAvro namespaceBehavior (S.Fixed n _ s) =+  [d| instance FromLazyAvro $(conT $ mkDataTypeName namespaceBehavior n) where+        fromLazyAvro (LV.Fixed _ v)+          | BS.length v == s = pure $ $(conE (mkDataTypeName namespaceBehavior n)) v+        fromLazyAvro value = $( [|\v -> badValue v $(mkTextLit $ S.renderFullname n)|] ) value+  |]+genFromLazyAvro _ _                             = pure []++genFromLazyAvroFieldsExp :: Name -> [Field] -> Q Exp+genFromLazyAvroFieldsExp n []     = [| (return . return) $(conE n) |]+genFromLazyAvroFieldsExp n (x:xs) =+  [| \r ->+    $(let extract fld = [| r .~: T.pack $(mkTextLit (fldName fld))|]+          ctor = [| $(conE n) <$> $(extract x) |]+      in foldl (\expr fld -> [| $expr <*> $(extract fld) |]) ctor xs+     )+  |]++----------------------- HasAvroSchema ----------------------------------------+ genHasAvroSchema :: NamespaceBehavior -> Schema -> Q [Dec] genHasAvroSchema namespaceBehavior s = do   let sname = mkSchemaValueName namespaceBehavior (name s)@@ -367,8 +407,10 @@          -> Q [Name] newNames base n = sequence [newName (base ++ show i) | i <- [1..n]] +------------------------- ToAvro ----------------------------------------------+ genToAvro :: DeriveOptions -> Schema -> Q [Dec]-genToAvro opts s@(Enum n _ _ vs _) =+genToAvro opts s@(S.Enum n _ _ vs _) =   toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where     conP' = flip conP [] . mkAdtCtorName (namespaceBehavior opts) n@@ -380,7 +422,7 @@                                (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> vs))               |])       |]-genToAvro opts s@(Record n _ _ _ fs) =+genToAvro opts s@(S.Record n _ _ _ fs) =   toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where     toAvroInstance sname =@@ -397,7 +439,7 @@                 )             |] -genToAvro opts s@(Fixed n _ size) =+genToAvro opts s@(S.Fixed n _ size) =   toAvroInstance (mkSchemaValueName (namespaceBehavior opts) n)   where     toAvroInstance sname =

@@ -1,21 +1,118 @@-{-# LANGUAGE DeriveGeneric  #-}-{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE DeriveFoldable      #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE DeriveTraversable   #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Data.Avro.EitherN where  import           Data.Avro+import           Data.Avro.Decode.Lazy as AL import           Data.Avro.Schema-import qualified Data.Avro.Types    as T-import           Data.Tagged+import qualified Data.Avro.Types       as T+import           Data.Bifoldable       (Bifoldable (..))+import           Data.Bifunctor        (Bifunctor (..))+import           Data.Bitraversable    (Bitraversable (..)) import           Data.List.NonEmpty-import           GHC.Generics       (Generic)+import           Data.Tagged+import           GHC.Generics          (Generic) -data Either3 a b c = E3_1 a | E3_2 b | E3_3 c deriving (Eq, Ord, Show, Generic)+data Either3 a b c = E3_1 a | E3_2 b | E3_3 c deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) -data Either4 a b c d = E4_1 a | E4_2 b | E4_3 c | E4_4 d deriving (Eq, Ord, Show, Generic)+data Either4 a b c d = E4_1 a | E4_2 b | E4_3 c | E4_4 d deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) -data Either5 a b c d e = E5_1 a | E5_2 b | E5_3 c | E5_4 d | E5_5 e deriving (Eq, Ord, Show, Generic)+data Either5 a b c d e = E5_1 a | E5_2 b | E5_3 c | E5_4 d | E5_5 e deriving (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) +instance Applicative (Either3 a b) where+  pure = E3_3+  E3_1 a <*> _ = E3_1 a+  E3_2 a <*> _ = E3_2 a+  E3_3 f <*> r = fmap f r++instance Applicative (Either4 a b c) where+  pure = E4_4+  E4_1 a <*> _ = E4_1 a+  E4_2 a <*> _ = E4_2 a+  E4_3 a <*> _ = E4_3 a+  E4_4 f <*> r = fmap f r++instance Applicative (Either5 a b c d) where+  pure = E5_5+  E5_1 a <*> _ = E5_1 a+  E5_2 a <*> _ = E5_2 a+  E5_3 a <*> _ = E5_3 a+  E5_4 a <*> _ = E5_4 a+  E5_5 f <*> r = fmap f r++instance Bifunctor (Either3 a) where+  bimap _ _ (E3_1 a) = E3_1 a+  bimap f _ (E3_2 a) = E3_2 (f a)+  bimap _ g (E3_3 a) = E3_3 (g a)++instance Bifunctor (Either4 a b) where+  bimap _ _ (E4_1 a) = E4_1 a+  bimap _ _ (E4_2 a) = E4_2 a+  bimap f _ (E4_3 a) = E4_3 (f a)+  bimap _ g (E4_4 a) = E4_4 (g a)++instance Bifunctor (Either5 a b c) where+  bimap _ _ (E5_1 a) = E5_1 a+  bimap _ _ (E5_2 a) = E5_2 a+  bimap _ _ (E5_3 a) = E5_3 a+  bimap f _ (E5_4 a) = E5_4 (f a)+  bimap _ g (E5_5 a) = E5_5 (g a)++instance Monad (Either3 a b) where+  E3_1 a >>= _ = E3_1 a+  E3_2 a >>= _ = E3_2 a+  E3_3 a >>= f = f a++instance Monad (Either4 a b c) where+  E4_1 a >>= _ = E4_1 a+  E4_2 a >>= _ = E4_2 a+  E4_3 a >>= _ = E4_3 a+  E4_4 a >>= f = f a++instance Monad (Either5 a b c d) where+  E5_1 a >>= _ = E5_1 a+  E5_2 a >>= _ = E5_2 a+  E5_3 a >>= _ = E5_3 a+  E5_4 a >>= _ = E5_4 a+  E5_5 a >>= f = f a++instance Bifoldable (Either3 a) where+  bifoldMap f _ (E3_2 a) = f a+  bifoldMap _ g (E3_3 a) = g a+  bifoldMap _ _ _        = mempty++instance Bifoldable (Either4 a b) where+  bifoldMap f _ (E4_3 a) = f a+  bifoldMap _ g (E4_4 a) = g a+  bifoldMap _ _ _        = mempty++instance Bifoldable (Either5 a b c) where+  bifoldMap f _ (E5_4 a) = f a+  bifoldMap _ g (E5_5 a) = g a+  bifoldMap _ _ _        = mempty++instance Bitraversable (Either3 a) where+  bitraverse _ _ (E3_1 a) = pure (E3_1 a)+  bitraverse f _ (E3_2 a) = E3_2 <$> f a+  bitraverse _ g (E3_3 a) = E3_3 <$> g a++instance Bitraversable (Either4 a b) where+  bitraverse _ _ (E4_1 a) = pure (E4_1 a)+  bitraverse _ _ (E4_2 a) = pure (E4_2 a)+  bitraverse f _ (E4_3 a) = E4_3 <$> f a+  bitraverse _ g (E4_4 a) = E4_4 <$> g a++instance Bitraversable (Either5 a b c) where+  bitraverse _ _ (E5_1 a) = pure (E5_1 a)+  bitraverse _ _ (E5_2 a) = pure (E5_2 a)+  bitraverse _ _ (E5_3 a) = pure (E5_3 a)+  bitraverse f _ (E5_4 a) = E5_4 <$> f a+  bitraverse _ g (E5_5 a) = E5_5 <$> g a+ instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c) => HasAvroSchema (Either3 a b c) where   schema = Tagged $ mkUnion (untag (schema :: Tagged a Type) :| [                              untag (schema :: Tagged b Type),@@ -42,11 +139,11 @@     | matches branch schemaA = E3_1 <$> fromAvro x     | matches branch schemaB = E3_2 <$> fromAvro x     | matches branch schemaC = E3_3 <$> fromAvro x-    | otherwise              = badValue e "either3"+    | otherwise              = badValue e "Either3"     where Tagged schemaA = schema :: Tagged a Type           Tagged schemaB = schema :: Tagged b Type           Tagged schemaC = schema :: Tagged c Type-  fromAvro x = badValue x "either3"+  fromAvro x = badValue x "Either3"  instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d) => FromAvro (Either4 a b c d) where   fromAvro e@(T.Union _ branch x)@@ -54,12 +151,12 @@     | matches branch schemaB = E4_2 <$> fromAvro x     | matches branch schemaC = E4_3 <$> fromAvro x     | matches branch schemaD = E4_4 <$> fromAvro x-    | otherwise              = badValue e "either4"+    | otherwise              = badValue e "Either4"     where Tagged schemaA = schema :: Tagged a Type           Tagged schemaB = schema :: Tagged b Type           Tagged schemaC = schema :: Tagged c Type           Tagged schemaD = schema :: Tagged d Type-  fromAvro x = badValue x "either4"+  fromAvro x = badValue x "Either4"  instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e) => FromAvro (Either5 a b c d e) where   fromAvro e@(T.Union _ branch x)@@ -68,13 +165,52 @@     | matches branch schemaC = E5_3 <$> fromAvro x     | matches branch schemaD = E5_4 <$> fromAvro x     | matches branch schemaE = E5_5 <$> fromAvro x-    | otherwise              = badValue e "either5"+    | otherwise              = badValue e "Either5"     where Tagged schemaA = schema :: Tagged a Type           Tagged schemaB = schema :: Tagged b Type           Tagged schemaC = schema :: Tagged c Type           Tagged schemaD = schema :: Tagged d Type           Tagged schemaE = schema :: Tagged e Type-  fromAvro x = badValue x "either5"+  fromAvro x = badValue x "Either5"++instance (FromLazyAvro a, FromLazyAvro b, FromLazyAvro c) => FromLazyAvro (Either3 a b c) where+  fromLazyAvro e@(AL.Union _ branch x)+    | matches branch schemaA = E3_1 <$> fromLazyAvro x+    | matches branch schemaB = E3_2 <$> fromLazyAvro x+    | matches branch schemaC = E3_3 <$> fromLazyAvro x+    | otherwise              = badValue e "Either3"+    where Tagged schemaA = schema :: Tagged a Type+          Tagged schemaB = schema :: Tagged b Type+          Tagged schemaC = schema :: Tagged c Type+  fromLazyAvro x = badValue x "Either3"++instance (FromLazyAvro a, FromLazyAvro b, FromLazyAvro c, FromLazyAvro d) => FromLazyAvro (Either4 a b c d) where+  fromLazyAvro e@(AL.Union _ branch x)+    | matches branch schemaA = E4_1 <$> fromLazyAvro x+    | matches branch schemaB = E4_2 <$> fromLazyAvro x+    | matches branch schemaC = E4_3 <$> fromLazyAvro x+    | matches branch schemaD = E4_4 <$> fromLazyAvro x+    | otherwise              = badValue e "Either4"+    where Tagged schemaA = schema :: Tagged a Type+          Tagged schemaB = schema :: Tagged b Type+          Tagged schemaC = schema :: Tagged c Type+          Tagged schemaD = schema :: Tagged d Type+  fromLazyAvro x = badValue x "Either4"++instance (FromLazyAvro a, FromLazyAvro b, FromLazyAvro c, FromLazyAvro d, FromLazyAvro e) => FromLazyAvro (Either5 a b c d e) where+  fromLazyAvro e@(AL.Union _ branch x)+    | matches branch schemaA = E5_1 <$> fromLazyAvro x+    | matches branch schemaB = E5_2 <$> fromLazyAvro x+    | matches branch schemaC = E5_3 <$> fromLazyAvro x+    | matches branch schemaD = E5_4 <$> fromLazyAvro x+    | matches branch schemaE = E5_5 <$> fromLazyAvro x+    | otherwise              = badValue e "Either5"+    where Tagged schemaA = schema :: Tagged a Type+          Tagged schemaB = schema :: Tagged b Type+          Tagged schemaC = schema :: Tagged c Type+          Tagged schemaD = schema :: Tagged d Type+          Tagged schemaE = schema :: Tagged e Type+  fromLazyAvro x = badValue x "Either5"  instance (ToAvro a, ToAvro b, ToAvro c) => ToAvro (Either3 a b c) where   toAvro e =

@@ -1,39 +1,37 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MultiWayIf #-} module Data.Avro.FromAvro  where -import           Control.Arrow        (first)+import           Control.Arrow           (first)+import qualified Data.Avro.Encode        as E import           Data.Avro.HasAvroSchema-import qualified Data.Avro.Encode     as E-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           Data.Foldable        (toList)-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           Data.Foldable           (toList)+import qualified Data.HashMap.Strict     as HashMap import           Data.Int-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Map             as Map-import           Data.Monoid          ((<>))-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.Monoid             ((<>)) 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 => FromAvro a where   fromAvro :: Value Type -> Result a --- instance FromAvro (Value Type) where---   fromAvro = pure- (.:) :: FromAvro a => HashMap.HashMap Text (Value Type) -> Text -> Result a (.:) obj key =   case HashMap.lookup key obj of@@ -44,32 +42,39 @@   fromAvro e@(T.Union _ branch x)     | S.matches branch schemaA = Left  <$> fromAvro x     | S.matches branch schemaB = Right <$> fromAvro x-    | otherwise              = badValue e "either"+    | otherwise              = badValue e "Either"     where Tagged schemaA = schema :: Tagged a Type           Tagged schemaB = schema :: Tagged b Type-  fromAvro x = badValue x "either"+  fromAvro x = badValue x "Either"+ instance FromAvro Bool where   fromAvro (T.Boolean b) = pure b   fromAvro v             = badValue v "Bool"+ instance FromAvro B.ByteString where   fromAvro (T.Bytes b) = pure b-  fromAvro v          = badValue v "ByteString"+  fromAvro v           = badValue v "ByteString"+ instance FromAvro BL.ByteString where   fromAvro (T.Bytes b) = pure (BL.fromStrict b)-  fromAvro v          = badValue v "Lazy ByteString"+  fromAvro v           = badValue v "Lazy ByteString"+ instance FromAvro Int where   fromAvro (T.Int i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)                       = pure (fromIntegral i)   fromAvro (T.Long i) | (fromIntegral i :: Integer) < fromIntegral (maxBound :: Int)                       = pure (fromIntegral i)   fromAvro v          = badValue v "Int"+ instance FromAvro Int32 where-  fromAvro (T.Int i)  = pure (fromIntegral i)-  fromAvro v          = badValue v "Int32"+  fromAvro (T.Int i) = pure (fromIntegral i)+  fromAvro v         = badValue v "Int32"+ instance FromAvro Int64 where   fromAvro (T.Long i) = pure i   fromAvro (T.Int i)  = pure (fromIntegral i)-  fromAvro v = badValue v "Int64"+  fromAvro v          = badValue v "Int64"+ instance FromAvro Double where   fromAvro (T.Double d) = pure d   fromAvro v            = badValue v "Double"@@ -81,11 +86,11 @@ 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 v                                   = badValue v "Maybe a"  instance FromAvro a => FromAvro [a] where   fromAvro (T.Array vec) = mapM fromAvro $ toList vec-  fromAvro v = badValue v "[a]"+  fromAvro v             = badValue v "[a]"  instance FromAvro a => FromAvro (V.Vector a) where   fromAvro (T.Array vec) = mapM fromAvro vec@@ -97,21 +102,19 @@  instance FromAvro Text where   fromAvro (T.String txt) = pure txt-  fromAvro v = badValue v "Text"+  fromAvro v              = badValue v "Text"  instance FromAvro TL.Text where   fromAvro (T.String txt) = pure (TL.fromStrict txt)-  fromAvro v = badValue v "Lazy Text"+  fromAvro v              = badValue v "Lazy Text"  instance (FromAvro a) => FromAvro (Map.Map Text a) where   fromAvro (T.Record _ mp) = mapM fromAvro $ Map.fromList (HashMap.toList mp)-  fromAvro (T.Map mp)  = mapM fromAvro $ Map.fromList (HashMap.toList mp)-  fromAvro v = badValue v "Map Text a"+  fromAvro (T.Map mp)      = mapM fromAvro $ Map.fromList (HashMap.toList mp)+  fromAvro v               = badValue v "Map Text a"  instance (FromAvro a) => FromAvro (HashMap.HashMap Text a) where   fromAvro (T.Record _ mp) = mapM fromAvro mp-  fromAvro (T.Map mp)    = mapM fromAvro mp-  fromAvro v = badValue v "HashMap Text a"+  fromAvro (T.Map mp)      = mapM fromAvro mp+  fromAvro v               = badValue v "HashMap Text a" -badValue :: Value Type -> String -> Result a-badValue v t = fail $ "Unexpected value when decoding for '" <> t <> "': " <> show v

@@ -28,7 +28,9 @@   , typeName   , buildTypeEnvironment   , extractBindings+   , Result(..)+  , badValue   , resultToEither    , matches@@ -492,6 +494,9 @@  data Result a = Success a | Error String   deriving (Eq, Ord, Show)++badValue :: Show t => t -> String -> Result a+badValue v t = fail $ "Unexpected value for '" <> t <> "': " <> show v  resultToEither :: Result b -> Either String b resultToEither r =

@@ -47,7 +47,7 @@     res <- encodeThenDecode chunks     sequence res `shouldBe` Right msgs -encodeThenDecode :: (FromAvro a, ToAvro a) => [[a]] -> IO [Either String a]+encodeThenDecode :: (FromLazyAvro a, ToAvro a) => [[a]] -> IO [Either String a] encodeThenDecode as =   DL.decodeContainer <$> A.encodeContainer as 

@@ -0,0 +1,1 @@+{"id":37,"name":"blarg","reason":"Instead"}

@@ -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"+      }+    ]+  }+]

@@ -0,0 +1,21 @@+{+  "scalars": {+    "string": "blarg"+  },+  "nullable": null,+  "records": {+    "haskell.avro.example.Foo": {+      "stuff": "stuff"+    }+  },+  "sameFields": {+    "haskell.avro.example.Foo": {+      "stuff": "foo stuff"+    }+  },+  "three": { "int": 37 },+  "four": { "string": "foo" },+  "five": {+    "haskell.avro.example.Foo": { "stuff": "foo stuff" }+  }+}

@@ -0,0 +1,28 @@+{+  "scalars": {+    "long": 37+  },+  "nullable": {+    "int": 42+  },+  "records": {+    "haskell.avro.example.Bar": {+      "stuff": "stuff",+      "things": {+        "stuff": "things"+      }+    }+  },+  "sameFields": {+    "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" }+  }+}