avro 0.3.0.5 → 0.3.1.0
raw patch · 14 files changed
+141/−51 lines, 14 files
Files
- avro.cabal +2/−2
- src/Data/Avro/Deriving.hs +110/−37
- src/Data/Avro/Schema.hs +11/−5
- test/Avro/Deconflict/Reader.hs +1/−0
- test/Avro/Deconflict/Writer.hs +1/−0
- test/Avro/DefaultsSpec.hs +1/−0
- test/Avro/JSONSpec.hs +1/−0
- test/Avro/NormSchemaSpec.hs +1/−0
- test/Avro/THEncodeContainerSpec.hs +6/−5
- test/Avro/THEnumSpec.hs +2/−1
- test/Avro/THLogicalTypeSpec.hs +1/−0
- test/Avro/THReusedSpec.hs +2/−1
- test/Avro/THSimpleSpec.hs +1/−0
- test/Avro/THUnionSpec.hs +1/−0
avro.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 86dacf38d4a96f044259ea81c7afc0a5aec901f34480f50e90d4c98b05834e43+-- hash: d96fb3f751e7082ce82dad5a68e5c9c64c853adfcdba51ba55c807b50491045b name: avro-version: 0.3.0.5+version: 0.3.1.0 synopsis: Avro serialization support for Haskell description: Avro serialization and deserialization support for Haskell category: Data
src/Data/Avro/Deriving.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -6,7 +7,15 @@ {-# LANGUAGE ViewPatterns #-} module Data.Avro.Deriving-( deriveAvro+( -- * Deriving options+ DeriveOptions(..), defaultDeriveOptions+, mkPrefixedFieldName, mkAsIsFieldName++ -- * Deriving Haskell types from Avro schema+, deriveAvroWithOptions+, deriveAvroWithOptions'+, deriveFromAvroWithOptions+, deriveAvro , deriveAvro' , deriveFromAvro )@@ -27,6 +36,7 @@ import Data.Map (Map) import Data.Maybe (fromMaybe) import Data.Semigroup ((<>))+import GHC.Generics (Generic) import Language.Haskell.TH as TH import Language.Haskell.TH.Syntax @@ -42,28 +52,95 @@ -- | Derives Avro from a given schema file. -- Generates data types, FromAvro and ToAvro instances.-deriveAvro :: FilePath -> Q [Dec]-deriveAvro p = readSchema p >>= deriveAvro'+data DeriveOptions = DeriveOptions+ { -- | How to build field names for generated data types+ doFieldNameBuilder :: TypeName -> Field -> Name+ } -deriveAvro' :: Schema -> Q [Dec]-deriveAvro' s = do+-- | Default deriving options+--+-- @+-- defaultDeriveOptions = 'DeriveOptions'+-- { doFieldNameBuilder = 'mkPrefixedFieldName'+-- }+-- @+defaultDeriveOptions = DeriveOptions+ { doFieldNameBuilder = mkPrefixedFieldName+ }++-- | Generates a field name that is prefixed with the type name.+--+-- For example, if the schema defines type 'Person' that has a field 'firstName',+-- then the generated Haskell type will be like+--+-- @+-- Person { personFirstName :: Text }+-- @+mkPrefixedFieldName :: TypeName -> Field -> Name+mkPrefixedFieldName (TN dn) fld = mkTextName . sanitiseName $+ updateFirst T.toLower dn <> updateFirst T.toUpper (fldName fld)++-- | Generates a field name that matches the field name in schema+-- (sanitised for Haskell, so first letter is lower cased)+--+-- For example, if the schema defines type 'Person' that has a field 'firstName',+-- then the generated Haskell type will be like+--+-- @+-- Person { firstName :: Text }+-- @+-- You may want to enable 'DuplicateRecordFields' if you want to use this method.++mkAsIsFieldName :: TypeName -> Field -> Name+mkAsIsFieldName _ = mkTextName . sanitiseName . updateFirst T.toLower . fldName++-- | Generates Haskell classes and 'FromAvro' and 'ToAvro' instances+-- given the Avro schema file+deriveAvroWithOptions :: DeriveOptions -> FilePath -> Q [Dec]+deriveAvroWithOptions o p = readSchema p >>= deriveAvroWithOptions' o++-- | Generates Haskell classes and 'FromAvro' and 'ToAvro' instances+-- given the Avro schema+deriveAvroWithOptions' :: DeriveOptions -> Schema -> Q [Dec]+deriveAvroWithOptions' o s = do let schemas = extractDerivables s- types <- traverse genType schemas+ types <- traverse (genType o) schemas hasSchema <- traverse genHasAvroSchema schemas fromAvros <- traverse genFromAvro schemas- toAvros <- traverse genToAvro schemas+ toAvros <- traverse (genToAvro o) schemas pure $ join types <> join hasSchema <> join fromAvros <> join toAvros -- | Derives "read only" Avro from a given schema file. -- Generates data types and FromAvro.-deriveFromAvro :: FilePath -> Q [Dec]-deriveFromAvro p = do+deriveFromAvroWithOptions :: DeriveOptions -> FilePath -> Q [Dec]+deriveFromAvroWithOptions o p = do schemas <- extractDerivables <$> readSchema p- types <- traverse genType schemas+ types <- traverse (genType o) schemas hasSchema <- traverse genHasAvroSchema schemas fromAvros <- traverse genFromAvro schemas pure $ join types <> join hasSchema <> join fromAvros +-- | Same as 'deriveAvroWithOptions' but uses 'defaultDeriveOptions'+--+-- @+-- deriveAvro' = deriveAvroWithOptions' 'defaultDeriveOptions'+-- @+deriveAvro :: FilePath -> Q [Dec]+deriveAvro = deriveAvroWithOptions defaultDeriveOptions++-- | Same as 'deriveAvroWithOptions'' but uses 'defaultDeriveOptions'+--+-- @+-- deriveAvro' = 'deriveAvroWithOptions'' 'defaultDeriveOptions'+-- @+deriveAvro' :: Schema -> Q [Dec]+deriveAvro' = deriveAvroWithOptions' defaultDeriveOptions++-- | Derives "read only" Avro from a given schema file.+-- Generates data types and FromAvro.+deriveFromAvro :: FilePath -> Q [Dec]+deriveFromAvro = deriveFromAvroWithOptions defaultDeriveOptions+ readSchema :: FilePath -> Q Schema readSchema p = do qAddDependentFile p@@ -111,8 +188,8 @@ schema = pure $(varE sname) |] -genToAvro :: Schema -> Q [Dec]-genToAvro s@(Enum n _ _ _ vs _) =+genToAvro :: DeriveOptions -> Schema -> Q [Dec]+genToAvro opts s@(Enum n _ _ _ vs _) = toAvroInstance (mkSchemaValueName n) where conP' = flip conP [] . mkAdtCtorName n@@ -125,7 +202,7 @@ |]) |] -genToAvro s@(Record n _ _ _ _ fs) =+genToAvro opts s@(Record n _ _ _ _ fs) = toAvroInstance (mkSchemaValueName n) where toAvroInstance sname =@@ -133,12 +210,12 @@ toAvro = $(genToAvroFieldsExp sname) |] genToAvroFieldsExp sname = [| \r -> record $(varE sname)- $(let assign fld = [| T.pack $(mkTextLit (fldName fld)) .= $(varE $ mkFieldTextName n fld) r |]+ $(let assign fld = [| T.pack $(mkTextLit (fldName fld)) .= $(varE $ (doFieldNameBuilder opts) n fld) r |] in listE $ assign <$> fs ) |] -genToAvro s@(Fixed n _ _ size) =+genToAvro opts s@(Fixed n _ _ size) = toAvroInstance (mkSchemaValueName n) where toAvroInstance sname =@@ -246,19 +323,19 @@ 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+genType :: DeriveOptions -> Schema -> Q [Dec]+genType opts (S.Record n _ _ _ _ fs) = do+ flds <- traverse (mkField opts n) fs let dname = mkDataTypeName n sequenceA [genDataType dname flds]-genType (S.Enum n _ _ _ vs _) = do+genType _ (S.Enum n _ _ _ vs _) = do let dname = mkDataTypeName n sequenceA [genEnum dname (mkAdtCtorName n <$> vs)]-genType (S.Fixed n _ _ s) = do+genType _ (S.Fixed n _ _ s) = do let dname = mkDataTypeName n sequenceA [genNewtype dname] -genType _ = pure []+genType _ _ = pure [] mkFieldTypeName :: S.Type -> Q TH.Type mkFieldTypeName t = case t of@@ -311,32 +388,28 @@ 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+mkField :: DeriveOptions -> TypeName -> Field -> Q VarStrictType+mkField opts prefix field = do ftype <- mkFieldTypeName (fldType field)- let fName = mkFieldTextName prefix field+ let fName = (doFieldNameBuilder opts) prefix field pure (fName, defaultStrictness, ftype) genNewtype :: Name -> Q Dec #if MIN_VERSION_template_haskell(2,12,0) genNewtype dn = do- ders <- sequenceA [[t|Eq|], [t|Show|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] fldType <- [t|ByteString|] let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)] pure $ NewtypeD [] dn [] Nothing ctor [DerivClause Nothing ders] #elif MIN_VERSION_template_haskell(2,11,0) genNewtype dn = do- ders <- sequenceA [[t|Eq|], [t|Show|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] fldType <- [t|ByteString|] let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)] pure $ NewtypeD [] dn [] Nothing ctor ders #else genNewtype dn = do- [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|]]+ [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] fldType <- [t|ByteString|] let ctor = RecC dn [(mkName ("un" ++ nameBase dn), defaultStrictness, fldType)] pure $ NewtypeD [] dn [] ctor [eq, sh]@@ -345,30 +418,30 @@ 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|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|], [t|Generic|]] 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|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|], [t|Generic|]] 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|]]+ [ConT eq, ConT sh, ConT or, ConT en] <- sequenceA [[t|Eq|], [t|Show|], [t|Ord|], [t|Enum|], [t|Generic|]] 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|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] 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|]]+ ders <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] pure $ DataD [] dn [] Nothing [RecC dn flds] ders #else genDataType dn flds = do- [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|]]+ [ConT eq, ConT sh] <- sequenceA [[t|Eq|], [t|Show|], [t|Generic|]] pure $ DataD [] dn [] [RecC dn flds] [eq, sh] #endif
src/Data/Avro/Schema.hs view
@@ -55,7 +55,8 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes, fromMaybe)-import Data.Monoid (First (..), (<>))+import Data.Monoid (First (..))+import Data.Semigroup import qualified Data.Set as S import Data.String import Data.Text (Text)@@ -154,9 +155,12 @@ instance Show TypeName where show (TN s) = show s +instance Semigroup TypeName where+ TN a <> TN b = TN (a <> b)+ instance Monoid TypeName where mempty = TN mempty- mappend (TN a) (TN b) = TN (a <> b)+ mappend = (<>) instance IsString TypeName where fromString = TN . fromString@@ -371,6 +375,8 @@ mzero = fail "mzero" mplus a@(Success _) _ = a mplus _ b = b+instance Semigroup (Result a) where+ (<>) = mplus instance Monoid (Result a) where mempty = fail "Empty Result" mappend = mplus@@ -435,11 +441,11 @@ Long -> return $ Ty.Long (floor i) Float -> return $ Ty.Float (realToFrac i) Double -> return $ Ty.Double (realToFrac i)- _ -> avroTypeMismatch ty "number"+ _ -> avroTypeMismatch ty "number" A.Array vec -> case ty of Array t -> Ty.Array <$> V.mapM (parseAvroJSON union env t) vec- _ -> avroTypeMismatch ty "array"+ _ -> avroTypeMismatch ty "array" A.Object obj -> case ty of Map mTy -> Ty.Map <$> mapM (parseAvroJSON union env mTy) obj@@ -454,7 +460,7 @@ _ -> avroTypeMismatch ty "object" A.Null -> case ty of Null -> return Ty.Null- _ -> avroTypeMismatch ty "null"+ _ -> avroTypeMismatch ty "null" -- | Parses a string literal into a bytestring in the format expected -- for bytes and fixed values. Will fail if every character does not
test/Avro/Deconflict/Reader.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Avro.Deconflict.Reader
test/Avro/Deconflict/Writer.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Avro.Deconflict.Writer
test/Avro/DefaultsSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}
test/Avro/JSONSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}
test/Avro/NormSchemaSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}
test/Avro/THEncodeContainerSpec.hs view
@@ -1,13 +1,14 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} module Avro.THEncodeContainerSpec where -import Data.Avro-import Data.Avro.Deriving+import Data.Avro+import Data.Avro.Deriving -import Test.Hspec+import Test.Hspec -import Control.Monad (void)-import Control.Exception+import Control.Exception+import Control.Monad (void) deriveAvro "test/data/record.avsc"
test/Avro/THEnumSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -7,7 +8,7 @@ import Data.Avro import Data.Avro.Deriving -import Test.Hspec+import Test.Hspec {-# ANN module ("HLint: ignore Redundant do" :: String) #-}
test/Avro/THLogicalTypeSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}
test/Avro/THReusedSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -7,7 +8,7 @@ import Data.Avro import Data.Avro.Deriving -import Test.Hspec+import Test.Hspec {-# ANN module ("HLint: ignore Redundant do" :: String) #-}
test/Avro/THSimpleSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}
test/Avro/THUnionSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}