packages feed

avro 0.4.4.1 → 0.4.4.2

raw patch · 22 files changed

+701/−320 lines, 22 filesdep +raw-strings-qqPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: raw-strings-qq

API changes (from Hackage documentation)

+ Data.Avro.Decode.Get: decodeBlocks :: Get a -> Get [a]
+ Data.Avro.Decode.Lazy.Deconflict: deconflictNoResolve :: Schema -> Schema -> LazyValue Type -> LazyValue Type
+ Data.Avro.Deconflict: deconflictNoResolve :: Schema -> Schema -> Value Type -> Either String (Value Type)
+ Data.Avro.Schema: expandNamedTypes :: Schema -> Schema

Files

avro.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12  name:           avro-version:        0.4.4.1+version:        0.4.4.2 synopsis:       Avro serialization support for Haskell description:    Avro serialization and deserialization support for Haskell category:       Data@@ -131,8 +131,10 @@       Avro.Decode.Lazy.RawBlocksSpec       Avro.Decode.Lazy.RawValuesSpec       Avro.Decode.Lazy.ValuesSpec-      Avro.Deconflict.Reader-      Avro.Deconflict.Writer+      Avro.Deconflict.A.Reader+      Avro.Deconflict.A.Writer+      Avro.Deconflict.B.Reader+      Avro.Deconflict.B.Writer       Avro.DeconflictSpec       Avro.DefaultsSpec       Avro.EncodeRawSpec@@ -171,6 +173,7 @@     , lens-aeson     , mtl     , pure-zlib+    , raw-strings-qq     , scientific     , semigroups     , tagged@@ -190,7 +193,12 @@ benchmark bench-time   default-language: Haskell2010   type: exitcode-stdio-1.0-  main-is: Time.hs+  main-is: Main.hs+  other-modules:+    Bench.Deconflict+    Bench.Deconflict.Reader+    Bench.Deconflict.Writer+    Bench.Time   hs-source-dirs: bench   build-depends:       avro@@ -203,6 +211,7 @@     , mtl     , text     , random+    , raw-strings-qq     , transformers     , unordered-containers     , vector
+ bench/Bench/Deconflict.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE NumDecimals         #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++module Bench.Deconflict+( only+)+where++import Data.Avro            (toAvro)+import Data.Avro.Deconflict+import Data.Avro.Deriving+import Data.Vector          (Vector)+import Text.RawString.QQ++import qualified Bench.Deconflict.Reader as R+import qualified Bench.Deconflict.Writer as W+import qualified Data.Vector             as Vector+import qualified System.Random           as Random++import Gauge++newOuter :: IO (W.Outer)+newOuter = do+  i1 <- Random.randomRIO (minBound, maxBound)+  i2 <- Random.randomRIO (minBound, maxBound)+  pure $ W.Outer "Written" (W.Inner i1) (W.Inner i2)++many :: Int -> IO a -> IO (Vector a)+many n f = Vector.replicateM n f++-- | Only deconflicts values without actually decoding into generated types+only :: Benchmark+only = env (many 1e5 $ toAvro <$> newOuter) $ \ values ->+  bgroup "strict"+    [ bgroup "deconflict"+        [ bench "plain"     $ nf (fmap (deconflict          W.schema'Outer R.schema'Outer)) $ values+        , bench "noResolve" $ nf (fmap (deconflictNoResolve W.schema'Outer R.schema'Outer)) $ values+        ]+    ]
+ bench/Bench/Deconflict/Reader.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}+module Bench.Deconflict.Reader+where++import Data.Avro.Deriving+import Text.RawString.QQ++deriveAvroFromByteString [r|+{+  "type": "record",+  "name": "Outer",+  "fields": [+    { "name": "name", "type": "string" },+    { "name": "inner", "type": {+        "type": "record",+        "name": "Inner",+        "fields": [+          { "name": "id", "type": "int" },+          { "name": "smell", "type": ["null", "string"], "default": null }+        ]+      }+    },+    { "name": "other", "type": "Inner" }+  ]+}+|]
+ bench/Bench/Deconflict/Writer.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}+module Bench.Deconflict.Writer+where++import Data.Avro.Deriving+import Text.RawString.QQ++deriveAvroFromByteString [r|+{+  "type": "record",+  "name": "Outer",+  "fields": [+    { "name": "name", "type": "string" },+    { "name": "inner", "type": {+        "type": "record",+        "name": "Inner",+        "fields": [+          { "name": "id", "type": "int" }+        ]+      }+    },+    { "name": "other", "type": "Inner" }+  ]+}+|]
+ bench/Bench/Time.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE NumDecimals         #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Bench.Time where++import Control.Monad (replicateM)++import qualified Data.ByteString.Lazy as LBS+import           Data.HashMap.Strict  (HashMap)+import qualified Data.HashMap.Strict  as HashMap+import           Data.Text            (Text)+import           Data.Vector          (Vector)+import qualified Data.Vector          as Vector++import Gauge++import GHC.Int (Int32, Int64)++import qualified System.Random as Random++import qualified Data.Avro             as Avro+import qualified Data.Avro.Decode      as Decode+import qualified Data.Avro.Encode      as Encode+import           Data.Avro.Schema      (Schema)+import qualified Data.Avro.Schema      as Schema+import           Data.Avro.Types.Value (Value)+import qualified Data.Avro.Types.Value as Value+-- * Encoding to binary++encode :: Benchmark+encode = bgroup "encode" [ encodeArray ]++encodeArray :: Benchmark+encodeArray = env randoms $ \ ~(bools, ints, longs, records) ->+  bgroup "array"+  [ bench "bools" $+      nf encodeAvro $ Value.Array $ Value.Boolean <$> bools+  , bench "ints" $+      nf encodeAvro $ Value.Array $ Value.Int <$> ints+  , bench "longs" $+      nf encodeAvro $ Value.Array $ Value.Long <$> longs+  , bench "records" $+      nf encodeAvro $ Value.Array records+  ]+  where randoms = do+          bools <- array+          ints  <- array+          longs <- array+          pure (bools, ints, longs, records bools ints longs)++        array :: (Bounded r, Random.Random r) => IO (Vector r)+        array = Vector.replicateM 1e5 (Random.randomRIO (minBound, maxBound))++        records bools ints longs =+          Vector.zipWith3 record bools ints longs+        record bool int long = Value.Record recordSchema+          [ ("b", Value.Boolean bool)+          , ("i", Value.Int int)+          , ("l", Value.Long long)+          ]+        recordSchema = Schema.Record "Rec" [] Nothing Nothing+          [ Schema.Field "b" [] Nothing Nothing Schema.Boolean Nothing+          , Schema.Field "i" [] Nothing Nothing Schema.Int Nothing+          , Schema.Field "l" [] Nothing Nothing Schema.Long Nothing+          ]++encodeAvro :: Value Schema -> LBS.ByteString+encodeAvro = Encode.encodeAvro++-- * Decoding from binary++decode :: Benchmark+decode = bgroup "decode" [ decodeArray ]++decodeArray :: Benchmark+decodeArray = env randoms $ \ ~(bools, ints, longs, records) ->+  bgroup "array"+  [ bench "bools" $+      nf (decodeAvro $ Schema.Array Schema.Boolean) bools+  , bench "ints" $+      nf (decodeAvro $ Schema.Array Schema.Int) ints+  , bench "longs" $+      nf (decodeAvro $ Schema.Array Schema.Long) longs+  , bench "records" $+      nf (decodeAvro $ Schema.Array recordSchema) records+  ]+  where randoms = do+          bools <- array+          ints  <- array+          longs <- array+          pure ( encodeAvro $ Value.Array $ Value.Boolean <$> bools+               , encodeAvro $ Value.Array $ Value.Int <$> ints+               , encodeAvro $ Value.Array $ Value.Long <$> longs+               , encodeAvro $ Value.Array $ records bools ints longs+               )++        array :: (Bounded r, Random.Random r) => IO (Vector r)+        array = Vector.replicateM 1e5 (Random.randomRIO (minBound, maxBound))++        records bools ints longs =+          Vector.zipWith3 record bools ints longs+        record bool int long = Value.Record recordSchema+          [ ("b", Value.Boolean bool)+          , ("i", Value.Int int)+          , ("l", Value.Long long)+          ]+        recordSchema = Schema.Record "Rec" [] Nothing Nothing+          [ Schema.Field "b" [] Nothing Nothing Schema.Boolean Nothing+          , Schema.Field "i" [] Nothing Nothing Schema.Int Nothing+          , Schema.Field "l" [] Nothing Nothing Schema.Long Nothing+          ]++decodeAvro :: Schema -> LBS.ByteString -> Value Schema+decodeAvro schema bytes = case Decode.decodeAvro schema bytes of+  Left err  -> error err+  Right res -> res
+ bench/Main.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NumDecimals         #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main+where++import qualified Bench.Deconflict as Deconflict+import qualified Bench.Time       as Time++import Gauge++main :: IO ()+main = defaultMain+  [ Time.encode+  , Time.decode++  , Deconflict.only+  ]
− bench/Time.hs
@@ -1,121 +0,0 @@-{-# LANGUAGE NumDecimals         #-}-{-# LANGUAGE OverloadedLists     #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Main where--import           Control.Monad         (replicateM)--import qualified Data.ByteString.Lazy  as LBS-import           Data.HashMap.Strict   (HashMap)-import qualified Data.HashMap.Strict   as HashMap-import           Data.Text             (Text)-import           Data.Vector           (Vector)-import qualified Data.Vector           as Vector--import           Gauge--import           GHC.Int               (Int32, Int64)--import qualified System.Random         as Random--import qualified Data.Avro             as Avro-import qualified Data.Avro.Decode      as Decode-import qualified Data.Avro.Encode      as Encode-import           Data.Avro.Schema      (Schema)-import qualified Data.Avro.Schema      as Schema-import           Data.Avro.Types.Value (Value)-import qualified Data.Avro.Types.Value as Value--main :: IO ()-main = defaultMain [encode, decode]---- * Encoding to binary--encode :: Benchmark-encode = bgroup "encode" [ encodeArray ]--encodeArray :: Benchmark-encodeArray = env randoms $ \ ~(bools, ints, longs, records) ->-  bgroup "array"-  [ bench "bools" $-      nf encodeAvro $ Value.Array $ Value.Boolean <$> bools-  , bench "ints" $-      nf encodeAvro $ Value.Array $ Value.Int <$> ints-  , bench "longs" $-      nf encodeAvro $ Value.Array $ Value.Long <$> longs-  , bench "records" $-      nf encodeAvro $ Value.Array records-  ]-  where randoms = do-          bools <- array-          ints  <- array-          longs <- array-          pure (bools, ints, longs, records bools ints longs)--        array :: (Bounded r, Random.Random r) => IO (Vector r)-        array = Vector.replicateM 1e5 (Random.randomRIO (minBound, maxBound))--        records bools ints longs =-          Vector.zipWith3 record bools ints longs-        record bool int long = Value.Record recordSchema-          [ ("b", Value.Boolean bool)-          , ("i", Value.Int int)-          , ("l", Value.Long long)-          ]-        recordSchema = Schema.Record "Rec" [] Nothing Nothing-          [ Schema.Field "b" [] Nothing Nothing Schema.Boolean Nothing-          , Schema.Field "i" [] Nothing Nothing Schema.Int Nothing-          , Schema.Field "l" [] Nothing Nothing Schema.Long Nothing-          ]--encodeAvro :: Value Schema -> LBS.ByteString-encodeAvro = Encode.encodeAvro---- * Decoding from binary--decode :: Benchmark-decode = bgroup "decode" [ decodeArray ]--decodeArray :: Benchmark-decodeArray = env randoms $ \ ~(bools, ints, longs, records) ->-  bgroup "array"-  [ bench "bools" $-      nf (decodeAvro $ Schema.Array Schema.Boolean) bools-  , bench "ints" $-      nf (decodeAvro $ Schema.Array Schema.Int) ints-  , bench "longs" $-      nf (decodeAvro $ Schema.Array Schema.Long) longs-  , bench "records" $-      nf (decodeAvro $ Schema.Array recordSchema) records-  ]-  where randoms = do-          bools <- array-          ints  <- array-          longs <- array-          pure ( encodeAvro $ Value.Array $ Value.Boolean <$> bools-               , encodeAvro $ Value.Array $ Value.Int <$> ints-               , encodeAvro $ Value.Array $ Value.Long <$> longs-               , encodeAvro $ Value.Array $ records bools ints longs-               )--        array :: (Bounded r, Random.Random r) => IO (Vector r)-        array = Vector.replicateM 1e5 (Random.randomRIO (minBound, maxBound))--        records bools ints longs =-          Vector.zipWith3 record bools ints longs-        record bool int long = Value.Record recordSchema-          [ ("b", Value.Boolean bool)-          , ("i", Value.Int int)-          , ("l", Value.Long long)-          ]-        recordSchema = Schema.Record "Rec" [] Nothing Nothing-          [ Schema.Field "b" [] Nothing Nothing Schema.Boolean Nothing-          , Schema.Field "i" [] Nothing Nothing Schema.Int Nothing-          , Schema.Field "l" [] Nothing Nothing Schema.Long Nothing-          ]--decodeAvro :: Schema -> LBS.ByteString -> Value Schema-decodeAvro schema bytes = case Decode.decodeAvro schema bytes of-  Left err  -> error err-  Right res -> res
src/Data/Avro.hs view
@@ -114,7 +114,7 @@ import           Data.Word import           Prelude               as P -import Data.Avro.Codec (nullCodec)+import Data.Avro.Codec         (nullCodec) import Data.Avro.FromAvro import Data.Avro.HasAvroSchema import Data.Avro.ToAvro@@ -152,13 +152,16 @@ decodeContainerWithSchema readerSchema bs =   case D.decodeContainer bs of     Right (writerSchema,val) ->-      let err e = error $ "Could not deconflict reader and writer schema." <> e-          dec x =-            case C.deconflict writerSchema readerSchema x of-              Left e   -> err e-              Right v  -> case fromAvro v of-                            Success x -> x-                            Error e   -> error e+      let+        writerSchema' = S.expandNamedTypes writerSchema+        readerSchema' = S.expandNamedTypes readerSchema+        err e = error $ "Could not deconflict reader and writer schema." <> e+        dec x =+          case C.deconflictNoResolve writerSchema' readerSchema' x of+            Left e   -> err e+            Right v  -> case fromAvro v of+                          Success x -> x+                          Error e   -> error e       in P.map (P.map dec) val     Left err -> error err 
src/Data/Avro/Decode/Get.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns        #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE MultiWayIf          #-} {-# LANGUAGE OverloadedStrings   #-}@@ -8,20 +9,17 @@ where  import qualified Codec.Compression.Zlib     as Z-import           Control.Monad              (foldM, replicateM, when)+import           Control.Monad              (replicateM, when) import qualified Data.Aeson                 as A import qualified Data.Array                 as Array-import           Data.Binary.Get            (Get, runGetOrFail)+import           Data.Binary.Get            (Get) import qualified Data.Binary.Get            as G import           Data.Binary.IEEE754        as IEEE import           Data.Bits import           Data.ByteString            (ByteString) import qualified Data.ByteString.Lazy       as BL import qualified Data.ByteString.Lazy.Char8 as BC-import 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.Maybe import           Data.Monoid                ((<>))@@ -35,7 +33,6 @@ import           Data.Avro.Codec import           Data.Avro.DecodeRaw import           Data.Avro.Schema           as S-import           Data.Avro.Zag  class GetAvro a where   getAvro :: Get a@@ -153,7 +150,7 @@   bytes <- getBytes   case Text.decodeUtf8' bytes of     Left unicodeExc -> fail (show unicodeExc)-    Right text -> return text+    Right text      -> return text  -- a la Java: --  Bit 31 (the bit that is selected by the mask 0x80000000) represents the@@ -196,28 +193,35 @@ -- getRecord = getAvro  getArray :: GetAvro ty => Get [ty]-getArray =-  do nr <- getLong-     if-      | nr == 0 -> return []-      | nr < 0  ->-          do _len <- getLong-             rs <- replicateM (fromIntegral (abs nr)) getAvro-             (rs <>) <$> getArray-      | otherwise ->-          do rs <- replicateM (fromIntegral nr) getAvro-             (rs <>) <$> getArray+getArray = decodeBlocks getAvro  getMap :: GetAvro ty => Get (Map.Map Text ty)-getMap = go Map.empty- where- go acc =-  do nr <- getLong-     if nr == 0-       then return acc-       else do m <- Map.fromList <$> replicateM (fromIntegral nr) getKVs-               go (Map.union m acc)- getKVs = (,) <$> getString <*> getAvro+getMap = Map.fromList <$> decodeBlocks keyValue+  where keyValue = (,) <$> getString <*> getAvro++-- | Avro encodes arrays and maps as a series of blocks. Each block+-- starts with a count of the elements in the block. A series of+-- blocks is always terminated with an empty block (encoded as a 0).+decodeBlocks :: Get a -> Get [a]+decodeBlocks element = do+  count <- getLong+  if | count == 0 -> return []++     -- negative counts are followed by the number of *bytes* in the+     -- array block+     | count < 0  -> do+         _bytes <- getLong+         items  <- replicateM (fromIntegral $ abs count) element'+         rest   <- decodeBlocks element+         pure $ items <> rest++     | otherwise  -> do+         items <- replicateM (fromIntegral count) element'+         rest  <- decodeBlocks element+         pure $ items <> rest+  where element' = do+          !x <- element+          pure x  -- Safe-ish from integral sFromIntegral :: forall a b m. (Monad m, Bounded a, Bounded b, Integral a, Integral b) => a -> m b
src/Data/Avro/Decode/Lazy.hs view
@@ -55,7 +55,7 @@ import qualified Data.Vector                as V import           Prelude                    as P -import           Data.Avro.Codec (Decompress)+import           Data.Avro.Codec                 (Decompress) import qualified Data.Avro.Decode.Lazy.LazyValue as T import           Data.Avro.DecodeRaw import           Data.Avro.HasAvroSchema         (schema)@@ -125,9 +125,11 @@ 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+  let writerSchema' = S.expandNamedTypes writerSchema+  let readerSchema' = S.expandNamedTypes readerSchema+  pure $ (fmap . fmap) (convertValue writerSchema' readerSchema') vals   where-    convertValue w v = resultToEither $ fromLazyAvro (C.deconflict w readerSchema v) -- >>= (resultToEither . fromLazyAvro)+    convertValue w r v = resultToEither $ fromLazyAvro (C.deconflictNoResolve w r v)  -- |Decode bytes into a 'Value' as described by Schema. decodeAvro :: Schema -> BL.ByteString -> T.LazyValue Type@@ -198,7 +200,7 @@       nrBytes  <- getLong       compressed <- G.getLazyByteString nrBytes       bytes <- case decompress compressed G.getRemainingLazyByteString of-        Right x -> pure x+        Right x  -> pure x         Left err -> fail err       pure (nrObj, bytes) 
src/Data/Avro/Decode/Lazy/Deconflict.hs view
@@ -1,11 +1,13 @@ module Data.Avro.Decode.Lazy.Deconflict   ( deconflict+  , deconflictNoResolve   ) where  import           Control.Applicative             ((<|>)) import           Data.Avro.Decode.Lazy.Convert   (fromStrictValue) import           Data.Avro.Decode.Lazy.LazyValue as T import           Data.Avro.Schema                as S+import qualified Data.Foldable                   as Foldable import           Data.HashMap.Strict             (HashMap) import qualified Data.HashMap.Strict             as HashMap import           Data.List                       (find)@@ -21,14 +23,36 @@ -- | @deconflict writer reader val@ will convert a value that was -- encoded/decoded with the writer's schema into the form specified by the -- reader's schema.+--+-- 'deconflict' will attempt resolving 'TypedName' constructors to make sure that+-- they are handled correctly. This has a performance impact.+-- To avoid it use 'deconflictNoResolve' when possible. deconflict :: Schema        -- ^ Writer schema            -> Schema        -- ^ Reader schema            -> T.LazyValue Type            -> T.LazyValue Type-deconflict = resolveSchema+deconflict writerSchema readerSchema =+  deconflictNoResolve (S.expandNamedTypes writerSchema) (S.expandNamedTypes readerSchema) -resolveSchema :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type-resolveSchema writerSchema readerSchema v+-- | @deconflict writer reader val@ will convert a value that was+-- encoded/decoded with the writer's schema into the form specified by the+-- reader's schema.+--+-- A faster version of 'deconflict' which does not attempt to resolve 'TypedName' references.+-- It still checks if the referenced type has the same name, but does not traverses these references.+--+-- 'deconflictNoResolve' should typically be used when a number of values are decoded with+-- the same reader and writer schemas. In this case schemas can only be resolved once+-- to be used in 'deconflictNoResolve'.+deconflictNoResolve :: Schema         -- ^ Writer schema+                    -> Schema         -- ^ Reader schema+                    -> T.LazyValue Type+                    -> T.LazyValue Type+deconflictNoResolve writerSchema readerSchema =+  deconflictValue writerSchema readerSchema++deconflictValue :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type+deconflictValue writerSchema readerSchema v   | writerSchema == readerSchema    = v   | otherwise = go writerSchema readerSchema v   where@@ -39,72 +63,74 @@     go (S.Map aTy) (S.Map bTy) (T.Map mp)    =         T.Map $ fmap (go aTy bTy) mp     go a@S.Enum {} b@S.Enum {} val-        | name a == name b = resolveEnum a b val+        | name a == name b = deconflictEnum a b val     go a@S.Fixed {} b@S.Fixed {} val         | name a == name b && size a == size b = val     go a@S.Record {} b@S.Record {} val-        | name a == name b = resolveRecord a b val-    go (S.Union _ _) (S.Union ys _) val =-        resolveTwoUnions ys val+        | name a == name b = deconflictRecord a b 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 =-        resolveReaderUnion nonUnion ys val-    go (S.Union _xs _) nonUnion val =-        resolveWriterUnion nonUnion val+        deconflictReaderUnion nonUnion ys 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-        T.Int i32 | dTy == S.Long    -> T.Long   (fromIntegral i32)-                  | dTy == S.Float   -> T.Float  (fromIntegral i32)-                  | dTy == S.Double  -> T.Double (fromIntegral i32)+        T.Int i32  | dTy == S.Long   -> T.Long   (fromIntegral i32)+                   | dTy == S.Float  -> T.Float  (fromIntegral i32)+                   | dTy == S.Double -> T.Double (fromIntegral i32)         T.Long i64 | dTy == S.Float  -> T.Float (fromIntegral i64)-                  | dTy == S.Double -> T.Double (fromIntegral i64)-        T.Float f | dTy == S.Double  -> T.Double (realToFrac f)+                   | dTy == S.Double -> T.Double (fromIntegral i64)+        T.Float f  | dTy == S.Double -> T.Double (realToFrac f)         T.String s | dTy == S.Bytes  -> T.Bytes (Text.encodeUtf8 s)         T.Bytes bs | dTy == S.String -> T.String (Text.decodeUtf8 bs)         _                            -> T.Error $ "Can not resolve differing writer and reader schemas: " ++ show (eTy, dTy)  -- The writer's symbol must be present in the reader's enum-resolveEnum :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type-resolveEnum e d val@(T.Enum _ _ _txt) = val+deconflictEnum :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type+deconflictEnum e d val@(T.Enum _ _ _txt) = val   -- --  | txt `elem` symbols d = Right val   -- --  | otherwise = Left "Decoded enum does not appear in reader's symbol list." -resolveTwoUnions :: NonEmpty Type -> T.LazyValue Type -> T.LazyValue Type-resolveTwoUnions ds (T.Union _ eTy val) =-  resolveReaderUnion eTy ds val+withSchemaIn :: (Foldable f, Functor f)+  => Schema+  -> f Schema+  -> (Schema -> LazyValue Schema)+  -> LazyValue Schema+withSchemaIn schema schemas f =+  case findType schema schemas of+    Nothing    -> T.Error $ "Incorrect payload: union " <> (show . Foldable.toList $ typeName <$> schemas) <> " does not contain schema " <> Text.unpack (typeName schema)+    Just found -> f found -resolveReaderUnion :: Type -> NonEmpty Type -> T.LazyValue Type -> T.LazyValue Type-resolveReaderUnion e ds val =-  let hdl [] = T.Error $ "No corresponding union value for " <> Text.unpack (typeName e)+deconflictReaderUnion :: Type -> NonEmpty 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 resolveSchema e d val of+            case deconflictValue valueType d val of               T.Error _ -> hdl rest-                -- Right (T.Union ds d v)-              v         -> T.Union ds d v-  in hdl (NE.toList ds)--resolveWriterUnion :: Type -> T.LazyValue Type -> T.LazyValue Type-resolveWriterUnion reader (T.Union _ ty val) = resolveSchema ty reader val+              v         -> T.Union unionTypes d v+  in hdl (NE.toList unionTypes) -resolveRecord :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type-resolveRecord writerSchema readerSchema (T.Record ty fldVals)  =-  T.Record ty . HashMap.fromList $ fmap (resolveFields fldVals (fields writerSchema)) (fields readerSchema)+deconflictRecord :: Type -> Type -> T.LazyValue Type -> T.LazyValue Type+deconflictRecord writerSchema readerSchema (T.Record ty fldVals)  =+  T.Record readerSchema . HashMap.fromList $ fmap (deconflictFields fldVals (fields writerSchema)) (fields readerSchema)  -- For each field of the decoders, lookup the field in the hash map---  1) If the field exists, call 'resolveSchema'+--  1) If the field exists, call 'deconflictValue' --  2) If the field is missing use the reader's default --  3) If there is no default, fail. -- -- XXX: Consider aliases in the writer schema, use those to retry on failed lookup.-resolveFields :: HashMap Text (T.LazyValue Type) -> [Field] -> Field -> (Text,T.LazyValue Type)-resolveFields hm writerFields readerField =+deconflictFields :: HashMap Text (T.LazyValue Type) -> [Field] -> Field -> (Text,T.LazyValue Type)+deconflictFields hm writerFields readerField =   let     mbWriterField = findField readerField writerFields     mbValue = HashMap.lookup (fldName readerField) hm   in case (mbWriterField, mbValue, fldDefault readerField) of-    (Just w, Just x,_)   -> (fldName readerField, resolveSchema (fldType w) (fldType readerField) x)-    (_, Just x,_)  -> (fldName readerField, x)-    (_, _,Just def)      -> (fldName readerField, fromStrictValue def)-    (_,Nothing,Nothing)  -> (fldName readerField, T.Error ("No field and no default for " ++ show (fldName readerField)))+    (Just w, Just x,_)  -> (fldName readerField, deconflictValue (fldType w) (fldType readerField) x)+    (_, Just x,_)       -> (fldName readerField, x)+    (_, _,Just def)     -> (fldName readerField, fromStrictValue def)+    (_,Nothing,Nothing) -> (fldName readerField, T.Error ("No field and no default for " ++ show (fldName readerField)))  findField :: Field -> [Field] -> Maybe Field findField f fs =@@ -115,3 +141,8 @@     sameField = not . Set.null . Set.intersection fNames . allNames     byAliases = find sameField fs   in byName <|> byAliases++findType :: Foldable f => Schema -> f Schema -> Maybe Schema+findType schema =+  let tn = typeName schema+  in Foldable.find ((tn ==) . typeName) -- TODO: Consider aliases
src/Data/Avro/Deconflict.hs view
@@ -1,17 +1,20 @@ {-# LANGUAGE TupleSections #-} module Data.Avro.Deconflict   ( deconflict+  , deconflictNoResolve   ) where  import           Control.Applicative ((<|>)) import           Data.Avro.Schema    as S import           Data.Avro.Types     as T+import qualified Data.Foldable       as Foldable import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import           Data.List           (find) import           Data.List.NonEmpty  (NonEmpty (..)) import qualified Data.List.NonEmpty  as NE import qualified Data.Map            as M+import           Data.Semigroup      ((<>)) import qualified Data.Set            as Set import           Data.Text           (Text) import qualified Data.Text           as Text@@ -20,14 +23,39 @@ -- | @deconflict writer reader val@ will convert a value that was -- encoded/decoded with the writer's schema into the form specified by the -- reader's schema.+--+-- 'deconflict' will attempt resolving 'TypedName' constructors to make sure that+-- they are handled correctly. This has a performance impact.+-- To avoid it use 'deconflictNoResolve' when possible. deconflict :: Schema        -- ^ Writer schema            -> Schema        -- ^ Reader schema            -> T.Value Type            -> Either String (T.Value Type)-deconflict = resolveSchema+deconflict writerSchema readerSchema =+  deconflictNoResolve (S.expandNamedTypes writerSchema) (S.expandNamedTypes readerSchema) -resolveSchema :: Type -> Type -> T.Value Type -> Either String (T.Value Type)-resolveSchema writerSchema readerSchema v+-- | @deconflict writer reader val@ will convert a value that was+-- encoded/decoded with the writer's schema into the form specified by the+-- reader's schema.+--+-- A faster version of 'deconflict' which does not attempt to resolve 'TypedName' references.+-- It still checks if the referenced type has the same name, but does not traverses these references.+--+-- 'deconflictNoResolve' should typically be used when a number of values are decoded with+-- the same reader and writer schemas. In this case schemas can only be resolved once+-- to be used in 'deconflictNoResolve'.+deconflictNoResolve :: Schema         -- ^ Writer schema+                    -> Schema         -- ^ Reader schema+                    -> T.Value Type+                    -> Either String (T.Value Type)+deconflictNoResolve writerSchema readerSchema =+  deconflictValue writerSchema readerSchema++deconflictValue :: Schema+              -> Schema+              -> T.Value Type+              -> Either String (T.Value Type)+deconflictValue writerSchema readerSchema v   | writerSchema == readerSchema    = Right v   | otherwise = go writerSchema readerSchema v   where@@ -37,71 +65,74 @@   go (S.Map aTy) (S.Map bTy) (T.Map mp)    =        T.Map <$> mapM (go aTy bTy) mp   go a@S.Enum {} b@S.Enum {} val-       | name a == name b = resolveEnum a b val+       | name a == name b = deconflictEnum a b val   go a@S.Fixed {} b@S.Fixed {} val        | name a == name b && size a == size b = Right val   go a@S.Record {} b@S.Record {} val-       | name a == name b = resolveRecord a b val-  go (S.Union _ _) (S.Union ys _) val =-       resolveTwoUnions ys val+       | name a == name b = deconflictRecord a b 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 =-       resolveReaderUnion nonUnion ys val-  go (S.Union _xs _) nonUnion val =-       resolveWriterUnion nonUnion val+       deconflictReaderUnion nonUnion ys 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-      T.Int i32 | dTy == S.Long    -> Right $ T.Long   (fromIntegral i32)-                | dTy == S.Float   -> Right $ T.Float  (fromIntegral i32)-                | dTy == S.Double  -> Right $ T.Double (fromIntegral i32)+      T.Int i32  | dTy == S.Long   -> Right $ T.Long   (fromIntegral i32)+                 | dTy == S.Float  -> Right $ T.Float  (fromIntegral i32)+                 | dTy == S.Double -> Right $ T.Double (fromIntegral i32)       T.Long i64 | dTy == S.Float  -> Right $ T.Float (fromIntegral i64)                  | dTy == S.Double -> Right $ T.Double (fromIntegral i64)-      T.Float f | dTy == S.Double  -> Right $ T.Double (realToFrac f)+      T.Float f  | dTy == S.Double -> Right $ T.Double (realToFrac f)       T.String s | dTy == S.Bytes  -> Right $ T.Bytes (Text.encodeUtf8 s)       T.Bytes bs | dTy == S.String -> Right $ T.String (Text.decodeUtf8 bs)       _                            -> Left $ "Can not resolve differing writer and reader schemas: " ++ show (eTy, dTy)  -- The writer's symbol must be present in the reader's enum-resolveEnum :: Type -> Type -> T.Value Type -> Either String (T.Value Type)-resolveEnum e d val@(T.Enum _ _ _txt) = Right val+deconflictEnum :: Type -> Type -> T.Value Type -> Either String (T.Value Type)+deconflictEnum e d val@(T.Enum _ _ _txt) = Right val   -- --  | txt `elem` symbols d = Right val   -- --  | otherwise = Left "Decoded enum does not appear in reader's symbol list." -resolveTwoUnions :: NonEmpty Type -> T.Value Type -> Either String (T.Value Type)-resolveTwoUnions  ds (T.Union _ eTy val) =-    resolveReaderUnion eTy ds val+withSchemaIn :: (Foldable f, Functor f)+  => Schema+  -> f Schema+  -> (Schema -> Either String a)+  -> Either String a+withSchemaIn schema schemas f =+  case findType schema schemas of+    Nothing    -> Left $ "Incorrect payload: union " <> (show . Foldable.toList $ typeName <$> schemas) <> " does not contain schema " <> Text.unpack (typeName schema)+    Just found -> f found -resolveReaderUnion :: Type -> NonEmpty Type -> T.Value Type -> Either String (T.Value Type)-resolveReaderUnion e ds val =+deconflictReaderUnion :: Type -> NonEmpty 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 resolveSchema e d val of-                Right v -> Right (T.Union ds d v)+              case deconflictValue valueSchema d val of+                Right v -> Right (T.Union unionTypes d v)                 Left _  -> hdl rest-    in hdl (NE.toList ds)--resolveWriterUnion :: Type -> T.Value Type -> Either String (T.Value Type)-resolveWriterUnion reader (T.Union _ ty val) = resolveSchema ty reader val+    in hdl (NE.toList unionTypes) -resolveRecord :: Type -> Type -> T.Value Type -> Either String (T.Value Type)-resolveRecord writerSchema readerSchema (T.Record ty fldVals)  =-  T.Record ty . HashMap.fromList <$> mapM (resolveFields fldVals (fields writerSchema)) (fields readerSchema)+deconflictRecord :: Type -> Type -> T.Value Type -> Either String (T.Value Type)+deconflictRecord writerSchema readerSchema (T.Record ty fldVals)  =+  T.Record readerSchema . HashMap.fromList <$> mapM (deconflictFields fldVals (fields writerSchema)) (fields readerSchema)  -- For each field of the decoders, lookup the field in the hash map---  1) If the field exists, call 'resolveSchema'+--  1) If the field exists, call 'deconflictValue' --  2) If the field is missing use the reader's default --  3) If there is no default, fail. -- -- XXX: Consider aliases in the writer schema, use those to retry on failed lookup.-resolveFields :: HashMap Text (T.Value Type) -> [Field] -> Field -> Either String (Text,T.Value Type)-resolveFields hm writerFields readerField =+deconflictFields :: HashMap Text (T.Value Type) -> [Field] -> Field -> Either String (Text,T.Value Type)+deconflictFields hm writerFields readerField =   let     mbWriterField = findField readerField writerFields     mbValue = HashMap.lookup (fldName readerField) hm   in case (mbWriterField, mbValue, fldDefault readerField) of-    (Just w, Just x,_)   -> (fldName readerField,) <$> resolveSchema (fldType w) (fldType readerField) x-    (_, Just x,_)  -> Right (fldName readerField, x)-    (_, _,Just def)      -> Right (fldName readerField, def)-    (_,Nothing,Nothing)  -> Left $ "No field and no default for " ++ show (fldName readerField)+    (Just w, Just x,_)  -> (fldName readerField,) <$> deconflictValue (fldType w) (fldType readerField) x+    (_, Just x,_)       -> Right (fldName readerField, x)+    (_, _,Just def)     -> Right (fldName readerField, def)+    (_,Nothing,Nothing) -> Left $ "No field and no default for " ++ show (fldName readerField)  findField :: Field -> [Field] -> Maybe Field findField f fs =@@ -112,3 +143,8 @@     sameField = not . Set.null . Set.intersection fNames . allNames     byAliases = find sameField fs   in byName <|> byAliases++findType :: Foldable f => Schema -> f Schema -> Maybe Schema+findType schema =+  let tn = typeName schema+  in Foldable.find ((tn ==) . typeName) -- TODO: Consider aliases
src/Data/Avro/Schema.hs view
@@ -45,6 +45,7 @@    , overlay   , subdefinition+  , expandNamedTypes   ) where  import           Control.Applicative@@ -53,36 +54,36 @@ import qualified Control.Monad.Fail         as MF import           Control.Monad.State.Strict -import           Data.Aeson                 (FromJSON (..), ToJSON (..), object,-                                             (.!=), (.:), (.:!), (.:?), (.=))-import qualified Data.Aeson                 as A-import           Data.Aeson.Types           (Parser, typeMismatch)-import qualified Data.Avro.Types            as Ty-import qualified Data.ByteString            as B-import qualified Data.ByteString.Base16     as Base16-import qualified Data.Char                  as Char-import           Data.Function              (on)+import           Data.Aeson             (FromJSON (..), ToJSON (..), object, (.!=), (.:), (.:!), (.:?), (.=))+import qualified Data.Aeson             as A+import           Data.Aeson.Types       (Parser, typeMismatch)+import qualified Data.Avro.Types        as Ty+import qualified Data.ByteString        as B+import qualified Data.ByteString.Base16 as Base16+import qualified Data.Char              as Char+import           Data.Function          (on) import           Data.Hashable-import qualified Data.HashMap.Strict        as HashMap+import           Data.HashMap.Strict    (HashMap)+import qualified Data.HashMap.Strict    as HashMap import           Data.Int-import qualified Data.IntMap                as IM-import qualified Data.List                  as L-import           Data.List.NonEmpty         (NonEmpty (..))-import qualified Data.List.NonEmpty         as NE-import           Data.Maybe                 (catMaybes, fromMaybe, isJust)-import           Data.Monoid                (First (..))+import qualified Data.IntMap            as IM+import qualified Data.List              as L+import           Data.List.NonEmpty     (NonEmpty (..))+import qualified Data.List.NonEmpty     as NE+import           Data.Maybe             (catMaybes, fromMaybe, isJust)+import           Data.Monoid            (First (..)) import           Data.Semigroup-import qualified Data.Set                   as S+import qualified Data.Set               as S import           Data.String-import           Data.Text                  (Text)-import qualified Data.Text                  as T-import           Data.Text.Encoding         as T-import qualified Data.Vector                as V-import           Prelude                    as P+import           Data.Text              (Text)+import qualified Data.Text              as T+import           Data.Text.Encoding     as T+import qualified Data.Vector            as V+import           Prelude                as P -import           GHC.Generics               (Generic)+import GHC.Generics (Generic) -import           Text.Show.Functions        ()+import Text.Show.Functions ()  -- |An Avro schema is either -- * A "JSON object in the form `{"type":"typeName" ...`@@ -742,9 +743,28 @@   Map{..}      -> extractBindings values   _            -> HashMap.empty ++expandNamedTypes :: Schema -> Schema+expandNamedTypes =+  flip evalState HashMap.empty . go+  where+    expandField f@Field{fldType} = (\x -> f { fldType = x }) <$> go fldType+    go = \case+      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++      r@Record{name, fields}  -> do+        fields' <- traverse expandField fields+        let r' = r { fields = fields' }+        modify' (HashMap.insert name r')+        pure r'++      other -> pure other+ -- | 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@@ -752,12 +772,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{..}      = u {-                                      options     = NE.map overlayType options,-                                      unionLookup = \i -> case unionLookup i of-                                                            Just named@(NamedType _) -> Just $ rebind named-                                                            other                    -> other-                                   }+    overlayType  u@Union{..}      = mkUnion (NE.map overlayType options)     overlayType  nt@(NamedType _) = rebind nt     overlayType  other            = other 
+ test/Avro/Deconflict/A/Reader.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+module Avro.Deconflict.A.Reader+where++import Data.Avro.Deconflict+import Data.Avro.Deriving++deriveAvro "test/data/deconflict/reader.avsc"++sampleValue :: Outer+sampleValue = Outer "Peone" (Inner 3 Nothing) (Inner 5 Nothing)
+ test/Avro/Deconflict/A/Writer.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+module Avro.Deconflict.A.Writer+where++import Data.Avro.Deconflict+import Data.Avro.Deriving++deriveAvro "test/data/deconflict/writer.avsc"++sampleValue :: Outer+sampleValue = Outer "Peone" (Inner 3) (Inner 5)
+ test/Avro/Deconflict/B/Reader.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}++module Avro.Deconflict.B.Reader where++import Data.Avro.Deriving+import Text.RawString.QQ++deriveAvroFromByteString [r|+[+{+  "type": "record",+  "name": "Foo",+  "namespace": "avro.test",+  "fields": [+    { "name": "fieldA",+      "type": ["null", {+        "type": "record",+        "name": "Goo",+        "fields": [+          { "name": "fieldB1",+            "type": {+              "type": "record",+              "name": "Moo",+              "fields": [+                { "name": "name",     "type": "string"  },+                { "name": "fullName", "type": ["null", "string"], "default": null }+              ]+            }+          },+          { "name": "fieldB2", "type": "Moo" }+        ]+      }]+    }+  ]+}+]+|]++sampleValue :: Foo+sampleValue = Foo+  { fooFieldA = Just Goo+    { gooFieldB1 = Moo+      { mooName     = "X"+      , mooFullName = Nothing+      }+    , gooFieldB2 = Moo+      { mooName     = "X"+      , mooFullName = Nothing+      }+    }+  }
+ test/Avro/Deconflict/B/Writer.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE TemplateHaskell   #-}++module Avro.Deconflict.B.Writer where++import Data.Avro.Deriving+import Text.RawString.QQ++deriveAvroFromByteString [r|+[+{+  "type": "record",+  "name": "Foo",+  "namespace": "avro.test",+  "fields": [+    { "name": "fieldA",+      "type": ["null", {+        "type": "record",+        "name": "Goo",+        "fields": [+          { "name": "fieldB1",+            "type": {+              "type": "record",+              "name": "Moo",+              "fields": [+                { "name": "name",     "type": "string"  }+              ]+            }+          },+          { "name": "fieldB2", "type": "Moo" }+        ]+      }]+    }+  ]+}+]+|]++sampleValue :: Foo+sampleValue = Foo+  { fooFieldA = Just Goo+    { gooFieldB1  = Moo+      { mooName   = "X"+      }+    , gooFieldB2  = Moo+      { mooName   = "X"+      }+    }+  }
− test/Avro/Deconflict/Reader.hs
@@ -1,10 +0,0 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}-module Avro.Deconflict.Reader-where--import           Data.Avro.Deconflict-import           Data.Avro.Deriving--deriveAvro "test/data/deconflict/reader.avsc"
− test/Avro/Deconflict/Writer.hs
@@ -1,10 +0,0 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}-module Avro.Deconflict.Writer-where--import           Data.Avro.Deconflict-import           Data.Avro.Deriving--deriveAvro "test/data/deconflict/writer.avsc"
test/Avro/DeconflictSpec.hs view
@@ -1,40 +1,94 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}-module Avro.DeconflictSpec-where+module Avro.DeconflictSpec where -import           Data.Avro              as A-import qualified Data.Avro.Decode       as A (decodeAvro)-import           Data.Avro.Deconflict-import           Data.Avro.Deriving-import           Data.Avro.Schema-import qualified Data.Avro.Types        as Ty-import           Data.Either-import           Data.List.NonEmpty     (NonEmpty (..))+import Control.Monad.IO.Class+import Data.Avro              as A+import Data.Avro.Deconflict+import Data.Avro.Deriving+import Data.Avro.Schema+import Data.Either+import Data.List.NonEmpty     (NonEmpty (..)) -import qualified Avro.Deconflict.Reader as R-import qualified Avro.Deconflict.Writer as W+import qualified Avro.Deconflict.A.Reader         as AR+import qualified Avro.Deconflict.A.Writer         as AW+import qualified Avro.Deconflict.B.Reader         as BR+import qualified Avro.Deconflict.B.Writer         as BW+import qualified Data.Avro.Decode                 as A (decodeAvro)+import qualified Data.Avro.Decode.Lazy            as AL+import qualified Data.Avro.Decode.Lazy.Deconflict as AL+import qualified Data.Avro.Deconflict             as A+import qualified Data.Avro.Types                  as Ty -import           Test.Hspec+import Test.Hspec  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} -writerMessage :: W.Outer-writerMessage = W.Outer "Peone" (W.Inner 3)- spec :: Spec spec = describe "Avro.DeconflictSpec" $ do-  it "should deconflict simple message" $ do-    let payload = A.encode $ W.Inner 3-    let Right decodedAvro = A.decodeAvro W.schema'Inner payload-    let Right deconflicted = deconflict W.schema'Inner R.schema'Inner decodedAvro-    fromAvro deconflicted `shouldBe` Success (R.Inner 3 Nothing)+  describe "Type A" $ do+    it "should deconflict simple message" $ do+      let payload = A.encode $ AW.Inner 3+      let Right decodedAvro = A.decodeAvro AW.schema'Inner payload+      let Right deconflicted = deconflict AW.schema'Inner AR.schema'Inner decodedAvro+      fromAvro deconflicted `shouldBe` Success (AR.Inner 3 Nothing) -  it "should deconflict nested message" $ do-    let payload = A.encode writerMessage-    let Right decodedAvro = A.decodeAvro W.schema'Outer payload-    let Right deconflicted = deconflict W.schema'Outer R.schema'Outer decodedAvro+    it "should deconflict nested message" $ do+      let payload = A.encode AW.sampleValue+      let Right decodedAvro = A.decodeAvro AW.schema'Outer payload+      let Right deconflicted = deconflict AW.schema'Outer AR.schema'Outer decodedAvro -    fromAvro deconflicted `shouldBe` Success (R.Outer "Peone" (R.Inner 3 Nothing))+      fromAvro deconflicted `shouldBe` Success AR.sampleValue +    it "should deconflict strict container" $ do+      w <- A.encodeContainer [[AW.sampleValue]]+      A.decodeContainer w `shouldBe` [[AR.sampleValue]] +    it "should deconflict lazy container" $ do+      w <- A.encodeContainer [[AW.sampleValue]]+      AL.decodeContainer w `shouldBe` [Right AR.sampleValue]++    it "should deconflict lazy value" $ do+      let payload = A.encode AW.sampleValue+      let decodedAvro = AL.decodeAvro AW.schema'Outer payload+      let deconflicted = AL.deconflict AW.schema'Outer AR.schema'Outer decodedAvro++      AL.fromLazyAvro deconflicted `shouldBe` Success AR.sampleValue++    it "should deconflict strict value" $ do+      let payload = A.encode AW.sampleValue+      let Right decodedAvro = A.decodeAvro AW.schema'Outer payload+      let Right deconflicted = A.deconflict AW.schema'Outer AR.schema'Outer decodedAvro++      A.fromAvro deconflicted `shouldBe` Success AR.sampleValue+++  describe "Type B" $ do+    it "should deconflict complex type" $ do+      let payload = A.encode BW.sampleValue+      let decodedAvro = AL.decodeAvro BW.schema'Foo payload+      let res = AL.deconflict BW.schema'Foo BR.schema'Foo decodedAvro++      AL.fromLazyAvro res `shouldBe` Success BR.sampleValue++    it "should deconflict lazy container" $ do+      w <- liftIO $ A.encodeContainer [[ BW.sampleValue ]]+      AL.decodeContainer w `shouldBe` [ Right BR.sampleValue ]++    it "should deconflict lazy value" $ do+      let payload = A.encode AW.sampleValue+      let decodedAvro = AL.decodeAvro AW.schema'Outer payload+      let deconflicted = AL.deconflict AW.schema'Outer AR.schema'Outer decodedAvro++      AL.fromLazyAvro deconflicted `shouldBe` Success AR.sampleValue++    it "should deconflict strict container" $ do+      w <- A.encodeContainer [[BW.sampleValue]]+      A.decodeContainer w `shouldBe` [[BR.sampleValue]]++    it "should deconflict strict value" $ do+      let payload = A.encode BW.sampleValue+      let Right decodedAvro = A.decodeAvro BW.schema'Foo payload+      let Right deconflicted = A.deconflict BW.schema'Foo BR.schema'Foo decodedAvro++      A.fromAvro deconflicted `shouldBe` Success BR.sampleValue
test/data/deconflict/reader.avsc view
@@ -11,6 +11,7 @@           { "name": "smell", "type": ["null", "string"], "default": null }         ]       }-    }+    },+    { "name": "other", "type": "Inner" }   ] }
test/data/deconflict/writer.avsc view
@@ -10,6 +10,7 @@           { "name": "id", "type": "int" }         ]       }-    }+    },+    { "name": "other", "type": "Inner" }   ] }