packages feed

avro (empty) → 0.1.0.0

raw patch · 34 files changed

+2966/−0 lines, 34 filesdep +QuickCheckdep +aesondep +arraysetup-changed

Dependencies added: QuickCheck, aeson, array, avro, base, base16-bytestring, binary, bytestring, containers, data-binary-ieee754, entropy, extra, fail, hashable, hspec, mtl, pure-zlib, scientific, semigroups, tagged, template-haskell, text, unordered-containers, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for avro++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Thomas M. DuBuisson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Thomas M. DuBuisson nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ avro.cabal view
@@ -0,0 +1,113 @@+-- Initial avro.cabal generated by cabal init.  For further documentation,+-- see http://haskell.org/cabal/users-guide/++name:                avro+version:             0.1.0.0+synopsis:            Avro serialization support for Haskell+description:         Avro serialization and deserialization support for Haskell+homepage:            https://github.com/GaloisInc/avro.git+license:             BSD3+license-file:        LICENSE+author:              Thomas M. DuBuisson+maintainer:          tommd@galois.com+-- copyright:+category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md, test/data/reused.avsc, test/data/small.avsc, test/data/enums.avsc+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/GaloisInc/avro.git++flag dev+  default: False+  manual: True+  description: Use development GHC flags++library+  exposed-modules:      Data.Avro,+                        Data.Avro.Decode,+                        Data.Avro.DecodeRaw,+                        Data.Avro.Deconflict,+                        Data.Avro.Deriving,+                        Data.Avro.Encode,+                        Data.Avro.EncodeRaw,+                        Data.Avro.Schema,+                        Data.Avro.Types,+                        Data.Avro.Zag,+                        Data.Avro.Zig+  other-modules:        Data.Avro.Deriving.NormSchema+  other-extensions:    OverloadedStrings+  build-depends:       base >=4.8 && <5.0,+                       aeson,+                       array,+                       base16-bytestring,+                       binary,+                       bytestring,+                       containers,+                       data-binary-ieee754,+                       entropy,+                       fail,+                       hashable,+                       mtl,+                       scientific,+                       text,+                       unordered-containers,+                       vector,+                       pure-zlib,+                       semigroups,+                       tagged,+                       template-haskell+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -O2+  if flag(dev)+    ghc-options: -Wall -Werror++test-suite test+  type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       test+  other-modules:        Avro.Codec.ArraySpec+                      , Avro.Codec.BoolSpec+                      , Avro.Codec.CodecRawSpec+                      , Avro.Codec.DoubleSpec+                      , Avro.Codec.Int64Spec+                      , Avro.Codec.MaybeSpec+                      , Avro.Codec.NestedSpec+                      , Avro.Codec.TextSpec+                      , Avro.Codec.ZigZagSpec+                      , Avro.EncodeRawSpec+                      , Avro.THEnumSpec+                      , Avro.THReusedSpec+                      , Avro.THSimpleSpec+                      , Avro.ToAvroSpec++  main-is:              Spec.hs+  ghc-options:          -threaded+  if flag(dev)+    ghc-options: -Wall -Werror+  build-depends:        base >=4.6 && < 5+                      , avro+                      , aeson+                      , array+                      , base16-bytestring+                      , binary+                      , bytestring+                      , containers+                      , entropy+                      , extra+                      , fail+                      , hashable+                      , mtl+                      , scientific+                      , text+                      , unordered-containers+                      , vector+                      , pure-zlib+                      , semigroups+                      , tagged+                      , template-haskell+                      , hspec+                      , QuickCheck
+ src/Data/Avro.hs view
@@ -0,0 +1,327 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiWayIf #-}+-- | Avro encoding and decoding routines.+--+-- This library provides a high level interface for encoding (and decoding)+-- Haskell values in Apache's Avro serialization format.  The goal is to+-- match Aeson's API whenever reasonable, meaning user experience with one+-- effectively translate to the other.+--+-- Avro RPC is not currently supported.+--+-- **Library Structure**+--+-- The library structure includes:+--   * This module, 'Data.Avro', providing a high-level interface via+--     classes of 'FromAvro' and 'ToAvro' for decoding and encoding values.+--   * 'Data.Avro.Type' define the types of Avro data, providing a common+--      (intermediate) representation for any data that is encoded or decoded+--      by Data.Avro.+--   * 'Data.Avro.Encode' and 'Data.Avro.Decode': More+--     efficient conversion capable of avoiding the intermediate representation.+--     Also, the implementation of the en/decoding of the intermediate+--     representation.+--   * 'Data.Avro.Deconflict': translate decoded data from an+--     encoder schema to the (potentially different) decoder's schema.+--   * 'Data.Avro.Schema': Defines the type for Avro schema's and its JSON+--      encoding/decoding.+--+-- Example decoding:+--+-- Let's say you have an ADT and related schema:+--+-- @+-- {-# LANGUAGE OverloadedStrings #-}+-- import qualified Data.Avro.Types as Ty+-- import Data.Avro.Schema+-- import Data.Avro+-- import           Data.List.NonEmpty (NonEmpty(..))+--+-- data MyEnum = A | B | C | D deriving (Eq,Ord,Show,Enum,Generic)+-- data MyStruct = MyStruct (Either MyEnum String) Int+--+-- meSchema :: Schema+-- meSchema = Schema $ mkEnum "MyEnum" [] Nothing Nothing ["A","B","C","D"]+--+-- msSchema  :: Schema+-- msSchema =+--   Struct "MyStruct" Nothing [] Nothing Nothing+--       [ fld "enumOrString" eOrS (Just $ String "The Default")+--       , fld "int" Int (Just (Ty.Int 1))+--       ]+--      where+--      fld nm ty def = Field nm [] Nothing Nothing ty def+--      eOrS = mkUnion (meSchema :| [String])+--+-- instance ToAvro MyEnum where+--     toAvro = toAvroEnum+-- instance ToAvro MyStruct where+--     toAvro (MyStruct ab i) =+--      record [ "enumOrString" .= ab+--             , "int"          .= i+--             ]+--+-- main = do+--   let val = MyStruct (Right "Hello") 1+--   print (fromAvro (toAvro val) == Success val)+--+-- @+module Data.Avro+  ( FromAvro(..)+  , ToAvro(..)+  , Avro+  , (.:)+  , (.=), record+  , Result(..), badValue+  , decode+  , decodeContainer+  , decodeContainerBytes+  , encode+  , encodeContainer+  , encodeContainerWithSync+  , schemaOf+  ) where++import           Prelude              as P+import           Control.Arrow        (first)+import qualified Data.Avro.Decode     as D+import           Data.Avro.Deconflict as C+import qualified Data.Avro.Encode     as E+import           Data.Avro.Schema     as S+import           Data.Avro.Types      as T+import qualified Data.Binary.Get      as G+import qualified Data.Binary.Put      as P+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.Tagged+import qualified Data.Vector          as V+import           Data.Word++-- |Decode a lazy bytestring using a given Schema.+decode :: FromAvro a => Schema -> ByteString -> Result a+decode sch bytes =+  case D.decodeAvro sch bytes of+    Right val -> fromAvro val+    Left err  -> Error err++-- |Decode a container and de-conflict the writer schema with a given+-- reader-schema.  Exceptions are thrown instead of a 'Result' type to+-- allow this function to be read lazy (to be done in some later version).+decodeContainer :: FromAvro a => Schema -> ByteString -> [[a]]+decodeContainer 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+      in P.map (P.map dec) val+    Left err -> error err++encode :: ToAvro a => a -> BL.ByteString+encode = E.encodeAvro . toAvro++encodeContainer :: ToAvro a => [[a]] -> IO BL.ByteString+encodeContainer = E.encodeContainer . map (map toAvro)++encodeContainerWithSync :: ToAvro a => (Word64,Word64,Word64,Word64) -> [[a]] -> BL.ByteString+encodeContainerWithSync (a,b,c,d) = E.encodeContainerWithSync s . map (map toAvro)+ where s = P.runPut $ mapM_ P.putWord64le [a,b,c,d]++-- |Like 'decodeContainer' but returns the avro-encoded bytes for each+-- object in the container instead of the Haskell type.+--+-- This is particularly useful when slicing up containers into one or more+-- smaller files.  By extracting the original bytestring it is possible to+-- avoid re-encoding data.+decodeContainerBytes :: ByteString -> [[ByteString]]+decodeContainerBytes bs =+  case D.decodeContainerWith schemaBytes bs of+    Right (writerSchema, val) -> val+    Left e -> error $ "Could not decode container: " <> e+  where+  schemaBytes sch =+    do start <- G.bytesRead+       end   <- G.lookAhead $ do _ <- D.getAvroOf sch+                                 G.bytesRead+       G.getLazyByteString (end-start)++type Avro a = (FromAvro a, ToAvro a)+class FromAvro a where+  fromAvro :: Value Type -> Result a++instance FromAvro (Value Type) where+  fromAvro = pure+instance (ToAvro a, ToAvro b, FromAvro a, FromAvro b) => FromAvro (Either a b) where+  fromAvro e@(T.Union _ v x) =+    if | v == untag (schema :: Tagged a Type) -> Left <$> fromAvro x+       | v == untag (schema :: Tagged b Type) -> Right <$> fromAvro x+       | otherwise -> badValue e "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"+instance FromAvro BL.ByteString where+  fromAvro (T.Bytes b) = pure (BL.fromStrict b)+  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"+instance FromAvro Int64 where+  fromAvro (T.Long i) = pure i+  fromAvro (T.Int i)  = pure (fromIntegral i)+  fromAvro v = badValue v "Int64"+instance FromAvro Double where+  fromAvro (T.Double d) = pure d+  fromAvro v            = badValue v "Double"+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"++instance FromAvro a => FromAvro [a] where+  fromAvro (T.Array vec) = mapM fromAvro $ toList vec+  fromAvro v = badValue v "[a]"++instance FromAvro Text where+  fromAvro (T.String txt) = pure txt+  fromAvro v = badValue v "Text"++instance FromAvro TL.Text where+  fromAvro (T.String txt) = pure (TL.fromStrict txt)+  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"++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"++badValue :: Value Type -> String -> Result a+badValue v t = fail $ "Unexpected value when decoding for '" <> t <> "': " <> show v++(.:) :: FromAvro a => HashMap.HashMap Text (Value Type) -> Text -> Result a+(.:) obj key =+  case HashMap.lookup key obj of+    Nothing -> fail $ "Requested field not available: " <> show key+    Just v  -> fromAvro v++(.=)  :: ToAvro a => Text -> a -> (Text,T.Value Type)+(.=) nm val = (nm,toAvro val)++record :: Foldable f => Type -> f (Text,T.Value Type) -> T.Value Type+record ty = T.Record ty . HashMap.fromList . toList++class ToAvro a where+  toAvro :: a -> T.Value Type+  schema :: Tagged a Type++schemaOf :: (ToAvro a) => a -> Type+schemaOf = witness schema++instance ToAvro Bool where+  toAvro = T.Boolean+  schema = Tagged S.Boolean+instance ToAvro () where+  toAvro _ = T.Null+  schema = Tagged S.Null+instance ToAvro Int where+  toAvro = T.Long . fromIntegral+  schema = Tagged S.Long+instance ToAvro Int32 where+  toAvro = T.Int+  schema = Tagged S.Int+instance ToAvro Int64 where+  toAvro = T.Long+  schema = Tagged S.Long+instance ToAvro Double where+  toAvro = T.Double+  schema = Tagged S.Double+instance ToAvro Text.Text where+  toAvro = T.String+  schema = Tagged S.String+instance ToAvro TL.Text where+  toAvro = T.String . TL.toStrict+  schema = Tagged S.String+instance ToAvro B.ByteString where+  toAvro = T.Bytes+  schema = Tagged S.Bytes+instance ToAvro BL.ByteString where+  toAvro = T.Bytes . BL.toStrict+  schema = Tagged S.Bytes+instance (ToAvro a, ToAvro b) => ToAvro (Either a b) where+  toAvro e =+    let sch@(l:|[r]) = options (schemaOf e)+    in case e of+         Left a  -> T.Union sch l (toAvro a)+         Right b -> T.Union sch r (toAvro b)+  schema = Tagged $ mkUnion (untag (schema :: Tagged a Type) :| [untag (schema :: Tagged b Type)])+instance (ToAvro a) => ToAvro (Map.Map Text a) where+  toAvro = toAvro . HashMap.fromList . Map.toList+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (HashMap.HashMap Text a) where+  toAvro = T.Map . HashMap.map toAvro+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (Map.Map TL.Text a) where+  toAvro = toAvro . HashMap.fromList . map (first TL.toStrict) . Map.toList+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (HashMap.HashMap TL.Text a) where+  toAvro = toAvro . HashMap.fromList . map (first TL.toStrict) . HashMap.toList+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (Map.Map String a) where+  toAvro = toAvro . HashMap.fromList . map (first Text.pack) . Map.toList+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (HashMap.HashMap String a) where+  toAvro = toAvro . HashMap.fromList . map (first Text.pack) . HashMap.toList+  schema = wrapTag S.Map (schema :: Tagged a Type)+instance (ToAvro a) => ToAvro (Maybe a) where+  toAvro a =+    let sch@(l:|[r]) = options (schemaOf a)+    in case a of+      Nothing -> T.Union sch S.Null (toAvro ())+      Just v  -> T.Union sch r (toAvro v)+  schema = Tagged $ mkUnion (S.Null:| [untag (schema :: Tagged a Type)])+instance (ToAvro a) => ToAvro [a] where+  toAvro = T.Array . V.fromList . (toAvro <$>)+  schema = wrapTag S.Array (schema :: Tagged a Type)++wrapTag :: (Type -> Type) -> Tagged a Type -> Tagged b Type+wrapTag f = Tagged . f . untag+{-# INLINE wrapTag #-}++-- @enumToAvro val@ will generate an Avro encoded value of enum suitable+-- for serialization ('encode').+-- enumToAvro :: (Show a, Enum a, Bounded a, Generic a) => a -> T.Value Type+-- enumToAvro e = T.Enum ty (show e)+--  where+--   ty = S.Enum nm Nothing [] Nothing (map (Text.pack . show) [minBound..maxBound])+--   nm = datatypeName g+--   g  = from e -- GHC generics
+ src/Data/Avro/Decode.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE TupleSections       #-}+{-# LANGUAGE OverloadedStrings   #-}++module Data.Avro.Decode+  ( decodeAvro+  , decodeContainer+  -- * Lower level interface+  , decodeContainerWith+  , getAvroOf+  , GetAvro(..)+  ) where++import Prelude as P+import           Control.Monad              (replicateM,when)+import qualified Codec.Compression.Zlib     as Z+import qualified Data.Aeson                 as A+import qualified Data.Array                 as Array+import qualified Data.Binary.Get            as G+import           Data.Binary.Get            (Get,runGetOrFail)+import           Data.Binary.IEEE754        as IEEE+import           Data.Bits+import qualified Data.ByteString.Lazy       as BL+import           Data.ByteString            (ByteString)+import qualified Data.ByteString.Lazy.Char8 as BC+import           Data.Int+import           Data.List                  (foldl')+import qualified Data.List.NonEmpty as NE+import           Data.Maybe+import qualified Data.Map                   as Map+import           Data.Monoid                ((<>))+import qualified Data.HashMap.Strict        as HashMap+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           Data.Avro.DecodeRaw+import           Data.Avro.Zag+import           Data.Avro.Schema as S+import qualified Data.Avro.Types as T++-- |Decode bytes into a 'Value' as described by Schema.+decodeAvro :: Schema -> BL.ByteString -> Either String (T.Value Type)+decodeAvro sch = either (\(_,_,s) -> Left s) (\(_,_,a) -> Right a) . runGetOrFail (getAvroOf sch)+{-# INLINABLE decodeAvro #-}++decodeContainer :: BL.ByteString -> Either String (Schema, [[T.Value Type]])+decodeContainer = decodeContainerWith getAvroOf+{-# INLINABLE decodeContainer #-}++decodeContainerWith :: (Schema -> Get a)+                    -> BL.ByteString+                    -> Either String (Schema, [[a]])+decodeContainerWith schemaToGet bs =+  case runGetOrFail (getContainerWith schemaToGet) bs of+    Right (_,_,a) -> Right a+    Left (_,_,s)  -> Left s+{-# INLINABLE decodeContainerWith #-}++data ContainerHeader = ContainerHeader+                      { syncBytes       :: !BL.ByteString+                      , decompress      :: BL.ByteString -> Get BL.ByteString+                      , containedSchema :: !Schema+                      }++nrSyncBytes :: Integral sb => sb+nrSyncBytes = 16++instance GetAvro ContainerHeader where+  getAvro =+   do magic <- getFixed avroMagicSize+      when (BL.fromStrict magic /= avroMagicBytes)+           (fail "Invalid magic number at start of container.")+      metadata <- getMap :: Get (Map.Map Text BL.ByteString) -- avro.schema, avro.codec+      sync  <- BL.fromStrict <$> getFixed nrSyncBytes+      codec <- getCodec (Map.lookup "avro.codec" metadata)+      schema <- case Map.lookup "avro.schema" metadata of+                  Nothing -> fail "Invalid container object: no schema."+                  Just s  -> case A.eitherDecode' s of+                                Left e  -> fail ("Can not decode container schema: " <> e)+                                Right x -> return x+      return ContainerHeader { syncBytes = sync, decompress = codec, containedSchema = schema }+   where avroMagicSize :: Integral a => a+         avroMagicSize = 4++         avroMagicBytes :: BL.ByteString+         avroMagicBytes = BC.pack "Obj" <> BL.pack [1]++         getFixed :: Int -> Get ByteString+         getFixed = G.getByteString+++getContainerWith :: (Schema -> Get a) -> Get (Schema, [[a]])+getContainerWith schemaToGet =+   do ContainerHeader {..} <- getAvro+      (containedSchema,) <$> getBlocks (schemaToGet containedSchema) syncBytes decompress+  where+  getBlocks :: Get a -> BL.ByteString -> (BL.ByteString -> Get BL.ByteString) -> Get [[a]]+  getBlocks getValue sync decompress =+   do nrObj    <- sFromIntegral =<< getLong+      nrBytes  <- getLong+      bytes    <- decompress =<< G.getLazyByteString nrBytes+      r        <- case runGetOrFail (replicateM nrObj getValue) bytes of+                    Right (_,_,x) -> return x+                    Left (_,_,s)  -> fail s+      marker   <- G.getLazyByteString nrSyncBytes+      when (marker /= sync) (fail "Invalid marker, does not match sync bytes.")+      e <- G.isEmpty+      if e+        then return [r]+        else (r :) <$> getBlocks getValue sync decompress++getCodec :: Monad m => Maybe BL.ByteString -> m (BL.ByteString -> m BL.ByteString)+getCodec code | Just "null"    <- code =+                     return return+              | Just "deflate" <- code =+                     return (either (fail . show) return . Z.decompress)+              | Just x <- code =+                     fail ("Unrecognized codec: " <> BC.unpack x)+              | otherwise = return return++{-# INLINABLE getAvroOf #-}+getAvroOf :: Schema -> Get (T.Value Type)+getAvroOf ty0 = go ty0+ where+ env = S.buildTypeEnvironment envFail ty0+ envFail t = fail $ "Named type not in schema: " <> show t++ go :: Type -> Get (T.Value Type)+ go ty =+  case ty of+    Null    -> return T.Null+    Boolean -> T.Boolean <$> getAvro+    Int     -> T.Int     <$> getAvro+    Long    -> T.Long    <$> getAvro+    Float   -> T.Float   <$> getAvro+    Double  -> T.Double  <$> getAvro+    Bytes   -> T.Bytes   <$> getAvro+    String  -> T.String  <$> getAvro+    Array t ->+      do vals <- getBlocksOf t+         return $ T.Array (V.fromList $ mconcat vals)+    Map  t  ->+      do kvs <- getKVBlocks t+         return $ T.Map (HashMap.fromList $ mconcat kvs)+    NamedType tn -> env tn >>= go+    Record {..} ->+      do let getField Field {..} = (fldName,) <$> go fldType+         T.Record ty . HashMap.fromList <$> mapM getField fields+    Enum {..} ->+      do val <- getLong+         let sym = fromMaybe "" (symbolLookup val) -- empty string for 'missing' symbols (alternative is an error or exception)+         pure (T.Enum ty (fromIntegral val) sym)+    Union ts unionLookup ->+      do i <- getLong+         case unionLookup i of+          Nothing -> fail $ "Decoded Avro tag is outside the expected range for a Union. Tag: " <> show i <> " union of: " <> show (P.map typeName $ NE.toList ts)+          Just t  -> T.Union ts t <$> go t+    Fixed {..} -> T.Fixed <$> G.getByteString (fromIntegral size)++ getKVBlocks :: Type -> Get [[(Text,T.Value Type)]]+ getKVBlocks t =+  do blockLength <- abs <$> getLong+     if blockLength == 0+      then return []+      else do vs <- replicateM (fromIntegral blockLength) ((,) <$> getString <*> go t)+              (vs:) <$> getKVBlocks t+ {-# INLINE getKVBlocks #-}++ getBlocksOf :: Type -> Get [[T.Value Type]]+ getBlocksOf t =+  do blockLength <- abs <$> getLong+     if blockLength == 0+      then return []+      else do vs <- replicateM (fromIntegral blockLength) (go t)+              (vs:) <$> getBlocksOf t+ {-# INLINE getBlocksOf #-}++class GetAvro a where+  getAvro :: Get a++instance GetAvro ty => GetAvro (Map.Map Text ty) where+  getAvro = getMap+instance GetAvro Bool where+  getAvro = getBoolean+instance GetAvro Int32 where+  getAvro = getInt+instance GetAvro Int64 where+  getAvro = getLong+instance GetAvro BL.ByteString where+  getAvro = BL.fromStrict <$> getBytes+instance GetAvro ByteString where+  getAvro = getBytes+instance GetAvro Text where+  getAvro = getString+instance GetAvro Float where+  getAvro = getFloat+instance GetAvro Double where+  getAvro = getDouble+instance GetAvro String where+  getAvro = Text.unpack <$> getString+instance GetAvro a => GetAvro [a] where+  getAvro = getArray+instance GetAvro a => GetAvro (Maybe a) where+  getAvro =+    do t <- getLong+       case t of+        0 -> return Nothing+        1 -> Just <$> getAvro+        n -> fail $ "Invalid tag for expected {null,a} Avro union, received: " <> show n++instance GetAvro a => GetAvro (Array.Array Int a) where+  getAvro =+    do ls <- getAvro+       return $ Array.listArray (0,length ls - 1) ls+instance GetAvro a => GetAvro (V.Vector a) where+  getAvro = V.fromList <$> getAvro+instance (GetAvro a, Ord a) => GetAvro (Set.Set a) where+  getAvro = Set.fromList <$> getAvro++--------------------------------------------------------------------------------+--  Specialized Getters++getBoolean :: Get Bool+getBoolean =+ do w <- G.getWord8+    return (w == 0x01)++-- |Get a 32-bit int (zigzag encoded, max of 5 bytes)+getInt :: Get Int32+getInt = getZigZag++-- |Get a 64 bit int (zigzag encoded, max of 10 bytes)+getLong :: Get Int64+getLong = getZigZag++-- |Get an zigzag encoded integral value consuming bytes till the msb is 0.+getZigZag :: (Bits i, Integral i, DecodeRaw i) => Get i+getZigZag = decodeRaw++getBytes :: Get ByteString+getBytes =+ do w <- getLong+    G.getByteString (fromIntegral w)++getString :: Get Text+getString = Text.decodeUtf8 <$> getBytes++-- a la Java:+--  Bit 31 (the bit that is selected by the mask 0x80000000) represents the+--  sign of the floating-point number. Bits 30-23 (the bits that are+--  selected by the mask 0x7f800000) represent the exponent. Bits 22-0 (the+--  bits that are selected by the mask 0x007fffff) represent the+--  significand (sometimes called the mantissa) of the floating-point+--  number.+--+--  If the argument is positive infinity, the result is 0x7f800000.+--+--  If the argument is negative infinity, the result is 0xff800000.+--+--  If the argument is NaN, the result is 0x7fc00000.+getFloat :: Get Float+getFloat = IEEE.wordToFloat <$> G.getWord32le++-- As in Java:+--  Bit 63 (the bit that is selected by the mask 0x8000000000000000L)+--  represents the sign of the floating-point number. Bits 62-52 (the bits+--  that are selected by the mask 0x7ff0000000000000L) represent the+--  exponent. Bits 51-0 (the bits that are selected by the mask+--  0x000fffffffffffffL) represent the significand (sometimes called the+--  mantissa) of the floating-point number.+--+--  If the argument is positive infinity, the result is+--  0x7ff0000000000000L.+--+--  If the argument is negative infinity, the result is+--  0xfff0000000000000L.+--+--  If the argument is NaN, the result is 0x7ff8000000000000L+getDouble :: Get Double+getDouble = IEEE.wordToDouble <$> G.getWord64le++--------------------------------------------------------------------------------+--  Complex AvroValue Getters++-- getRecord :: GetAvro ty => Get (AvroValue ty)+-- 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++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++-- Safe-ish from integral+sFromIntegral :: forall a b m. (Monad m, Bounded a, Bounded b, Integral a, Integral b) => a -> m b+sFromIntegral a+  | aI > fromIntegral (maxBound :: b) ||+    aI < fromIntegral (minBound :: b)   = fail "Integral overflow."+  | otherwise                           = return (fromIntegral a)+ where aI = fromIntegral a :: Integer
+ src/Data/Avro/DecodeRaw.hs view
@@ -0,0 +1,65 @@+module Data.Avro.DecodeRaw+  ( DecodeRaw(..)+  ) where++import Data.Avro.Zag+import Data.Binary.Get+import Data.Bits+import Data.Int+import Data.List+import Data.Word++getNonNegative :: (Bits i, Integral i) => Get i+getNonNegative = do+  orig <- getWord8s+  return (foldl' (\a x -> (a `shiftL` 7) + fromIntegral x) 0 (reverse orig))++getWord8s :: Get [Word8]+getWord8s = do+  w <- getWord8+  let msb = w `testBit` 7 in (w .&. 0x7F :) <$> if msb+    then getWord8s+    else return []++class DecodeRaw a where+  decodeRaw :: Get a++instance DecodeRaw Word where+  decodeRaw = getNonNegative+  {-# INLINE decodeRaw #-}++instance DecodeRaw Word8 where+  decodeRaw = getNonNegative+  {-# INLINE decodeRaw #-}++instance DecodeRaw Word16 where+  decodeRaw = getNonNegative+  {-# INLINE decodeRaw #-}++instance DecodeRaw Word32 where+  decodeRaw = getNonNegative+  {-# INLINE decodeRaw #-}++instance DecodeRaw Word64 where+  decodeRaw = getNonNegative+  {-# INLINE decodeRaw #-}++instance DecodeRaw Int where+  decodeRaw = zag <$> (decodeRaw :: Get Word)+  {-# INLINE decodeRaw #-}++instance DecodeRaw Int8 where+  decodeRaw = zag <$> (decodeRaw :: Get Word8)+  {-# INLINE decodeRaw #-}++instance DecodeRaw Int16 where+  decodeRaw = zag <$> (decodeRaw :: Get Word16)+  {-# INLINE decodeRaw #-}++instance DecodeRaw Int32 where+  decodeRaw = zag <$> (decodeRaw :: Get Word32)+  {-# INLINE decodeRaw #-}++instance DecodeRaw Int64 where+  decodeRaw = zag <$> (decodeRaw :: Get Word64)+  {-# INLINE decodeRaw #-}
+ src/Data/Avro/Deconflict.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE TupleSections #-}+module Data.Avro.Deconflict+  ( deconflict+  ) where++import           Data.Avro.Schema    as S+import           Data.Avro.Types     as T+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.List.NonEmpty as NE+import           Data.List.NonEmpty (NonEmpty(..))+import           Data.Text           (Text)+import qualified Data.Text           as Text+import qualified Data.Text.Encoding  as Text++-- | @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 :: Schema -> Schema -> T.Value Type -> Either String (T.Value Type)+deconflict writerType readerType val =+  resolveSchema writerType readerType val++resolveSchema :: Type -> Type -> T.Value Type -> Either String (T.Value Type)+resolveSchema e d v+  | e == d    = Right v+  | otherwise = go e d v+  where+  go :: Type -> Type -> T.Value Type -> Either String (T.Value Type)+  go (S.Array aTy) (S.Array bTy) (T.Array vec) =+       T.Array <$> mapM (go aTy bTy) vec+  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+  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+  go nonUnion (S.Union ys _) val =+       resolveReaderUnion nonUnion ys val+  go (S.Union _xs _) nonUnion val =+       resolveWriterUnion 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.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.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+  -- --  | 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++resolveReaderUnion :: Type -> NonEmpty Type -> T.Value Type -> Either String (T.Value Type)+resolveReaderUnion e ds 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)+                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++resolveRecord :: Type -> Type -> T.Value Type -> Either String (T.Value Type)+resolveRecord eRec dRec (T.Record ty fldVals)  =+ T.Record ty . HashMap.fromList <$> mapM (resolveFields fldVals (fields eRec)) (fields dRec)++-- For each field of the decoders, lookup the field in the hash map+--  1) If the field exists, call 'resolveSchema'+--  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 eFlds d =+  case (HashMap.lookup (fldName d) hm, fldDefault d) of+    (Just x,_)        -> Right (fldName d, x)+    (_,Just def)      -> Right (fldName d,def)+    (Nothing,Nothing) -> Left $ "No field and no default for " ++ show (fldName d)
+ src/Data/Avro/Deriving.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE OverloadedStrings     #-}++module Data.Avro.Deriving+( deriveAvro+, deriveAvro'+, deriveFromAvro+)+where++import           Control.Monad              (join)+import           Data.Aeson                 (eitherDecode)+import           Data.Char                  (isAlphaNum)+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           Data.Int+import           Data.List.NonEmpty         (NonEmpty( (:|) ))+import           Data.Map                   (Map)+import           Data.Maybe                 (fromMaybe)+import           Data.Semigroup             ((<>))+import           Language.Haskell.TH        as TH+import           Language.Haskell.TH.Syntax++import Data.Avro.Deriving.NormSchema++import qualified Data.ByteString.Lazy       as LBS+import qualified Data.ByteString.Lazy.Char8 as LBSC8+import           Data.Text                  (Text)+import qualified Data.Text                  as T++-- | Derives Avro from a given schema file.+-- Generates data types, FromAvro and ToAvro instances.+deriveAvro :: FilePath -> Q [Dec]+deriveAvro p = readSchema p >>= deriveAvro'++deriveAvro' :: Schema -> Q [Dec]+deriveAvro' s = do+  let schemas = extractDerivables s+  types <- traverse genType schemas+  fromAvros <- traverse genFromAvro schemas+  toAvros <- traverse genToAvro schemas+  pure $ join types <> join fromAvros <> join toAvros++-- | Derives "read only" Avro from a given schema file.+-- Generates data types and FromAvro.+deriveFromAvro :: FilePath -> Q [Dec]+deriveFromAvro p = do+  schemas <- extractDerivables <$> readSchema p+  types <- traverse genType schemas+  fromAvros <- traverse genFromAvro schemas+  pure $ join types <> join fromAvros++readSchema :: FilePath -> Q Schema+readSchema p = do+  qAddDependentFile p+  mbSchema <- runIO $ decodeSchema p+  case mbSchema of+    Left err     -> fail $ "Unable to generate AVRO for " <> p <> ": " <> err+    Right sch    -> pure sch++genFromAvro :: Schema -> Q [Dec]+genFromAvro (S.Enum n _ _ _ _ _) =+  [d| instance FromAvro $(conT $ mkDataTypeName n) where+        fromAvro (AT.Enum _ i _) = $([| pure . toEnum|]) i+        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value+  |]+genFromAvro (S.Record n _ _ _ _ fs) =+  [d| instance FromAvro $(conT $ mkDataTypeName n) where+        fromAvro (AT.Record _ r) = $(genFromAvroFieldsExp (mkTextName $ unTN n) fs) r+        fromAvro value           = $( [|\v -> badValue v $(mkTextLit $ unTN n)|] ) value+  |]+genFromAvro _                             = pure []++genFromAvroFieldsExp :: Name -> [Field] -> Q Exp+genFromAvroFieldsExp 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+     )+  |]++genToAvro :: Schema -> Q [Dec]+genToAvro s@(Enum n _ _ _ vs _) = do+  let sname = mkSchemaValueName n+  sdef <- schemaDef sname s+  idef <- toAvroInstance sname+  pure (sdef <> idef)+  where+    conP' = flip conP [] . mkAdtCtorName n+    toAvroInstance sname =+      [d| instance ToAvro $(conT $ mkDataTypeName n) where+            schema = pure $(varE sname)+            toAvro = $([| \x ->+              let convert = AT.Enum $(varE sname) (fromEnum $([|x|]))+              in $(caseE [|x|] ((\v -> match (conP' v)+                               (normalB [| convert (T.pack $(mkTextLit v))|]) []) <$> vs))+              |])+      |]++genToAvro s@(Record n _ _ _ _ fs) = do+  let sname = mkSchemaValueName n+  sdef <- schemaDef sname s+  idef <- toAvroInstance sname+  pure (sdef <> idef)+  where+    toAvroInstance sname =+      [d| instance ToAvro $(conT $ mkDataTypeName n) where+            toAvro = $(genToAvroFieldsExp sname)+            schema = pure $(varE sname)+      |]+    genToAvroFieldsExp sname = [| \r -> record $(varE sname)+        $(let assign fld = [| T.pack $(mkTextLit (fldName fld)) .= $(varE $ mkFieldTextName n fld) r |]+          in listE $ assign <$> fs+        )+      |]++schemaDef :: Name -> Schema -> Q [Dec]+schemaDef sname sch = setName sname $+  [d|+      x :: Schema+      x = fromMaybe undefined (J.decode (LBSC8.pack $(mkLit (LBSC8.unpack $ J.encode sch))))+  |]++-- | A hack around TemplateHaskell limitation:+-- It is currently not possible to splice variable name in QQ.+-- This function allows to replace hardcoded name into the specified one.+setName :: Name -> Q [Dec] -> Q [Dec]+setName = fmap . map . sn+  where+    sn n (SigD _ t) = SigD n t+    sn n (ValD (VarP _) x y) = ValD (VarP n) x y+    sn _ d = d++genType :: Schema -> Q [Dec]+genType (S.Record n _ _ _ _ fs) = do+  flds <- traverse (mkField n) fs+  let dname = mkDataTypeName n+  sequenceA [genDataType dname flds]+genType (S.Enum n _ _ _ vs _) = do+  let dname = mkDataTypeName n+  sequenceA [genEnum dname (mkAdtCtorName n <$> vs)]+genType _ = pure []++mkFieldTypeName :: S.Type -> Q TH.Type+mkFieldTypeName t = case t of+  S.Boolean                     -> [t| Bool |]+  S.Long                        -> [t| Int64 |]+  S.Int                         -> [t| Int |]+  S.Float                       -> [t| Float |]+  S.Double                      -> [t| Double |]+  S.Bytes                       -> [t| ByteString |]+  S.String                      -> [t| Text |]+  S.Union (Null :| [x]) _       -> [t| Maybe $(mkFieldTypeName x) |] -- AppT (ConT $ mkName "Maybe") (mkFieldTypeName x)+  S.Union (x :| [Null]) _       -> [t| Maybe $(mkFieldTypeName x) |] --AppT (ConT $ mkName "Maybe") (mkFieldTypeName x)+  S.Union (x :| [y]) _          -> [t| Either $(mkFieldTypeName x) $(mkFieldTypeName y) |] -- AppT (AppT (ConT (mkName "Either")) (mkFieldTypeName x)) (mkFieldTypeName y)+  S.Union (_ :| _) _            -> error "Unions with more than 2 elements are not yet supported"+  S.Record n _ _ _ _ _          -> [t| $(conT $ mkDataTypeName n) |]+  S.Map x                       -> [t| Map Text $(mkFieldTypeName x) |] --AppT (AppT (ConT (mkName "Map")) (ConT $ mkName "Text")) (mkFieldTypeName x)+  S.Array x                     -> [t| [$(mkFieldTypeName x)] |]--AppT (ConT $ Text "[]") (mkFieldTypeName x)+  S.NamedType n                 -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x+  S.Fixed n _ _ _               -> [t| $(conT $ mkDataTypeName n)|] --ConT . mkName . T.unpack . mkDataTypeName $ x+  S.Enum n _ _ _ _ _            -> [t| $(conT $ mkDataTypeName n)|]+  _                             -> error $ "Avro type is not supported: " <> show t++updateFirst :: (Text -> Text) -> Text -> Text+updateFirst f t =+  let (l, ls) = T.splitAt 1 t+  in f l <> ls++decodeSchema :: FilePath -> IO (Either String Schema)+decodeSchema p = eitherDecode <$> LBS.readFile p++mkAdtCtorName :: TypeName -> Text -> Name+mkAdtCtorName prefix nm =+  concatNames (mkDataTypeName prefix) (mkDataTypeName' nm)++concatNames :: Name -> Name -> Name+concatNames a b = mkName $ nameBase a <> nameBase b++sanitiseName :: Text -> Text+sanitiseName =+  let valid c = isAlphaNum c || c == '\'' || c == '_'+  in T.concat . T.split (not . valid)++mkSchemaValueName :: TypeName -> Name+mkSchemaValueName (TN n) = mkTextName $ "schema'" <> n++mkDataTypeName :: TypeName -> Name+mkDataTypeName = mkDataTypeName' . unTN++mkDataTypeName' :: Text -> Name+mkDataTypeName' =+  mkTextName . sanitiseName . updateFirst T.toUpper . T.takeWhileEnd (/='.')++mkFieldTextName :: TypeName -> Field -> Name+mkFieldTextName (TN dn) fld = mkTextName . sanitiseName $+  updateFirst T.toLower dn <> updateFirst T.toUpper (fldName fld)++mkField :: TypeName -> Field -> Q VarStrictType+mkField prefix field = do+  ftype <- mkFieldTypeName (fldType field)+  let fName = mkFieldTextName prefix field+  pure (fName, defaultStrictness, ftype)++genEnum :: Name -> [Name] -> Q Dec+#if MIN_VERSION_template_haskell(2,12,0)+genEnum dn vs = do+  ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]]+  pure $ DataD [] dn [] Nothing ((\n -> NormalC n []) <$> vs) [DerivClause Nothing ders]+#elif MIN_VERSION_template_haskell(2,11,0)+genEnum dn vs = do+  ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]]+  pure $ DataD [] dn [] Nothing ((\n -> NormalC n []) <$> vs) ders+#else+genEnum dn vs = do+  [ConT eq, ConT sh, ConT or, ConT en] <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|]]+  pure $ DataD [] dn [] ((\n -> NormalC n []) <$> vs) [eq, sh, or, en]+#endif++genDataType :: Name -> [VarStrictType] -> Q Dec+#if MIN_VERSION_template_haskell(2,12,0)+genDataType dn flds = do+  ders <- sequenceA [[t|Eq|], [t|Show|]]+  pure $ DataD [] dn [] Nothing [RecC dn flds] [DerivClause Nothing ders]+#elif MIN_VERSION_template_haskell(2,11,0)+genDataType dn flds = do+  ders <- sequenceA [[t|Eq|], [t|Show|]]+  pure $ DataD [] dn [] Nothing [RecC dn flds] ders+#else+genDataType dn flds = do+  [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|]]+  pure $ DataD [] dn [] [RecC dn flds] [eq, sh]+#endif++defaultStrictness :: Strict+#if MIN_VERSION_template_haskell(2,11,0)+defaultStrictness = Bang SourceNoUnpack NoSourceStrictness+#else+defaultStrictness = NotStrict+#endif++mkTextName :: Text -> Name+mkTextName = mkName . T.unpack++mkLit :: String -> ExpQ+mkLit = litE . StringL++mkTextLit :: Text -> ExpQ+mkTextLit = litE . StringL . T.unpack
+ src/Data/Avro/Deriving/NormSchema.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings     #-}+module Data.Avro.Deriving.NormSchema+where++import           Data.Avro.Schema+import qualified Data.Set as S+import           Data.List.NonEmpty         (NonEmpty( (:|) ))+import           Control.Monad.State.Strict+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.List as L+import           Data.Maybe (catMaybes, fromMaybe)+import           Data.Semigroup ((<>))++-- | Extracts all the records from the schema (flattens the schema)+-- Named types get resolved when needed to include at least one "inlined"+-- schema in each record and to make each record self-contained.+-- Note: Namespaces are not really supported in this version. All the+-- namespaces (including inlined into full names) will be ignored+-- during names resolution.+extractDerivables :: Schema -> [Schema]+extractDerivables s = flip evalState S.empty . normSchema rawRecs <$> rawRecs+  where+    rawRecs = getTypes s+    getTypes rec = case rec of+      r@(Record _ _ _ _ _ fs) -> r : (fs >>= (getTypes . fldType))+      Array t                 -> getTypes t+      Union (t1 :| ts) _      -> getTypes t1 <> concatMap getTypes ts+      Map t                   -> getTypes t+      e@Enum{}                -> [e]+      _                       -> []++-- TODO: Currently ensures normalisation: only in one way+-- that is needed for "extractRecord".+-- it ensures that an "extracted" record is self-contained and+-- all the named types are resolvable within the scope of the schema.+-- The other way around (to each record is inlined only once and is referenced+-- as a named type after that) is not implemented.+normSchema :: [Schema] -- ^ List of all possible records+           -> Schema   -- ^ Schema to normalise+           -> State (S.Set TypeName) Schema+normSchema rs r = case r of+  t@(NamedType tn) -> do+    let sn = shortName tn+    resolved <- get+    if S.member sn resolved+      then pure t+      else do+        modify' (S.insert sn)+        pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn)+  Array s   -> Array <$> normSchema rs s+  Map s     -> Map <$> normSchema rs s+  Record{name = tn}  -> do+    let sn = shortName tn+    modify' (S.insert sn)+    flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r)+    pure $ r { fields = flds }+  s         -> pure s+  where+    shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn)+    setType fld t = fld { fldType = t}+    fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s)+    findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs
+ src/Data/Avro/Encode.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeFamilies         #-}++module Data.Avro.Encode+  ( -- * High level interface+    getSchema+  , encodeAvro+  , encodeContainer, encodeContainerWithSync+  -- * Lower level interface+  , EncodeAvro(..)+  , Zag(..)+  , putAvro+  ) where++import Prelude as P+import qualified Data.Aeson as A+import qualified Data.Array              as Ar+import           Data.Ix                 (Ix)+import           Data.Bits+import           Data.ByteString.Lazy    as BL+import qualified Data.Binary.IEEE754     as IEEE+import           Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString         as B+import           Data.ByteString.Builder+import qualified Data.Foldable           as F+import           Data.HashMap.Strict     (HashMap)+import qualified Data.HashMap.Strict     as HashMap+import           Data.Int+import           Data.List               as DL+import           Data.List.NonEmpty      (NonEmpty(..))+import qualified Data.List.NonEmpty      as NE+import           Data.Monoid+import           Data.Maybe              (catMaybes, mapMaybe)+import qualified Data.Set                as S+import           Data.Text               (Text)+import qualified Data.Text               as T+import qualified Data.Text.Encoding      as T+import qualified Data.Text.Lazy          as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Vector             as V+import qualified Data.Vector.Unboxed     as U+import           Data.Word+import           Data.Proxy+import           System.Entropy (getEntropy)++import Data.Avro.EncodeRaw+import Data.Avro.Schema as S+import Data.Avro.Types  as T+import Data.Avro.Zag+import Data.Avro.Zig++encodeAvro :: EncodeAvro a => a -> BL.ByteString+encodeAvro = toLazyByteString . putAvro++-- |Encode chunks of objects into a container, using 16 random bytes for+-- the synchronization markers.+encodeContainer :: EncodeAvro a => [[a]] -> IO BL.ByteString+encodeContainer xss =+  do sync <- getEntropy 16+     return $ encodeContainerWithSync (BL.fromStrict sync) xss++-- |Encode chunks of objects into a container, using the provided+-- ByteString as the synchronization markers.+encodeContainerWithSync :: EncodeAvro a => BL.ByteString -> [[a]] -> BL.ByteString+encodeContainerWithSync syncBytes xss =+ toLazyByteString $+  lazyByteString avroMagicBytes <>+  putAvro (HashMap.fromList [("avro.schema", A.encode objSchema), ("avro.codec","null")] :: HashMap Text BL.ByteString) <>+  lazyByteString syncBytes <>+  foldMap putBlocks xss+ where+  objSchema    = getSchema (P.head (P.head xss))+  putBlocks ys =+    let nrObj    = P.length ys+        nrBytes  = BL.length theBytes+        theBytes = toLazyByteString $ foldMap putAvro ys+    in putAvro nrObj <>+       putAvro nrBytes <>+       lazyByteString theBytes <>+       lazyByteString syncBytes+  avroMagicBytes :: BL.ByteString+  avroMagicBytes = "Obj" <> BL.pack [1]++-- XXX make an instance 'EncodeAvro Schema'+-- Would require a schema schema...+-- encodeSchema :: EncodeAvro a => a -> BL.ByteString+-- encodeSchema = toLazyByteString . putAvro . getSchema++putAvro :: EncodeAvro a => a -> Builder+putAvro   = fst . runAvro . avro++getSchema :: forall a. EncodeAvro a => a -> Schema+getSchema _ = getType (Proxy :: Proxy a)++getType :: EncodeAvro a => Proxy a -> Type+getType p = snd (runAvro (avro (undefined `asProxyTypeOf` p)))+-- N.B. ^^^ Local knowledge that 'fst' won't be used,+-- so the bottom of 'undefined' will not escape so long as schema creation+-- remains lazy in the argument.++newtype AvroM = AvroM { runAvro :: (Builder,Type) }++class EncodeAvro a where+  avro :: a -> AvroM++-- class PutAvro a where+--   putAvro :: a -> Builder++avroInt :: forall a. (FiniteBits a, Integral a, EncodeRaw a) => a -> AvroM+avroInt n = AvroM (encodeRaw n, S.Int)++avroLong :: forall a. (FiniteBits a, Integral a, EncodeRaw a) => a -> AvroM+avroLong n = AvroM (encodeRaw n, S.Long)++-- Put a Haskell Int.+putI :: Int -> Builder+putI = encodeRaw++instance EncodeAvro Int  where+  avro = avroInt+instance EncodeAvro Int8  where+  avro = avroInt+instance EncodeAvro Int16  where+  avro = avroInt+instance EncodeAvro Int32  where+  avro = avroInt+instance EncodeAvro Int64  where+  avro = avroInt+instance EncodeAvro Word8 where+  avro = avroInt+instance EncodeAvro Word16 where+  avro = avroInt+instance EncodeAvro Word32 where+  avro = avroLong+instance EncodeAvro Word64 where+  avro = avroLong+instance EncodeAvro Text where+  avro t =+    let bs = T.encodeUtf8 t+    in AvroM (encodeRaw (B.length bs) <> byteString bs, S.String)+instance EncodeAvro TL.Text where+  avro t =+    let bs = TL.encodeUtf8 t+    in AvroM (encodeRaw (BL.length bs) <> lazyByteString bs, S.String)++instance EncodeAvro ByteString where+  avro bs = AvroM (encodeRaw (BL.length bs) <> lazyByteString bs, S.Bytes)++instance EncodeAvro B.ByteString where+  avro bs = AvroM (encodeRaw (B.length bs) <> byteString bs, S.Bytes)++instance EncodeAvro String where+  avro s = let t = T.pack s in avro t++instance EncodeAvro Double where+  avro d = AvroM (word64LE (IEEE.doubleToWord d), S.Double)++instance EncodeAvro Float where+  avro d = AvroM (word32LE (IEEE.floatToWord d), S.Float)++-- Terminating word for array and map types.+long0 :: Builder+long0 = encodeRaw (0 :: Word64)++instance EncodeAvro a => EncodeAvro [a] where+  avro a = AvroM ( if DL.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0+                  , S.Array (getType (Proxy :: Proxy a))+                  )++instance (Ix i, EncodeAvro a) => EncodeAvro (Ar.Array i a) where+  avro a = AvroM ( if F.length a == 0 then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0+                 , S.Array (getType (Proxy :: Proxy a))+                 )+instance EncodeAvro a => EncodeAvro (V.Vector a) where+  avro a = AvroM ( if V.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0+                 , S.Array (getType (Proxy :: Proxy a))+                 )+instance (U.Unbox a, EncodeAvro a) => EncodeAvro (U.Vector a) where+  avro a = AvroM ( if U.null a then long0 else encodeRaw (U.length a) <> foldMap putAvro (U.toList a) <> long0+                 , S.Array (getType (Proxy :: Proxy a))+                 )++instance EncodeAvro a => EncodeAvro (S.Set a) where+  avro a = AvroM ( if S.null a then long0 else encodeRaw (F.length a) <> foldMap putAvro a <> long0+                 , S.Array (getType (Proxy :: Proxy a))+                 )++instance EncodeAvro a => EncodeAvro (HashMap Text a) where+  avro hm = AvroM ( if HashMap.null hm then long0 else putI (F.length hm) <> foldMap putKV (HashMap.toList hm) <> long0+                  , S.Map (getType (Proxy :: Proxy a))+                  )+    where putKV (k,v) = putAvro k <> putAvro v++-- XXX more from containers+-- XXX Unordered containers++-- | Maybe is modeled as a sum type `{null, a}`.+instance EncodeAvro a => EncodeAvro (Maybe a) where+  avro Nothing  = AvroM (putI 0             , S.mkUnion (S.Null:|[S.Int]))+  avro (Just x) = AvroM (putI 1 <> putAvro x, S.mkUnion (S.Null:|[S.Int]))++instance EncodeAvro () where+  avro () = AvroM (mempty, S.Null)++instance EncodeAvro Bool where+  avro b = AvroM (word8 $ fromIntegral $ fromEnum b, S.Boolean)++--------------------------------------------------------------------------------+--  Common Intermediate Representation Encoding++instance EncodeAvro (T.Value Type) where+  avro v =+    case v of+      T.Null      -> avro ()+      T.Boolean b -> avro b+      T.Int i     -> avro i+      T.Long i    -> avro i+      T.Float f   -> avro f+      T.Double d  -> avro d+      T.Bytes bs  -> avro bs+      T.String t  -> avro t+      T.Array vec -> avro vec+      T.Map hm    -> avro hm+      T.Record ty hm ->+        let bs = foldMap putAvro (mapMaybe (`HashMap.lookup` hm) fs)+            fs = P.map fldName (fields ty)+        in AvroM (bs, ty)+      T.Union opts sel val | F.length opts > 0 ->+        case DL.elemIndex sel (NE.toList opts) of+          Just idx -> AvroM (putI idx <> putAvro val, S.mkUnion opts)+          Nothing  -> error "Union encoding specifies type not found in schema"+      T.Fixed bs  -> avro bs+      T.Enum sch@S.Enum{..} ix t -> AvroM (putI ix, sch)
+ src/Data/Avro/EncodeRaw.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE ScopedTypeVariables  #-}++module Data.Avro.EncodeRaw+  ( EncodeRaw(..)+  ) where++import Data.Avro.Zig+import Data.Bits+import Data.ByteString.Builder+import Data.Int+import Data.Monoid+import Data.Word++putNonNegative :: forall a. (FiniteBits a, Integral a) => a -> Builder+putNonNegative n = if n .&. complement 0x7F == 0+  then word8 $ fromIntegral (n .&. 0x7f)+  else word8 (0x80 .|. (fromIntegral n .&. 0x7F)) <> putNonNegative (n `shiftR` 7)++class EncodeRaw a where+  encodeRaw :: a -> Builder++instance EncodeRaw Word where+  encodeRaw = putNonNegative+  {-# INLINE encodeRaw #-}++instance EncodeRaw Word8 where+  encodeRaw = putNonNegative+  {-# INLINE encodeRaw #-}++instance EncodeRaw Word16 where+  encodeRaw = putNonNegative+  {-# INLINE encodeRaw #-}++instance EncodeRaw Word32 where+  encodeRaw = putNonNegative+  {-# INLINE encodeRaw #-}++instance EncodeRaw Word64 where+  encodeRaw = putNonNegative+  {-# INLINE encodeRaw #-}++instance EncodeRaw Int where+  encodeRaw = encodeRaw . zig+  {-# INLINE encodeRaw #-}++instance EncodeRaw Int8 where+  encodeRaw = encodeRaw . zig+  {-# INLINE encodeRaw #-}++instance EncodeRaw Int16 where+  encodeRaw = encodeRaw . zig+  {-# INLINE encodeRaw #-}++instance EncodeRaw Int32 where+  encodeRaw = encodeRaw . zig+  {-# INLINE encodeRaw #-}++instance EncodeRaw Int64 where+  encodeRaw = encodeRaw . zig+  {-# INLINE encodeRaw #-}
+ src/Data/Avro/Schema.hs view
@@ -0,0 +1,521 @@+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RecordWildCards       #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Avro 'Schema's, represented here as values of type 'Schema',+-- describe the serialization and de-serialization of values.+--+-- In Avro schemas are compose-able such that encoding data under a schema and+-- decoding with a variant, such as newer or older version of the original+-- schema, can be accomplished by using the 'Data.Avro.Deconflict' module.+module Data.Avro.Schema+  (+   -- * Schema description types+    Schema, Type(..)+  , Field(..), Order(..)+  , TypeName(..)+  , mkEnum, mkUnion+  , validateSchema+  -- * Lower level utilities+  , typeName+  , buildTypeEnvironment+  , Result(..)+  ) where++import           Prelude as P+import           Control.Applicative+import           Control.Monad.Except+import           Control.Monad.State.Strict+import qualified Control.Monad.Fail as MF+import qualified Data.Aeson as A+import           Data.Aeson ((.=),object,(.:?),(.:),(.!=),FromJSON(..),ToJSON(..))+import           Data.Aeson.Types (Parser,typeMismatch)+import qualified Data.ByteString.Base16 as Base16+import qualified Data.HashMap.Strict as HashMap+import           Data.Hashable+import qualified Data.List as L+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import           Data.Maybe (catMaybes, fromMaybe)+import           Data.Monoid ((<>), First(..))+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 qualified Data.Avro.Types as Ty+import qualified Data.IntMap as IM+import Data.Int+import Text.Show.Functions++-- |An Avro schema is either+-- * A "JSON object in the form `{"type":"typeName" ...`+-- * A "JSON string, naming a defined type" (basic type w/o free variables/names)+-- * A "JSON array, representing a union"+--+-- N.B. It is possible to create a Haskell value (of Schema type) that is+-- not a valid Avro schema by violating one of the above or one of the+-- conditions called out in 'validateSchema'.+type Schema = Type++-- |Avro types are considered either primitive (string, int, etc) or+-- complex/declared (structures, unions etc).+data Type+      =+      -- Basic types+        Null+      | Boolean+      | Int   | Long+      | Float | Double+      | Bytes | String+      | Array { item :: Type }+      | Map   { values :: Type }+      | NamedType TypeName+      -- Declared types+      | Record { name      :: TypeName+               , namespace :: Maybe Text+               , aliases   :: [TypeName]+               , doc       :: Maybe Text+               , order     :: Maybe Order+               , fields    :: [Field]+               }+      | Enum { name      :: TypeName+             , namespace :: Maybe Text+             , aliases   :: [TypeName]+             , doc       :: Maybe Text+             , symbols   :: [Text]+             , symbolLookup :: Int64 -> Maybe Text+             }+      | Union { options  :: NonEmpty Type+              , unionLookup :: Int64 -> Maybe Type+              }+      | Fixed { name        :: TypeName+              , namespace   :: Maybe Text+              , aliases     :: [TypeName]+              , size        :: Integer+              }+    deriving (Show)++instance Eq Type where+  Null == Null = True+  Boolean == Boolean = True+  Int   == Int = True+  Long == Long = True+  Float == Float = True+  Double == Double = True+  Bytes == Bytes = True+  String == String = True+  Array ty == Array ty2 = ty == ty2+  Map ty == Map ty2 = ty == ty2+  NamedType t == NamedType t2 = t == t2+  Record _ _ _ _ _ fs == Record _ _ _ _ _ fs2 = fs == fs2+  Enum _ _ _ _ s _ == Enum _ _ _ _ s2 _ = s == s2+  Union a _ == Union b _ = a == b+  Fixed _ _ _ s == Fixed _ _ _ s2 = s == s2+  _ == _ = False++-- | @mkEnum name aliases namespace docs syms@ Constructs an `Enum` schema using+-- the enumeration type's name, aliases (if any), namespace, documentation, and list of+-- symbols that inhabit the enumeration.+mkEnum :: TypeName -> [TypeName] -> Maybe Text -> Maybe Text -> [Text] -> Type+mkEnum n as ns d ss = Enum n ns as d ss (\i -> IM.lookup (fromIntegral i) mp)+ where+ mp = IM.fromList (zip [0..] ss)++-- | @mkUnion subTypes@ Defines a union of the provided subTypes.  N.B. it is+-- invalid Avro to include another union or to have more than one of the same+-- type as a direct member of the union.  No check is done for this condition!+mkUnion :: NonEmpty Type -> Type+mkUnion os = Union os (\i -> IM.lookup (fromIntegral i) mp)+ where mp = IM.fromList (zip [0..] $ NE.toList os)++newtype TypeName = TN { unTN :: T.Text }+  deriving (Eq, Ord)++instance Show TypeName where+  show (TN s) = show s++instance Monoid TypeName where+  mempty = TN mempty+  mappend (TN a) (TN b) = TN (a <> b)++instance IsString TypeName where+  fromString = TN . fromString++instance Hashable TypeName where+  hashWithSalt s (TN t) = hashWithSalt (hashWithSalt s ("AvroTypeName" :: Text)) t++-- |Get the name of the type.  In the case of unions, get the name of the+-- first value in the union schema.+typeName :: Type -> Text+typeName bt =+  case bt of+    Null             -> "null"+    Boolean          -> "boolean"+    Int              -> "int"+    Long             -> "long"+    Float            -> "float"+    Double           -> "double"+    Bytes            -> "bytes"+    String           -> "string"+    Array _          -> "array"+    Map   _          -> "map"+    NamedType (TN t) -> t+    Union (x:|_) _   -> typeName x+    _                -> unTN $ name bt++data Field = Field { fldName       :: Text+                   , fldAliases    :: [Text]+                   , fldDoc        :: Maybe Text+                   , fldOrder      :: Maybe Order+                   , fldType       :: Type+                   , fldDefault    :: Maybe (Ty.Value Type)+                   }+  deriving (Eq, Show)++data Order = Ascending | Descending | Ignore+  deriving (Eq, Ord, Show)++instance FromJSON Type where+  parseJSON (A.String s) =+    case s of+      "null"     -> return Null+      "boolean"  -> return Boolean+      "int"      -> return Int+      "long"     -> return Long+      "float"    -> return Float+      "double"   -> return Double+      "bytes"    -> return Bytes+      "string"   -> return String+      somename   -> return (NamedType (TN somename))+  parseJSON (A.Object o) =+    do ty <- o .: ("type" :: Text)+       case ty of+        "map"    -> Map   <$> o .: ("values" :: Text)+        "array"  -> Array <$> o .: ("items"  :: Text)+        "record" ->+          Record <$> o .:  ("name" :: Text)+                 <*> o .:? ("namespace" :: Text)+                 <*> o .:? ("aliases" :: Text) .!= []+                 <*> o .:? ("doc" :: Text)+                 <*> o .:? ("order" :: Text) .!= Just Ascending+                 <*> o .:  ("fields" :: Text)+        "enum"   ->+          mkEnum <$> o .:  ("name" :: Text)+                 <*> o .:? ("aliases" :: Text)  .!= []+                 <*> o .:? ("namespace" :: Text)+                 <*> o .:? ("doc" :: Text)+                 <*> o .:  ("symbols" :: Text)+        "fixed"  ->+           Fixed <$> o .:  ("name" :: Text)+                 <*> o .:? ("namespace" :: Text)+                 <*> o .:? ("aliases" :: Text) .!= []+                 <*> o .:  ("size" :: Text)+        s  -> fail $ "Unrecognized object type: " <> s+  parseJSON (A.Array arr) | V.length arr > 0 =+           mkUnion . NE.fromList <$> mapM parseJSON (V.toList arr)+  parseJSON foo = typeMismatch "Invalid JSON for Avro Schema" foo++instance ToJSON Type where+  toJSON bt =+    case bt of+      Null     -> A.String "null"+      Boolean  -> A.String "boolean"+      Int      -> A.String "int"+      Long     -> A.String "long"+      Float    -> A.String "float"+      Double   -> A.String "double"+      Bytes    -> A.String "bytes"+      String   -> A.String "string"+      Array tn -> object [ "type" .= ("array" :: Text), "items" .= tn ]+      Map tn   -> object [ "type" .= ("map" :: Text), "values" .= tn ]+      NamedType (TN tn) -> A.String tn+      Record {..} ->+        let opts = catMaybes+               [ ("order" .=)     <$> order+               , ("namespace" .=) <$> namespace+               , ("doc" .=)       <$> doc+               ]+         in object $ opts +++               [ "type"      .= ("record" :: Text)+               , "name"      .= name+               , "aliases"   .= aliases+               , "fields"    .= fields+               ]+      Enum   {..} ->+        let opts = catMaybes+               [ ("namespace" .=) <$> namespace+               , ("doc" .=)       <$> doc+               ]+         in object $ opts +++               [ "type"      .= ("enum" :: Text)+               , "name"      .= name+               , "aliases"   .= aliases+               , "symbols"   .= symbols+               ]+      Union  {..} -> A.Array $ V.fromList $ P.map toJSON (NE.toList options)+      Fixed  {..} ->+        let opts = catMaybes+               [ ("namespace" .=) <$> namespace ]+         in object $ opts +++               [ "type"      .= ("fixed" :: Text)+               , "name"      .= name+               , "aliases"   .= aliases+               , "size"      .= size+               ]++instance ToJSON TypeName where+  toJSON (TN t) = A.String t++instance FromJSON TypeName where+  parseJSON (A.String s) = return (TN s)+  parseJSON j = typeMismatch "TypeName" j++instance FromJSON Field where+  parseJSON (A.Object o) =+    do nm  <- o .: "name"+       doc <- o .:? "doc"+       ty  <- o .: "type"+       let err = fail "Haskell Avro bindings does not support default for aliased or recursive types at this time."+       defM <- o .:? "default"+       def <- case parseAvroJSON err ty <$> defM of+                Just (Success x) -> return (Just x)+                Just (Error e)   -> fail e+                Nothing          -> return Nothing+       od  <- o .:? ("order" :: Text)    .!= Just Ascending+       al  <- o .:? ("aliases" :: Text)  .!= []+       return $ Field nm al doc od ty def++  parseJSON j = typeMismatch "Field " j++instance ToJSON Field where+  toJSON Field {..} =+    let opts = catMaybes+           [ ("order" .=)     <$> fldOrder+           , ("doc" .=)       <$> fldDoc+           , ("default" .=)   <$> fldDefault+           ]+     in object $ opts +++           [ "name"    .= fldName+           , "type"    .= fldType+           , "aliases" .= fldAliases+           ]++instance ToJSON (Ty.Value Type) where+  toJSON av =+    case av of+      Ty.Null              -> A.Null+      Ty.Boolean b         -> A.Bool b+      Ty.Int i             -> A.Number (fromIntegral i)+      Ty.Long i            -> A.Number (fromIntegral i)+      Ty.Float f           -> A.Number (realToFrac f)+      Ty.Double d          -> A.Number (realToFrac d)+      Ty.Bytes bs          -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs))+      Ty.String t          -> A.String t+      Ty.Array vec         -> A.Array (V.map toJSON vec)+      Ty.Map mp            -> A.Object (HashMap.map toJSON mp)+      Ty.Record _ flds     -> A.Object (HashMap.map toJSON flds)+      Ty.Union _ _ Ty.Null -> A.Null+      Ty.Union _ ty val    -> object [ typeName ty .= val ]+      Ty.Fixed bs          -> A.String ("\\u" <> T.decodeUtf8 (Base16.encode bs))  -- XXX the example wasn't literal - this should be an actual bytestring... somehow.+      Ty.Enum _ _ txt      -> A.String txt++data Result a = Success a | Error String+  deriving (Eq,Ord,Show)++instance Monad Result where+  return = pure+  Success a >>= k = k a+  Error e >>= _ = Error e+  fail = MF.fail+instance Functor Result where+  fmap f (Success x) = Success (f x)+  fmap _ (Error e)   = Error e+instance MF.MonadFail Result where+  fail = Error+instance MonadError String Result where+  throwError = fail+  catchError a@(Success _) _ = a+  catchError (Error e) k     = k e+instance Applicative Result where+  pure  = Success+  (<*>) = ap+instance Alternative Result where+  empty = mzero+  (<|>) = mplus+instance MonadPlus Result where+  mzero = fail "mzero"+  mplus a@(Success _) _ = a+  mplus _ b = b+instance Monoid (Result a) where+  mempty = fail "Empty Result"+  mappend = mplus+instance Foldable Result where+  foldMap _ (Error _)   = mempty+  foldMap f (Success y) = f y+  foldr _ z (Error _)   = z+  foldr f z (Success y) = f y z+instance Traversable Result where+  traverse _ (Error err) = pure (Error err)+  traverse f (Success v) = Success <$> f v++-- |Parse JSON-encoded avro data.+parseAvroJSON :: (Text -> Maybe Type) -> Type -> A.Value -> Result (Ty.Value Type)+parseAvroJSON env (NamedType (TN tn)) av =+  case env tn of+    Nothing -> fail $ "Could not resolve type name for " <> show tn+    Just t  -> parseAvroJSON env t av+parseAvroJSON env ty av =+    case av of+      A.String s     ->+        case ty of+          String    -> return $ Ty.String s+          Enum {..} ->+              if s `elem` symbols+                then return $ Ty.Enum ty (maybe (error "IMPOSSIBLE BUG") id $ lookup s (zip symbols [0..])) s+                else fail $ "JSON string is not one of the expected symbols for enum '" <> show name <> "': " <> T.unpack s+          Union tys _ -> do+            f <- tryAllTypes env tys av+            maybe (fail $ "No match for String in union '" <> show (typeName ty) <> "'.") pure f+          _ -> avroTypeMismatch ty "string"+      A.Bool b       -> case ty of+                          Boolean -> return $ Ty.Boolean b+                          _       -> avroTypeMismatch ty "boolean"+      A.Number i     ->+        case ty of+          Int    -> return $ Ty.Int    (floor i)+          Long   -> return $ Ty.Long   (floor i)+          Float  -> return $ Ty.Float  (realToFrac i)+          Double -> return $ Ty.Double (realToFrac i)+          Union tys _ -> do+            f <- tryAllTypes env tys av+            maybe (fail $ "No match for Number in union '" <> show (typeName ty) <> "'.") pure f+          _                   -> avroTypeMismatch ty "number"+      A.Array vec    ->+        case ty of+          Array t -> Ty.Array <$> V.mapM (parseAvroJSON env t) vec+          Union tys _ -> do+            f <- tryAllTypes env tys av+            maybe (fail $ "No match for Array in union '" <> show (typeName ty) <> "'.") pure f+          _  -> avroTypeMismatch ty "array"+      A.Object obj ->+        case ty of+          Map mTy     -> Ty.Map <$> mapM (parseAvroJSON env mTy) obj+          Record {..} ->+           do let lkAndParse f =+                    case HashMap.lookup (fldName f) obj of+                      Nothing -> case fldDefault f of+                                  Just v  -> return v+                                  Nothing -> fail $ "Decode failure: No record field '" <> T.unpack (fldName f) <> "' and no default in schema."+                      Just v  -> parseAvroJSON env (fldType f) v+              Ty.Record ty . HashMap.fromList <$> mapM (\f -> (fldName f,) <$> lkAndParse f) fields+          Union tys _ -> do+            f <- tryAllTypes env tys av+            maybe (fail $ "No match for given record in union '" <> show (typeName ty) <> "'.") pure f+          _ -> avroTypeMismatch ty "object"+      A.Null -> case ty of+                  Null -> return Ty.Null+                  Union us _ | Null `elem` NE.toList us -> return $ Ty.Union us Null Ty.Null+                  _ -> avroTypeMismatch ty "null"++tryAllTypes :: (Text -> Maybe Type) -> NonEmpty Type -> A.Value -> Result (Maybe (Ty.Value Type))+tryAllTypes env tys av =+     getFirst <$> foldMap (\t -> First . Just <$> parseAvroJSON env t av) (NE.toList tys)+                          `catchError` (\_ -> return mempty)++avroTypeMismatch :: Type -> Text -> Result a+avroTypeMismatch expected actual =+  fail $ "Could not resolve type '" <> T.unpack actual <> "' with expected type: " <> show expected++instance ToJSON Order where+  toJSON o =+    case o of+      Ascending  -> A.String "ascending"+      Descending -> A.String "descending"+      Ignore     -> A.String "ignore"++instance FromJSON Order where+  parseJSON (A.String s) =+    case s of+      "ascending"  -> return Ascending+      "descending" -> return Descending+      "ignore"     -> return Ignore+      _            -> fail $ "Unknown string for order: " <> T.unpack s+  parseJSON j = typeMismatch "Order" j++-- | Placeholder NO-OP function!+--+-- Validates a schema to ensure:+--+--  * All types are defined+--  * Unions do not directly contain other unions+--  * Unions are not ambiguous (may not contain more than one schema with+--  the same type except for named types of record, fixed and enum)+--  * Default values for unions can be cast as the type indicated by the+--  first structure.+--  * Default values can be cast/de-serialize correctly.+--  * Named types are resolvable+validateSchema :: Schema -> Parser ()+validateSchema _sch = return () -- XXX TODO++-- | @buildTypeEnvironment schema@ builds a function mapping type names to+-- the types declared in the traversed schema.  Notice this function does not+-- currently handle namespaces in a correct manner, possibly allowing+-- for bad environment lookups when used on complex schemas.+buildTypeEnvironment :: Applicative m => (TypeName -> m Type) -> Type -> TypeName -> m Type+buildTypeEnvironment failure from =+    \forTy -> case HashMap.lookup forTy mp of+                Nothing  -> failure forTy+                Just res -> pure res+  where+  mp = HashMap.fromList $ go from+  go :: Type -> [(TypeName,Type)]+  go ty =+    let mk :: TypeName -> [TypeName] -> Maybe Text -> [(TypeName,Type)]+        mk n as ns =+            let unqual = n:as+                qual   = maybe [] (\x -> P.map (mappend (TN x <> ".")) unqual) ns+            in zip (unqual ++ qual) (repeat ty)+    in case ty of+        Record {..} -> mk name aliases namespace ++ concatMap (go . fldType) fields+        Enum {..}   -> mk name aliases namespace+        Union {..}  -> concatMap go options+        Fixed {..}  -> mk name aliases namespace+        Array {..}  -> go item+        _           -> []++-- TODO: Currently ensures normalisation: only in one way+-- that is needed for "extractRecord".+-- it ensures that an "extracted" record is self-contained and+-- all the named types are resolvable within the scope of the schema.+-- The other way around (to each record is inlined only once and is referenced+-- as a named type after that) is not implemented.+normSchema :: [Schema] -- ^ List of all possible records+           -> Schema   -- ^ Schema to normalise+           -> State (S.Set TypeName) Schema+normSchema rs r = case r of+  t@(NamedType tn) -> do+    let sn = shortName tn+    resolved <- get+    if S.member sn resolved+      then pure t+      else do+        modify' (S.insert sn)+        pure $ fromMaybe (error $ "Unable to resolve schema: " <> show (typeName t)) (findSchema tn)++  Array s   -> Array <$> normSchema rs s+  Map s     -> Map <$> normSchema rs s+  Record{name = tn}  -> do+    let sn = shortName tn+    modify' (S.insert sn)+    flds <- mapM (\fld -> setType fld <$> normSchema rs (fldType fld)) (fields r)+    pure $ r { fields = flds }+  s         -> pure s+  where+    shortName tn = TN $ T.takeWhileEnd (/='.') (unTN tn)+    setType fld t = fld { fldType = t}+    fullName s = TN $ maybe (typeName s) (\n -> typeName s <> "." <> n) (namespace s)+    findSchema tn = L.find (\s -> name s == tn || fullName s == tn) rs
+ src/Data/Avro/Types.hs view
@@ -0,0 +1,25 @@+module Data.Avro.Types where++import Data.ByteString+import Data.HashMap.Strict (HashMap)+import Data.Int+import Data.List.NonEmpty (NonEmpty)+import Data.Text+import Data.Vector++data Value f+      = Null+      | Boolean !Bool+      | Int {-# UNPACK #-} !Int32+      | Long {-# UNPACK #-} !Int64+      | Float {-# UNPACK #-} !Float+      | Double {-# UNPACK #-} !Double+      | Bytes {-# UNPACK #-} !ByteString+      | String {-# UNPACK #-} !Text+      | Array (Vector (Value f))       -- ^ Dynamically enforced monomorphic type.+      | Map (HashMap Text (Value f))   -- ^ Dynamically enforced monomorphic type+      | Record f (HashMap Text (Value f)) -- Order and a map+      | Union (NonEmpty f) f (Value f) -- ^ Set of union options, schema for selected option, and the actual value.+      | Fixed {-# UNPACK #-} !ByteString+      | Enum f {-# UNPACK #-} !Int Text  -- ^ An enum is a set of the possible symbols (the schema) and the selected symbol+  deriving (Eq, Show)
+ src/Data/Avro/Zag.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TypeFamilies         #-}++module Data.Avro.Zag+  ( Zag(..)+  ) where++import Data.Bits+import Data.Int+import Data.Word++class Zag a where+  type Zagged a+  zag :: a -> Zagged a++instance Zag Word8 where+  type Zagged Word8 = Int8+  zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)+  {-# INLINE zag #-}++instance Zag Word16 where+  type Zagged Word16 = Int16+  zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)+  {-# INLINE zag #-}++instance Zag Word32 where+  type Zagged Word32 = Int32+  zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)+  {-# INLINE zag #-}++instance Zag Word64 where+  type Zagged Word64 = Int64+  zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)+  {-# INLINE zag #-}++instance Zag Word where+  type Zagged Word = Int+  zag n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)+  {-# INLINE zag #-}
+ src/Data/Avro/Zig.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TypeFamilies         #-}++module Data.Avro.Zig+  ( Zig(..)+  ) where++import Data.Bits+import Data.Int+import Data.Word++class Zig a where+  type Zigged a+  zig :: a -> Zigged a++instance Zig Int8 where+  type Zigged Int8 = Word8+  zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1))+  {-# INLINE zig #-}++instance Zig Int16 where+  type Zigged Int16 = Word16+  zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1))+  {-# INLINE zig #-}++instance Zig Int32 where+  type Zigged Int32 = Word32+  zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1))+  {-# INLINE zig #-}++instance Zig Int64 where+  type Zigged Int64 = Word64+  zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1))+  {-# INLINE zig #-}++instance Zig Int where+  type Zigged Int = Word+  zig n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` (finiteBitSize n - 1))+  {-# INLINE zig #-}
+ test/Avro/Codec/ArraySpec.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.ArraySpec (spec) where++import Data.Avro+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text as T++import Test.Hspec+import qualified Test.QuickCheck as Q++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++spec :: Spec+spec = describe "Avro.Codec.ArraySpec" $ do+  it "list roundtip" $ Q.property $ \(xs :: [Int]) -> decode (schemaOf xs) (encode xs) == Success xs++  it "map roundtrip" $ Q.property $ \(xs :: Map String Int) ->+    let xs' = M.mapKeys T.pack xs+    in decode (schemaOf xs') (encode xs') == Success xs'
+ test/Avro/Codec/BoolSpec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.BoolSpec (spec) where++import Test.Hspec+import qualified Test.QuickCheck as Q++import           Data.List.NonEmpty (NonEmpty(..))+import           Data.Tagged+import           Data.Text+import qualified Data.ByteString.Lazy as BL++import           Data.Avro+import           Data.Avro.Schema+import qualified Data.Avro.Types as AT++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++-- Avro definition for Bool++newtype OnlyBool = OnlyBool+  { onlyBoolValue :: Bool+  } deriving (Show, Eq)++onlyBoolSchema :: Schema+onlyBoolSchema =+  let fld nm = Field nm [] Nothing Nothing+   in Record "OnlyBool" (Just "test.contract") [] Nothing Nothing+        [ fld "onlyBoolValue" Boolean Nothing+        ]++instance ToAvro OnlyBool where+  toAvro sa = record onlyBoolSchema+    [ "onlyBoolValue" .= onlyBoolValue sa+    ]+  schema = pure onlyBoolSchema++instance FromAvro OnlyBool where+  fromAvro (AT.Record _ r) =+    OnlyBool <$> r .: "onlyBoolValue"++spec :: Spec+spec = describe "Avro.Codec.BoolSpec" $ do+  let x = untag (schema :: Tagged OnlyBool Type)+  it "should encode True correctly" $ do+    let trueEncoding = BL.singleton 0x01+    encode (OnlyBool True) `shouldBe` trueEncoding++  it "should encode False correctly" $ do+    let falseEncoding = BL.singleton 0x00+    encode (OnlyBool False) `shouldBe` falseEncoding++  it "should encode then decode True correctly" $ do+    decode x (encode $ OnlyBool True) `shouldBe` Success (OnlyBool True)++  it "should encode then decode False correctly" $ do+    decode x (encode $ OnlyBool False) `shouldBe` Success (OnlyBool False)
+ test/Avro/Codec/CodecRawSpec.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.CodecRawSpec (spec) where++import Data.Avro.DecodeRaw+import Data.Avro.EncodeRaw+import Data.Binary.Get+import Data.ByteString.Builder+import Data.Int+import Data.Word+import Test.Hspec+import qualified Test.QuickCheck as Q++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++spec :: Spec+spec = describe "Avro.Codec.CodecRawSpec" $ do+  it "codec raw round trip Int"     $ Q.property $ \(w :: Int)    -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Int8"    $ Q.property $ \(w :: Int8)   -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Int16"   $ Q.property $ \(w :: Int16)  -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Int32"   $ Q.property $ \(w :: Int32)  -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Int64"   $ Q.property $ \(w :: Int64)  -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Word"    $ Q.property $ \(w :: Word)   -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Word8"   $ Q.property $ \(w :: Word8)  -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Word16"  $ Q.property $ \(w :: Word16) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Word32"  $ Q.property $ \(w :: Word32) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w+  it "codec raw round trip Word64"  $ Q.property $ \(w :: Word64) -> runGet decodeRaw (toLazyByteString (encodeRaw w)) == w
+ test/Avro/Codec/DoubleSpec.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.DoubleSpec (spec) where++import           Data.Avro+import           Data.Avro.Schema+import           Data.Tagged+import           Test.Hspec+import qualified Data.Avro.Types      as AT+import qualified Data.ByteString.Lazy as BL+import qualified Test.QuickCheck      as Q++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++newtype OnlyDouble = OnlyDouble+  {onlyDoubleValue :: Double+  } deriving (Show, Eq)++onlyDoubleSchema :: Schema+onlyDoubleSchema =+  let fld nm = Field nm [] Nothing Nothing+  in Record "OnlyDouble" (Just "test.contract") [] Nothing Nothing+        [ fld "onlyDoubleValue" Double Nothing+        ]++instance ToAvro OnlyDouble where+  toAvro sa = record onlyDoubleSchema+    [ "onlyDoubleValue" .= onlyDoubleValue sa ]+  schema = pure onlyDoubleSchema++instance FromAvro OnlyDouble where+  fromAvro (AT.Record _ r) =+    OnlyDouble <$> r .: "onlyDoubleValue"++spec :: Spec+spec = describe "Avro.Codec.DoubleSpec" $ do+  it "Can decode 0.89" $ do+    let expectedBuffer = BL.pack [123, 20, -82, 71, -31, 122, -20, 63]+    let value = OnlyDouble 0.89+    encode value `shouldBe` expectedBuffer++  it "Can decode -2.0" $ do+    let expectedBuffer = BL.pack [0, 0, 0, 0, 0, 0, 0, -64]+    let value = OnlyDouble (-2.0)+    encode value `shouldBe` expectedBuffer++  it "Can decode 1.0" $ do+    let expectedBuffer = [0, 0, 0, 0, 0, 0, -16, 63]+    let value = OnlyDouble 1.0+    BL.unpack (encode value) `shouldBe` expectedBuffer++  it "Can decode encoded Double values" $ do+    Q.property $ \(d :: Double) ->+      let x = untag (schema :: Tagged OnlyDouble Type) in+        decode x (encode (OnlyDouble d)) == Success (OnlyDouble d)
+ test/Avro/Codec/Int64Spec.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.Int64Spec (spec) where++import           Data.Avro+import           Data.Avro.Encode+import           Data.Avro.Schema+import           Data.Avro.Zig+import           Data.Bits+import           Data.ByteString.Builder+import           Data.Int+import           Data.List.Extra+import           Data.Tagged+import           Data.Word+import           Numeric (showHex)+import           Test.Hspec+import qualified Data.Avro.Types      as AT+import qualified Data.ByteString.Lazy as BL+import qualified Test.QuickCheck      as Q+import Debug.Trace+{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+++prettyPrint :: BL.ByteString -> String+prettyPrint = concatMap (`showHex` "") . BL.unpack++newtype OnlyInt64 = OnlyInt64+  { onlyInt64Value :: Int64+  } deriving (Show, Eq)++onlyInt64Schema :: Schema+onlyInt64Schema =+  let fld nm = Field nm [] Nothing Nothing+   in Record "OnlyInt64" (Just "test.contract") [] Nothing Nothing+        [ fld "onlyInt64Value"    Long Nothing+        ]++instance ToAvro OnlyInt64 where+  toAvro sa = record onlyInt64Schema+    [ "onlyInt64Value" .= onlyInt64Value sa+    ]+  schema = pure onlyInt64Schema++instance FromAvro OnlyInt64 where+  fromAvro (AT.Record _ r) =+    OnlyInt64  <$> r .: "onlyInt64Value"++bitStringToWord8s :: String -> [Word8]+bitStringToWord8s = reverse . map (toWord . reverse) . chunksOf 8 . reverse . toBinary+  where toBinary :: String -> [Bool]+        toBinary ('1':xs) = True  : toBinary xs+        toBinary ('0':xs) = False : toBinary xs+        toBinary (_  :xs) = toBinary xs+        toBinary       [] = []+        toWord' :: Word8 -> [Bool] -> Word8+        toWord' n (True :bs)  = toWord' ((n `shiftL` 1) .|. 1) bs+        toWord' n (False:bs)  = toWord' ((n `shiftL` 1) .|. 0) bs+        toWord' n _           = n+        toWord = toWord' 0++spec :: Spec+spec = describe "Avro.Codec.Int64Spec" $ do+  it "Can encode 90071992547409917L correctly" $ do+    let expectedBuffer = BL.pack [0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xbf, 0x02]+    let value = OnlyInt64 90071992547409917+    encode value `shouldBe` expectedBuffer+  it "Can decode 90071992547409917L correctly" $ do+    let x = untag (schema :: Tagged OnlyInt64 Type)+    let buffer = BL.pack [0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xbf, 0x02]+    let expectedValue = OnlyInt64 90071992547409917+    decode x buffer `shouldBe` Success expectedValue+  it "Can decode encoded Int64 values" $ do+    let x = untag (schema :: Tagged OnlyInt64 Type)+    Q.property $ \(w :: Int64) -> decode x (encode (OnlyInt64 w)) == Success (OnlyInt64 w)++  it "Can decode 129L" $ do+    let w = 129 :: Int64+    let x = untag (schema :: Tagged OnlyInt64 Type)+    decode x (encode (OnlyInt64 w)) == Success (OnlyInt64 w)++  it "Can decode 36028797018963968 correctly" $ do+    let x = untag (schema :: Tagged OnlyInt64 Type)+    let buffer = BL.pack (bitStringToWord8s "10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001")+    let expectedValue = OnlyInt64 36028797018963968+    decode x buffer `shouldBe` Success expectedValue++  it "bitStringToWord8s 00000000"                   $  bitStringToWord8s "00000000"                    `shouldBe` [0x00             ]+  it "bitStringToWord8s 00000001"                   $  bitStringToWord8s "00000001"                    `shouldBe` [0x01             ]+  it "bitStringToWord8s 01111111"                   $  bitStringToWord8s "01111111"                    `shouldBe` [0x7f             ]+  it "bitStringToWord8s 10000000 00000001"          $  bitStringToWord8s "10000000 00000001"           `shouldBe` [0x80, 0x01       ]+  it "bitStringToWord8s 10000001 00000001"          $  bitStringToWord8s "10000001 00000001"           `shouldBe` [0x81, 0x01       ]+  it "bitStringToWord8s 10000010 00000001"          $  bitStringToWord8s "10000010 00000001"           `shouldBe` [0x82, 0x01       ]+  it "bitStringToWord8s 11111111 01111111"          $  bitStringToWord8s "11111111 01111111"           `shouldBe` [0xff, 0x7f       ]+  it "bitStringToWord8s 10000000 10000000 00000001" $  bitStringToWord8s "10000000 10000000 00000001"  `shouldBe` [0x80, 0x80, 0x01 ]+  it "bitStringToWord8s 10000001 10000000 00000001" $  bitStringToWord8s "10000001 10000000 00000001"  `shouldBe` [0x81, 0x80, 0x01 ]+  it "bitStringToWord8s 10000001 10000000 00000000" $  bitStringToWord8s "10000001 10000000 00000000"  `shouldBe` [0x81, 0x80, 0x00 ]++  it "Can zig" $ do+    zig (          0 :: Int64)  `shouldBe` 0+    zig (         -1 :: Int64)  `shouldBe` 1+    zig (          1 :: Int64)  `shouldBe` 2+    zig (         -2 :: Int64)  `shouldBe` 3+    zig ( 2147483647 :: Int64)  `shouldBe` 4294967294+    zig (-2147483648 :: Int64)  `shouldBe` 4294967295
+ test/Avro/Codec/MaybeSpec.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.MaybeSpec (spec) where++import           Test.Hspec+import qualified Test.QuickCheck as Q++import           Data.List.NonEmpty (NonEmpty(..))+import           Data.Tagged+import           Data.Text++import           Data.Avro+import           Data.Avro.Schema+import qualified Data.Avro.Types as AT++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++newtype OnlyMaybeBool = OnlyMaybeBool+  { onlyMaybeBoolValue :: Maybe Bool+  } deriving (Show, Eq)++onlyMaybeBoolSchema :: Schema+onlyMaybeBoolSchema =+  let fld nm = Field nm [] Nothing Nothing+   in Record "onlyMaybeBool" (Just "test.contract") [] Nothing Nothing+        [ fld "onlyMaybeBoolValue" (mkUnion (Null :| [Boolean])) Nothing+        ]++instance ToAvro OnlyMaybeBool where+  toAvro sa = record onlyMaybeBoolSchema+    [ "onlyMaybeBoolValue" .= onlyMaybeBoolValue sa+    ]+  schema = pure onlyMaybeBoolSchema++instance FromAvro OnlyMaybeBool where+  fromAvro (AT.Record _ r) =+    OnlyMaybeBool <$> r .: "onlyMaybeBoolValue"++spec :: Spec+spec = describe "Avro.Codec.MaybeSpec" $ do+  it "should encode then decode Maybe Bool correctly" $ do+    Q.property $ \(w :: Maybe Bool) ->+      let x = untag (schema :: Tagged OnlyMaybeBool Type) in+        decode x (encode (OnlyMaybeBool w)) `shouldBe` Success (OnlyMaybeBool w)
+ test/Avro/Codec/NestedSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.NestedSpec (spec) where++import           Data.Avro+import           Data.Avro.Schema+import qualified Data.Avro.Types      as AT+import qualified Data.ByteString.Lazy as BL+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++data ChildType = ChildType+  { childValue1 :: Int+  , childValue2 :: Int+  } deriving (Show, Eq)++data ParentType = ParentType+  { parentValue1 :: Int+  , parentValue2 :: [ChildType]+  } deriving (Show, Eq)++childTypeSchema :: Schema+childTypeSchema =+  let fld nm = Field nm [] Nothing Nothing+  in Record "ChildType" (Just "test.contract") [] Nothing Nothing+        [ fld "childValue1" Long Nothing+        , fld "childValue2" Long Nothing+        ]++parentTypeSchema :: Schema+parentTypeSchema =+  let fld nm = Field nm [] Nothing Nothing+  in Record "ParentType" (Just "test.contract") [] Nothing Nothing+        [ fld "parentValue1" Long             Nothing+        , fld "parentValue2" (Array childTypeSchema)  Nothing]++instance ToAvro ChildType where+  toAvro sa = record childTypeSchema+    [ "childValue1" .= childValue1 sa+    , "childValue2" .= childValue2 sa+    ]+  schema = pure childTypeSchema++instance FromAvro ChildType where+  fromAvro (AT.Record _ r) =+    ChildType <$> r .: "childValue1"+              <*> r .: "childValue2"+  fromAvro v = badValue v "ChildType"++instance ToAvro ParentType where+  toAvro sa = record parentTypeSchema+    [ "parentValue1" .= parentValue1 sa+    , "parentValue2" .= parentValue2 sa+    ]+  schema = pure parentTypeSchema++instance FromAvro ParentType where+  fromAvro (AT.Record _ r) =+    ParentType <$> r .: "parentValue1"+               <*> r .: "parentValue2"+  fromAvro v = badValue v "ParentType"++spec :: Spec+spec = describe "Avro.Codec.NestedSpec" $ do+  it "Can encode/decode nested structures" $ do+    let parent = ParentType 0 [ChildType 1 2, ChildType 3 4]+    let parentEncoded = encode parent++    let parentDecoded = decode parentTypeSchema parentEncoded+    parentDecoded `shouldBe` Success parent
+ test/Avro/Codec/TextSpec.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.TextSpec (spec) where++import           Data.Avro+import           Data.Avro.Schema+import           Data.Text+import           Data.Tagged+import           Test.Hspec+import qualified Data.Avro.Types      as AT+import qualified Test.QuickCheck      as Q++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++newtype OnlyText = OnlyText+  {onlyTextValue :: Text+  } deriving (Show, Eq)++onlyTextSchema :: Schema+onlyTextSchema =+  let fld nm = Field nm [] Nothing Nothing+  in Record "OnlyText" (Just "test.contract") [] Nothing Nothing+        [ fld "onlyTextValue" String Nothing+        ]++instance ToAvro OnlyText where+  toAvro sa = record onlyTextSchema+    [ "onlyTextValue" .= onlyTextValue sa ]+  schema = pure onlyTextSchema++instance FromAvro OnlyText where+  fromAvro (AT.Record _ r) =+    OnlyText <$> r .: "onlyTextValue"++spec :: Spec+spec = describe "Avro.Codec.TextSpec" $ do+  it "Can decode \"This is an unit test\"" $ do+    -- The '(' here is the length (ASCII value) of the string+    let expectedBuffer = "(This is an unit test"+    let value = OnlyText "This is an unit test"+    encode value `shouldBe` expectedBuffer++  it "Can decode encoded Text values" $ do+    Q.property $ \(t :: String) ->+      let x = untag (schema :: Tagged OnlyText Type) in+        decode x (encode (OnlyText (pack t))) == Success (OnlyText (pack t))
+ test/Avro/Codec/ZigZagSpec.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.Codec.ZigZagSpec (spec) where++import Data.Avro.Zag+import Data.Avro.Zig+import Data.Int+import Data.Word+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++spec :: Spec+spec = describe "Avro.Codec.Int64Spec" $ do+  it "Zig and zag roundtrips for Int"     $ property $ \(w :: Int   ) -> zag (zig w) `shouldBe` w+  it "Zig and zag roundtrips for Int8"    $ property $ \(w :: Int8  ) -> zag (zig w) `shouldBe` w+  it "Zig and zag roundtrips for Int16"   $ property $ \(w :: Int16 ) -> zag (zig w) `shouldBe` w+  it "Zig and zag roundtrips for Int32"   $ property $ \(w :: Int32 ) -> zag (zig w) `shouldBe` w+  it "Zig and zag roundtrips for Int64"   $ property $ \(w :: Int64 ) -> zag (zig w) `shouldBe` w+  it "Zag and zig roundtrips for Word"    $ property $ \(w :: Word  ) -> zig (zag w) `shouldBe` w+  it "Zag and zig roundtrips for Word8"   $ property $ \(w :: Word8 ) -> zig (zag w) `shouldBe` w+  it "Zag and zig roundtrips for Word16"  $ property $ \(w :: Word16) -> zig (zag w) `shouldBe` w+  it "Zag and zig roundtrips for Word32"  $ property $ \(w :: Word32) -> zig (zag w) `shouldBe` w+  it "Zag and zig roundtrips for Word64"  $ property $ \(w :: Word64) -> zig (zag w) `shouldBe` w
+ test/Avro/EncodeRawSpec.hs view
@@ -0,0 +1,51 @@+module Avro.EncodeRawSpec (spec) where++import           Data.Avro.EncodeRaw+import           Data.Bits+import           Data.ByteString.Builder+import           Data.List.Extra+import           Data.Word+import           Test.Hspec+import qualified Data.ByteString.Lazy as BL++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++bitStringToWord8s :: String -> [Word8]+bitStringToWord8s = reverse . map (toWord . reverse) . chunksOf 8 . reverse . toBinary+  where toBinary :: String -> [Bool]+        toBinary ('1':xs) = True  : toBinary xs+        toBinary ('0':xs) = False : toBinary xs+        toBinary (_  :xs) = toBinary xs+        toBinary       [] = []+        toWord' :: Word8 -> [Bool] -> Word8+        toWord' n (True :bs)  = toWord' ((n `shiftL` 1) .|. 1) bs+        toWord' n (False:bs)  = toWord' ((n `shiftL` 1) .|. 0) bs+        toWord' n _           = n+        toWord = toWord' 0++spec :: Spec+spec = describe "Avro.EncodeRawSpec" $ do+  it "Can encodeRaw (                  0 :: Word64)" $ toLazyByteString (encodeRaw (                  0 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                                 00000000" )+  it "Can encodeRaw (                  1 :: Word64)" $ toLazyByteString (encodeRaw (                  1 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                                 00000001" )+  it "Can encodeRaw (                  2 :: Word64)" $ toLazyByteString (encodeRaw (                  2 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                                 00000010" )+  it "Can encodeRaw (                127 :: Word64)" $ toLazyByteString (encodeRaw (                127 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                                 01111111" )+  it "Can encodeRaw (                129 :: Word64)" $ toLazyByteString (encodeRaw (                129 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                        10000001 00000001" )+  it "Can encodeRaw (                130 :: Word64)" $ toLazyByteString (encodeRaw (                130 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                        10000010 00000001" )+  it "Can encodeRaw (              16383 :: Word64)" $ toLazyByteString (encodeRaw (              16383 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                        11111111 01111111" )+  it "Can encodeRaw (              16385 :: Word64)" $ toLazyByteString (encodeRaw (              16385 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                               10000001 10000000 00000001" )+  it "Can encodeRaw (            2097153 :: Word64)" $ toLazyByteString (encodeRaw (            2097153 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                      10000001 10000000 10000000 00000001" )+  it "Can encodeRaw (          268435457 :: Word64)" $ toLazyByteString (encodeRaw (          268435457 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                             10000001 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (        34359738369 :: Word64)" $ toLazyByteString (encodeRaw (        34359738369 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                    10000001 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (      4398046511105 :: Word64)" $ toLazyByteString (encodeRaw (      4398046511105 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                           10000001 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (    562949953421313 :: Word64)" $ toLazyByteString (encodeRaw (    562949953421313 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                  10000001 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (  72057594037927937 :: Word64)" $ toLazyByteString (encodeRaw (  72057594037927937 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "         10000001 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (9223372036854775809 :: Word64)" $ toLazyByteString (encodeRaw (9223372036854775809 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "10000001 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (                128 :: Word64)" $ toLazyByteString (encodeRaw (                128 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                                        10000000 00000001" )+  it "Can encodeRaw (              16384 :: Word64)" $ toLazyByteString (encodeRaw (              16384 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                               10000000 10000000 00000001" )+  it "Can encodeRaw (            2097153 :: Word64)" $ toLazyByteString (encodeRaw (            2097152 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                                      10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (          268435457 :: Word64)" $ toLazyByteString (encodeRaw (          268435456 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                             10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (        34359738369 :: Word64)" $ toLazyByteString (encodeRaw (        34359738368 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                                    10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (      4398046511105 :: Word64)" $ toLazyByteString (encodeRaw (      4398046511104 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                           10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (    562949953421313 :: Word64)" $ toLazyByteString (encodeRaw (    562949953421312 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "                  10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (  72057594037927936 :: Word64)" $ toLazyByteString (encodeRaw (  72057594037927936 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "         10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )+  it "Can encodeRaw (9223372036854775808 :: Word64)" $ toLazyByteString (encodeRaw (9223372036854775808 :: Word64)) `shouldBe` BL.pack (bitStringToWord8s "10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 10000000 00000001" )
+ test/Avro/THEnumSpec.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+module Avro.THEnumSpec+where++import           Data.Avro+import           Data.Avro.Deriving++import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++deriveAvro "test/data/enums.avsc"++spec :: Spec+spec = describe "Avro.THEnumSpec: Schema with enums" $ do+  it "should do roundtrip" $ do+    let msg = EnumWrapper+              { enumWrapperId   = 42+              , enumWrapperName = "Text"+              , enumWrapperReason = EnumReasonBecause+              }+    fromAvro (toAvro msg) `shouldBe` pure msg
+ test/Avro/THReusedSpec.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+module Avro.THReusedSpec+where++import           Data.Avro+import           Data.Avro.Deriving++import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++deriveAvro "test/data/reused.avsc"++spec :: Spec+spec = describe "Avro.THReusedSpec: Schema with named types" $ do+  let container = ContainerChild+                  { containerChildFstIncluded = ReusedChild 100+                  , containerChildSndIncluded = ReusedChild 200+                  }+  let wrapper = ReusedWrapper+                { reusedWrapperFull  = ReusedChild 42+                , reusedWrapperInner = container+                }+  it "wrapper should do roundtrip" $+    fromAvro (toAvro wrapper)         `shouldBe` pure wrapper++  it "child should do rundtrip" $+    fromAvro (toAvro container)       `shouldBe` pure container++  it "innermost element should do roundtrip" $+    fromAvro (toAvro (ReusedChild 7)) `shouldBe` pure (ReusedChild 7)
+ test/Avro/THSimpleSpec.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+module Avro.THSimpleSpec+where++import           Control.Monad+import           Data.Aeson (decodeStrict)+import           Data.Avro+import           Data.Avro.Deriving+import           Data.Avro.Schema+import           Data.ByteString as BS++import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++deriveAvro "test/data/small.avsc"++spec :: Spec+spec = describe "Avro.THSpec: Small Schema" $ do+  let msgs =+        [ Endpoint+          { endpointIps   = ["192.168.1.1", "127.0.0.1"]+          , endpointPorts = [PortRange 1 10, PortRange 11 20]+          }+        , Endpoint+          { endpointIps   = []+          , endpointPorts = [PortRange 1 10, PortRange 11 20]+          }+        ]++  it "should do roundtrip" $ do+    forM_ msgs $ \msg ->+      fromAvro (toAvro msg) `shouldBe` pure msg++  it "should do full round trip" $+    forM_ msgs $ \msg -> do+      let encoded = encode msg+      let decoded = decode (schemaOf msg) encoded++      pure msg `shouldBe` decoded
+ test/Avro/ToAvroSpec.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Avro.ToAvroSpec+where++import           Data.Avro+import           Data.Int+import           Data.Text+import           Data.Avro.Schema+import qualified Data.Avro.Types as AT+import           Data.List.NonEmpty (NonEmpty(..))+import           Data.Tagged+import           Data.Word+import qualified Data.ByteString.Lazy as BL+import Test.Hspec+import qualified Test.QuickCheck as Q++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}++data TypesTestMessage = TypesTestMessage+  { tmId          :: Int64+  , tmName        :: Text+  , tmTimestamp   :: Maybe Int64+  , tmForeignId   :: Maybe Int64+  , tmCompetence  :: Maybe Double+  , tmAttraction  :: Double+  } deriving (Show, Eq)++tmSchema :: Schema+tmSchema =+  let fld nm = Field nm [] Nothing Nothing+   in Record "TypesTestMessage" (Just "avro.haskell.test") [] Nothing Nothing+        [ fld "id" Long Nothing+        , fld "name" String Nothing+        , fld "timestamp" (mkUnion (Null :| [Long])) Nothing+        , fld "foreignId" (mkUnion (Null :| [Long])) Nothing+        , fld "competence" (mkUnion (Null :| [Double])) Nothing+        , fld "attraction" Double Nothing+        ]++instance ToAvro TypesTestMessage where+  toAvro m = record tmSchema+    [ "id"          .= tmId m+    , "name"        .= tmName m+    , "timestamp"   .= tmTimestamp m+    , "foreignId"   .= tmForeignId m+    , "competence"  .= tmCompetence m+    , "attraction"  .= tmAttraction m+    ]+  schema = pure tmSchema++instance FromAvro TypesTestMessage where+  fromAvro (AT.Record _ r) =+    TypesTestMessage <$> r .: "id"+                     <*> r .: "name"+                     <*> r .: "timestamp"+                     <*> r .: "foreignId"+                     <*> r .: "competence"+                     <*> r .: "attraction"+  fromAvro v = badValue v "TypesTestMessage"++message :: TypesTestMessage+message = TypesTestMessage+  { tmId         = 896543+  , tmName       = "test-name"+  , tmTimestamp  = Just 7+  , tmForeignId  = Nothing+  , tmCompetence = Just 7.5+  , tmAttraction = 8.974+  }++spec :: Spec+spec = describe "Kafka.IntegrationSpec" $ do+  it "sends messages to test topic" $ do+    fromAvro (toAvro message) `shouldBe` pure message
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/data/enums.avsc view
@@ -0,0 +1,15 @@+{ "type": "record",+  "name": "EnumWrapper",+  "namespace": "haskell.avro.example",+  "fields": [+    { "name": "id",     "type": "long" },+    { "name": "name",   "type": "string"},+    { "name": "reason",+    "type": {+        "type": "enum",+        "name": "EnumReason",+        "symbols": ["Because", "Instead"]+      }+    }+  ]+}
+ test/data/reused.avsc view
@@ -0,0 +1,37 @@+{+  "type": "record",+  "name": "ReusedWrapper",+  "namespace": "Boo",+  "fields": [+    {+      "name": "full",+      "type": {+        "type": "record",+        "name": "ReusedChild",+        "fields": [+          {+            "name": "data",+            "type": "int"+          }+        ]+      }+    },+    {+      "name": "inner",+      "type": {+        "type": "record",+        "name": "ContainerChild",+        "fields": [+          {+            "name": "fstIncluded",+            "type": "ReusedChild"+          },+          {+            "name": "sndIncluded",+            "type": "ReusedChild"+          }+        ]+      }+    }+  ]+}
+ test/data/small.avsc view
@@ -0,0 +1,33 @@+{+  "type": "record",+  "name": "Endpoint",+  "fields": [+    {+      "name": "ips",+      "type": {+        "type": "array",+        "items": "string"+      }+    },+    {+      "name": "ports",+      "type": {+        "type": "array",+        "items": {+          "type": "record",+          "name": "PortRange",+          "fields": [+            {+              "name": "start",+              "type": "int"+            },+            {+              "name": "end",+              "type": "int"+            }+          ]+        }+      }+    }+  ]+}