mu-avro 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+288/−155 lines, 5 filesdep +deepseqdep +language-avrodep +mu-rpcdep ~avrodep ~mu-avrodep ~mu-schemanew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, language-avro, mu-rpc, time, uuid

Dependency ranges changed: avro, mu-avro, mu-schema

API changes (from Hackage documentation)

Files

• mu-avro.cabal +56/−43
• src/Data/Time/Millis.hs +41/−0
• src/Mu/Adapter/Avro.hs +89/−78
• src/Mu/Quasi/Avro.hs +101/−33
• test/Avro.hs +1/−1

@@ -1,51 +1,64 @@-cabal-version:       >=1.10-name:                mu-avro-version:             0.1.0.0-synopsis:            Avro serialization support for Mu microservices-description:         You can use @mu-avro@ to read AVRO Schema Declarations for mu-haskell-license:             Apache-2.0-license-file:        LICENSE-author:              Alejandro Serrano, Flavio Corpa-maintainer:          alejandro.serrano@47deg.com-copyright:           Copyright © 2019-2020 <http://47deg.com 47 Degrees>-category:            Network-build-type:          Simple-data-files:          test/avro/*.avsc-homepage:            https://higherkindness.io/mu-haskell/-bug-reports:         https://github.com/higherkindness/mu-haskell/issues+name:          mu-avro+version:       0.2.0.0+synopsis:      Avro serialization support for Mu microservices+description:+  You can use @mu-avro@ to read AVRO Schema Declarations for mu-haskell +license:       Apache-2.0+license-file:  LICENSE+author:        Alejandro Serrano, Flavio Corpa+maintainer:    alejandro.serrano@47deg.com+copyright:     Copyright © 2019-2020 <http://47deg.com 47 Degrees>+category:      Network+build-type:    Simple+cabal-version: >=1.10+data-files:    test/avro/*.avsc+homepage:      https://higherkindness.io/mu-haskell/+bug-reports:   https://github.com/higherkindness/mu-haskell/issues+ source-repository head   type:     git   location: https://github.com/higherkindness/mu-haskell  library-  exposed-modules:     Mu.Adapter.Avro-                     , Mu.Quasi.Avro-                     , Mu.Quasi.Avro.Example-  build-depends:       base >=4.12 && <5-                     , mu-schema-                     , avro-                     , tagged-                     , aeson-                     , text-                     , vector-                     , containers-                     , unordered-containers-                     , sop-core-                     , bytestring-                     , template-haskell >= 2.12-  hs-source-dirs:      src-  default-language:    Haskell2010-  ghc-options:         -Wall-                       -fprint-potential-instances+  exposed-modules:+    Data.Time.Millis+    Mu.Adapter.Avro+    Mu.Quasi.Avro+    Mu.Quasi.Avro.Example +  build-depends:+      aeson+    , avro                  >=0.4.7+    , base                  >=4.12  && <5+    , bytestring+    , containers+    , deepseq+    , language-avro         >=0.1.2+    , mu-rpc                >=0.2.0+    , mu-schema             >=0.2.0+    , sop-core+    , tagged+    , template-haskell      >=2.12+    , text+    , time+    , unordered-containers+    , uuid+    , vector++  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall -fprint-potential-instances+ executable test-avro-  main-is:             Avro.hs-  build-depends:       base >=4.12 && <5-                     , mu-schema-                     , mu-avro-                     , avro-                     , bytestring-  hs-source-dirs:      test-  default-language:    Haskell2010-  ghc-options:         -Wall+  main-is:          Avro.hs+  build-depends:+      avro        >=0.4.7+    , base        >=4.12  && <5+    , bytestring+    , mu-avro     >=0.2.0+    , mu-schema   >=0.2.0++  hs-source-dirs:   test+  default-language: Haskell2010+  ghc-options:      -Wall

@@ -0,0 +1,41 @@+{-# language GeneralizedNewtypeDeriving #-}+module Data.Time.Millis where+++import           Control.DeepSeq         (NFData)+import           Data.Avro.Encode+import           Data.Avro.EncodeRaw+import           Data.Avro.FromAvro+import           Data.Avro.HasAvroSchema+import           Data.Avro.Schema        as S+import           Data.Avro.ToAvro+import           Data.Avro.Types         as T+import           Data.Tagged+import           Data.Time+import           Unsafe.Coerce++-- | Wrapper for time difference expressed in milliseconds+newtype DiffTimeMs = DiffTimeMs { unDiffTimeMs :: DiffTime }+  deriving (Show, Eq, Ord, Enum, Num, Fractional, Real, RealFrac, NFData)++instance EncodeAvro DiffTimeMs where+  avro d+      -- Unfortunately, the AvroM constructor is not exposed :(+    = unsafeCoerce ( encodeRaw (fromIntegral $ diffTimeToMillis d :: Int)+                   , S.Long (Just TimeMicros) )++instance HasAvroSchema DiffTimeMs where+  schema = Tagged $ S.Int (Just TimeMillis)++instance ToAvro DiffTimeMs where+  toAvro = T.Int . fromIntegral . diffTimeToMillis++instance FromAvro DiffTimeMs where+  fromAvro (T.Int  v) = pure $ millisToDiffTime (toInteger v)+  fromAvro v          = badValue v "TimeMicros"++diffTimeToMillis :: DiffTimeMs -> Integer+diffTimeToMillis = (`div` 1000000000) . diffTimeToPicoseconds . unDiffTimeMs++millisToDiffTime :: Integer -> DiffTimeMs+millisToDiffTime = DiffTimeMs . picosecondsToDiffTime . (* 1000000000)

@@ -1,3 +1,4 @@+{-# language ConstraintKinds       #-} {-# language DataKinds             #-} {-# language FlexibleContexts      #-} {-# language FlexibleInstances     #-}@@ -72,97 +73,105 @@   toSchemalessValue e@AVal.Enum {}     = SLess.FSchematic (SLess.toSchemalessTerm e) -instance HasAvroSchemas sch sch+instance A.HasAvroSchema (Term f sch (sch :/: sty))          => A.HasAvroSchema (WithSchema f sch sty t) where-  -- the previous iteration added only the schema of the type-  -- schema = coerce $ A.schema @(Term sch (sch :/: sty))-  -- but now we prefer to have all of them-  schema = Tagged $ ASch.Union (schemas (Proxy @sch) (Proxy @sch))-instance ( FromSchema f sch sty t, HasAvroSchemas sch sch+  schema = coerce $ A.schema @(Term f sch (sch :/: sty))+instance ( FromSchema f sch sty t          , A.FromAvro (Term f sch (sch :/: sty)) )          => A.FromAvro (WithSchema f sch sty t) where-  fromAvro (AVal.Union _ _ v) = WithSchema . fromSchema' @_ @_ @sch @f <$> A.fromAvro v-  fromAvro v                  = ASch.badValue v "top-level"-instance ( ToSchema Identity sch sty t, HasAvroSchemas sch sch+  fromAvro v = WithSchema . fromSchema' @_ @_ @sch @f <$> A.fromAvro v+instance ( ToSchema Identity sch sty t          , A.ToAvro (Term Identity sch (sch :/: sty)) )          => A.ToAvro (WithSchema Identity sch sty t) where-  toAvro (WithSchema v) = AVal.Union (schemas (Proxy @sch) (Proxy @sch))-                                     (unTagged $ A.schema @(Term Identity sch (sch :/: sty)))-                                     (A.toAvro (toSchema' @_ @_ @sch @Identity v))--class HasAvroSchemas (r :: Schema tn fn) (sch :: Schema tn fn) where-  schemas :: Proxy r -> Proxy sch -> V.Vector ASch.Type-instance HasAvroSchemas r '[] where-  schemas _ _ = V.empty-instance forall r d ds.-         (A.HasAvroSchema (Term Identity r d), HasAvroSchemas r ds)-         => HasAvroSchemas r (d ': ds) where-  schemas pr _ = V.cons thisSchema (schemas pr (Proxy @ds))-    where thisSchema = unTagged $ A.schema @(Term Identity r d)+  toAvro (WithSchema v) = A.toAvro (toSchema' @_ @_ @sch @Identity v)  -- HasAvroSchema instances +class HasAvroSchema' x where+  schema' :: [ASch.TypeName] -> Tagged x ASch.Type++instance HasAvroSchema' (Term f sch t)+         => A.HasAvroSchema (Term f sch t) where+  schema = schema' []+instance HasAvroSchema' (FieldValue f sch t)+         => A.HasAvroSchema (FieldValue f sch t) where+  schema = schema' []+ instance (KnownName name, HasAvroSchemaFields sch args)-         => A.HasAvroSchema (Term f sch ('DRecord name args)) where-  schema = Tagged $ ASch.Record recordName [] Nothing Nothing fields+         => HasAvroSchema' (Term f sch ('DRecord name args)) where+  schema' visited+    = if recordName `elem` visited+         then Tagged $ ASch.NamedType recordName+         else Tagged $ ASch.Record recordName [] Nothing Nothing fields     where recordName = nameTypeName (Proxy @name)-          fields = schemaF (Proxy @sch) (Proxy @args)+          fields = schemaF (Proxy @sch) (Proxy @args) visited instance (KnownName name, HasAvroSchemaEnum choices)-          => A.HasAvroSchema (Term f sch ('DEnum name choices)) where-  schema = Tagged $ ASch.mkEnum enumName [] Nothing choicesNames+          => HasAvroSchema' (Term f sch ('DEnum name choices)) where+  schema' visited+    = if enumName `elem` visited+         then Tagged $ ASch.NamedType enumName+         else Tagged $ ASch.mkEnum enumName [] Nothing choicesNames     where enumName = nameTypeName (Proxy @name)           choicesNames = schemaE (Proxy @choices)-instance A.HasAvroSchema (FieldValue f sch t)-         => A.HasAvroSchema (Term f sch ('DSimple t)) where-  schema = coerce $ A.schema @(FieldValue f sch t)+instance HasAvroSchema' (FieldValue f sch t)+         => HasAvroSchema' (Term f sch ('DSimple t)) where+  schema' visited = coerce $ schema' @(FieldValue f sch t) visited -instance A.HasAvroSchema (FieldValue f sch 'TNull) where-  schema = Tagged ASch.Null+instance HasAvroSchema' (FieldValue f sch 'TNull) where+  schema' _ = Tagged ASch.Null instance A.HasAvroSchema t-         => A.HasAvroSchema (FieldValue f sch ('TPrimitive t)) where-  schema = coerce $ A.schema @t-instance KnownName t-         => A.HasAvroSchema (FieldValue f sch ('TSchematic t)) where-  -- schema = coerce $ A.schema @(Term sch (sch :/: t))-  schema = Tagged $ ASch.NamedType (nameTypeName (Proxy @t))+         => HasAvroSchema' (FieldValue f sch ('TPrimitive t)) where+  schema' _ = coerce $ A.schema @t+instance (HasAvroSchema' (Term f sch (sch :/: t)))+         => HasAvroSchema' (FieldValue f sch ('TSchematic t)) where+  schema' visited = coerce $ schema' @(Term f sch (sch :/: t)) visited instance forall sch f choices.          HasAvroSchemaUnion (FieldValue f sch) choices-         => A.HasAvroSchema (FieldValue f sch ('TUnion choices)) where-  schema = Tagged $ ASch.mkUnion $ schemaU (Proxy @(FieldValue f sch)) (Proxy @choices)-instance A.HasAvroSchema (FieldValue f sch t)-         => A.HasAvroSchema (FieldValue f sch ('TOption t)) where-  schema = coerce $ A.schema @(Maybe (FieldValue f sch t))-instance A.HasAvroSchema (FieldValue f sch t)-         => A.HasAvroSchema (FieldValue f sch ('TList t)) where-  schema = coerce $ A.schema @[FieldValue f sch t]+         => HasAvroSchema' (FieldValue f sch ('TUnion choices)) where+  schema' visited+    = Tagged $ ASch.mkUnion $ schemaU (Proxy @(FieldValue f sch)) (Proxy @choices) visited+instance HasAvroSchema' (FieldValue f sch t)+         => HasAvroSchema' (FieldValue f sch ('TOption t)) where+  schema' visited+    = Tagged $ ASch.mkUnion $ ASch.Null :| [iSchema]+    where iSchema = unTagged $ schema' @(FieldValue f sch t) visited+instance HasAvroSchema' (FieldValue f sch t)+         => HasAvroSchema' (FieldValue f sch ('TList t)) where+  schema' visited+    = Tagged $ ASch.Array iSchema+    where iSchema = unTagged $ schema' @(FieldValue f sch t) visited -- These are the only two versions of Map supported by the library-instance A.HasAvroSchema (FieldValue f sch v)-         => A.HasAvroSchema (FieldValue f sch ('TMap ('TPrimitive T.Text) v)) where-  schema = coerce $ A.schema @(M.Map T.Text (FieldValue f sch v))-instance A.HasAvroSchema (FieldValue f sch v)-         => A.HasAvroSchema (FieldValue f sch ('TMap ('TPrimitive String) v)) where-  schema = coerce $ A.schema @(M.Map String (FieldValue f sch v))+instance HasAvroSchema' (FieldValue f sch v)+         => HasAvroSchema' (FieldValue f sch ('TMap ('TPrimitive T.Text) v)) where+  schema' visited+    = Tagged $ ASch.Map iSchema+    where iSchema = unTagged $ schema' @(FieldValue f sch v) visited+instance HasAvroSchema' (FieldValue f sch v)+         => HasAvroSchema' (FieldValue f sch ('TMap ('TPrimitive String) v)) where+  schema' visited+    = Tagged $ ASch.Map iSchema+    where iSchema = unTagged $ schema' @(FieldValue f sch v) visited  class HasAvroSchemaUnion (f :: k -> *) (xs :: [k]) where-  schemaU :: Proxy f -> Proxy xs -> NonEmpty ASch.Type-instance A.HasAvroSchema (f v) => HasAvroSchemaUnion f '[v] where-  schemaU _ _ = vSchema :| []-    where vSchema = unTagged (A.schema @(f v))-instance (A.HasAvroSchema (f x), HasAvroSchemaUnion f (y ': zs))+  schemaU :: Proxy f -> Proxy xs -> [ASch.TypeName] -> NonEmpty ASch.Type+instance HasAvroSchema' (f v) => HasAvroSchemaUnion f '[v] where+  schemaU _ _ visited = vSchema :| []+    where vSchema = unTagged (schema' @(f v) visited)+instance (HasAvroSchema' (f x), HasAvroSchemaUnion f (y ': zs))          => HasAvroSchemaUnion f (x ': y ': zs) where-  schemaU p _ = xSchema :| NonEmptyList.toList yzsSchema-    where xSchema = unTagged (A.schema @(f x))-          yzsSchema = schemaU p (Proxy @(y ': zs))+  schemaU p _ visited = xSchema :| NonEmptyList.toList yzsSchema+    where xSchema = unTagged (schema' @(f x) visited)+          yzsSchema = schemaU p (Proxy @(y ': zs)) visited  class HasAvroSchemaFields sch (fs :: [FieldDef tn fn]) where-  schemaF :: Proxy sch -> Proxy fs -> [ASch.Field]+  schemaF :: Proxy sch -> Proxy fs -> [ASch.TypeName] -> [ASch.Field] instance HasAvroSchemaFields sch '[] where-  schemaF _ _ = []-instance (KnownName name, A.HasAvroSchema (FieldValue Identity sch t), HasAvroSchemaFields sch fs)+  schemaF _ _ _ = []+instance (KnownName name, HasAvroSchema' (FieldValue Identity sch t), HasAvroSchemaFields sch fs)          => HasAvroSchemaFields sch ('FieldDef name t ': fs) where-  schemaF psch _ = schemaThis : schemaF psch (Proxy @fs)+  schemaF psch _ visited = schemaThis : schemaF psch (Proxy @fs) visited     where fieldName = nameText (Proxy @name)-          schemaT = unTagged $ A.schema @(FieldValue Identity sch t)+          schemaT = unTagged $ schema' @(FieldValue Identity sch t) visited           schemaThis = ASch.Field fieldName [] Nothing Nothing schemaT Nothing  class HasAvroSchemaEnum (fs :: [ChoiceDef fn]) where@@ -183,7 +192,7 @@           => A.FromAvro (Term f sch ('DEnum name choices)) where   fromAvro v@(AVal.Enum _ n _) = TEnum <$> fromAvroEnum v n   fromAvro v                   = A.badValue v "enum"-instance A.FromAvro (FieldValue f sch t)+instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))          => A.FromAvro (Term f sch ('DSimple t)) where   fromAvro v = TSimple <$> A.fromAvro v @@ -192,24 +201,25 @@   fromAvro v         = A.badValue v "null" instance A.FromAvro t => A.FromAvro (FieldValue f sch ('TPrimitive t)) where   fromAvro v = FPrimitive <$> A.fromAvro v-instance (KnownName t, A.FromAvro (Term f sch (sch :/: t)))+instance ( KnownName t, HasAvroSchema' (Term f sch (sch :/: t))+         , A.FromAvro (Term f sch (sch :/: t)) )          => A.FromAvro (FieldValue f sch ('TSchematic t)) where   fromAvro v = FSchematic <$> A.fromAvro v instance (HasAvroSchemaUnion (FieldValue f sch) choices, FromAvroUnion f sch choices)          => A.FromAvro (FieldValue f sch ('TUnion choices)) where   fromAvro (AVal.Union _ branch v) = FUnion <$> fromAvroU branch v   fromAvro v                       = A.badValue v "union"-instance A.FromAvro (FieldValue f sch t)+instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))          => A.FromAvro (FieldValue f sch ('TOption t)) where   fromAvro v = FOption <$> A.fromAvro v-instance A.FromAvro (FieldValue f sch t)+instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))          => A.FromAvro (FieldValue f sch ('TList t)) where   fromAvro v = FList <$> A.fromAvro v -- These are the only two versions of Map supported by the library-instance A.FromAvro (FieldValue f sch v)+instance (HasAvroSchema' (FieldValue f sch v), A.FromAvro (FieldValue f sch v))          => A.FromAvro (FieldValue f sch ('TMap ('TPrimitive T.Text) v)) where   fromAvro v = FMap . M.mapKeys FPrimitive <$> A.fromAvro v-instance A.FromAvro (FieldValue f sch v)+instance (HasAvroSchema' (FieldValue f sch v), A.FromAvro (FieldValue f sch v))          => A.FromAvro (FieldValue f sch ('TMap ('TPrimitive String) v)) where   fromAvro v = FMap . M.mapKeys (FPrimitive . T.unpack) <$> A.fromAvro v @@ -255,7 +265,7 @@   toAvro (TEnum n) = AVal.Enum wholeSchema choice text     where wholeSchema = unTagged (A.schema @(Term Identity sch ('DEnum name choices)))           (choice, text) = toAvroE n-instance A.ToAvro (FieldValue Identity sch t)+instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))          => A.ToAvro (Term Identity sch ('DSimple t)) where   toAvro (TSimple v) = A.toAvro v @@ -263,27 +273,28 @@   toAvro FNull = AVal.Null instance A.ToAvro t => A.ToAvro (FieldValue Identity sch ('TPrimitive t)) where   toAvro (FPrimitive v) = A.toAvro v-instance (KnownName t, A.ToAvro (Term Identity sch (sch :/: t)))+instance ( KnownName t, HasAvroSchema' (Term Identity sch (sch :/: t))+         , A.ToAvro (Term Identity sch (sch :/: t)) )          => A.ToAvro (FieldValue Identity sch ('TSchematic t)) where   toAvro (FSchematic v) = A.toAvro v instance forall sch choices.          (HasAvroSchemaUnion (FieldValue Identity sch) choices, ToAvroUnion sch choices)          => A.ToAvro (FieldValue Identity sch ('TUnion choices)) where   toAvro (FUnion v) = AVal.Union wholeSchema' chosenTy chosenVal-    where wholeSchema = schemaU (Proxy @(FieldValue Identity sch)) (Proxy @choices)+    where wholeSchema = schemaU (Proxy @(FieldValue Identity sch)) (Proxy @choices) []           wholeSchema' = V.fromList (NonEmptyList.toList wholeSchema)           (chosenTy, chosenVal) = toAvroU v-instance A.ToAvro (FieldValue Identity sch t)+instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))          => A.ToAvro (FieldValue Identity sch ('TOption t)) where   toAvro (FOption v) = A.toAvro v-instance A.ToAvro (FieldValue Identity sch t)+instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))          => A.ToAvro (FieldValue Identity sch ('TList t)) where   toAvro (FList v) = AVal.Array $ V.fromList $ A.toAvro <$> v -- These are the only two versions of Map supported by the library-instance A.ToAvro (FieldValue Identity sch v)+instance (HasAvroSchema' (FieldValue Identity sch v), A.ToAvro (FieldValue Identity sch v))          => A.ToAvro (FieldValue Identity sch ('TMap ('TPrimitive T.Text) v)) where   toAvro (FMap v) = A.toAvro $ M.mapKeys (\(FPrimitive k) -> k) v-instance A.ToAvro (FieldValue Identity sch v)+instance (HasAvroSchema' (FieldValue Identity sch v), A.ToAvro (FieldValue Identity sch v))          => A.ToAvro (FieldValue Identity sch ('TMap ('TPrimitive String) v)) where   toAvro (FMap v) = A.toAvro $ M.mapKeys (\(FPrimitive k) -> k) v 

@@ -1,8 +1,9 @@-{-# language DataKinds       #-}-{-# language LambdaCase      #-}-{-# language NamedFieldPuns  #-}-{-# language TemplateHaskell #-}-{-# language ViewPatterns    #-}+{-# language DataKinds         #-}+{-# language LambdaCase        #-}+{-# language NamedFieldPuns    #-}+{-# language OverloadedStrings #-}+{-# language TemplateHaskell   #-}+{-# language ViewPatterns      #-} {-| Description : Quasi-quoters for Avro IDL format @@ -16,23 +17,34 @@ is supported, not the Java-like one. -} module Mu.Quasi.Avro (+  -- * Service generation from @.avdl@ files+  avdl   -- * Quasi-quoters for @.avsc@ files-    avro-  , avroFile+, avro+, avroFile   -- * Only for internal use-  , schemaFromAvroType-  ) where+, schemaFromAvroType+) where +import           Control.Monad.IO.Class import           Data.Aeson                 (decode) import qualified Data.Avro.Schema           as A+import           Data.Avro.Types.Decimal    as D import qualified Data.ByteString            as B import           Data.ByteString.Lazy.Char8 (pack) import           Data.Int+import qualified Data.Set                   as S import qualified Data.Text                  as T-import           Data.Vector                (fromList, toList)+import           Data.Time+import           Data.Time.Millis+import           Data.UUID+import qualified Data.Vector                as V+import           Language.Avro.Parser+import qualified Language.Avro.Types        as A import           Language.Haskell.TH import           Language.Haskell.TH.Quote +import           Mu.Rpc import           Mu.Schema.Definition  -- | Imports an avro definition written in-line as a 'Schema'.@@ -43,22 +55,52 @@     (const $ fail "cannot use as pattern")     schemaFromAvroString     (const $ fail "cannot use as declaration")+  where+    schemaFromAvroString :: String -> Q Type+    schemaFromAvroString s =+      case decode (pack s) of+        Nothing           -> fail "could not parse avro spec!"+        Just (A.Union us) -> schemaFromAvro (V.toList us)+        Just t            -> schemaFromAvro [t]  -- | Imports an avro definition from a file as a 'Schema'. avroFile :: QuasiQuoter avroFile = quoteFile avro -schemaFromAvroString :: String -> Q Type-schemaFromAvroString s =-  case decode (pack s) of-    Nothing           -> fail "could not parse avro spec!"-    Just (A.Union us) -> schemaFromAvro (toList us)-    Just t            -> schemaFromAvro [t]+-- | Reads a @.proto@ file and generates:+--   * A 'Mu.Schema.Definition.Schema' with all the message+--     types, using the name given as first argument.+--   * A 'Service' declaration for each service in the file,+--     where the name is obtained by applying the function+--     given as second argument to the name in the file.+avdl :: String -> String -> FilePath -> FilePath -> Q [Dec]+avdl schemaName serviceName baseDir initialFile+  = do r <- liftIO $ readWithImports baseDir initialFile+       case r of+         Left e+           -> fail ("could not parse protocol buffers spec: " ++ show e)+         Right p+           -> avdlToDecls schemaName serviceName p++avdlToDecls :: String -> String -> A.Protocol -> Q [Dec]+avdlToDecls schemaName serviceName protocol+  = do let schemaName'  = mkName schemaName+           serviceName' = mkName serviceName+       schemaDec <- tySynD schemaName' [] (schemaFromAvro $ S.toList (A.types protocol))+       serviceDec <- tySynD serviceName' []+         [t| 'Service $(textToStrLit (A.pname protocol)) $(pkgType (A.ns protocol))+                      $(typesToList <$> mapM (avroMethodToType schemaName') (S.toList $ A.messages protocol)) |]+       return [schemaDec, serviceDec]   where-    schemaFromAvro =-      (typesToList <$>) . mapM schemaDecFromAvroType . flattenAvroDecls+    pkgType Nothing = [t| '[] |]+    pkgType (Just (A.Namespace p))+                    = [t| '[ Package $(textToStrLit (T.intercalate "." p)) ] |] -schemaDecFromAvroType :: A.Type -> Q Type+schemaFromAvro :: [A.Schema] -> Q Type+schemaFromAvro =+  (typesToList <$>) . mapM schemaDecFromAvroType . flattenAvroDecls++schemaDecFromAvroType :: A.Schema -> Q Type schemaDecFromAvroType (A.Record name _ _ _ fields) =   [t|'DRecord $(textToStrLit $ A.baseName name)               $(typesToList <$> mapM avroFieldToType fields)|]@@ -69,24 +111,30 @@                    $(schemaFromAvroType $ A.fldType field)|] schemaDecFromAvroType (A.Enum name _ _ symbols) =   [t|'DEnum $(textToStrLit $ A.baseName name)-            $(typesToList <$> mapM avChoiceToType (toList symbols))|]+            $(typesToList <$> mapM avChoiceToType (V.toList symbols))|]   where     avChoiceToType :: T.Text -> Q Type     avChoiceToType c = [t|'ChoiceDef $(textToStrLit c)|] schemaDecFromAvroType t = [t|'DSimple $(schemaFromAvroType t)|]  -- | Turns a schema from Avro into a Template Haskell 'Type'.-schemaFromAvroType :: A.Type -> Q Type+schemaFromAvroType :: A.Schema -> Q Type schemaFromAvroType =   \case     A.Null -> [t|'TPrimitive 'TNull|]     A.Boolean -> [t|'TPrimitive Bool|]-    A.Int -> [t|'TPrimitive Int32|]-    A.Long -> [t|'TPrimitive Int64|]+    A.Int (Just A.Date) -> [t|'TPrimitive Day|]+    A.Int (Just A.TimeMillis) -> [t|'TPrimitive DiffTimeMs|]+    A.Int _ -> [t|'TPrimitive Int32|]+    A.Long (Just (A.DecimalL (A.Decimal p s)))+             -> [t|'TPrimitive (D.Decimal $(litT $ numTyLit p) $(litT $ numTyLit s)) |]+    A.Long (Just A.TimeMicros) -> [t|'TPrimitive DiffTime|]+    A.Long _ -> [t|'TPrimitive Int64|]     A.Float -> [t|'TPrimitive Float|]     A.Double -> [t|'TPrimitive Double|]-    A.Bytes -> [t|'TPrimitive B.ByteString|]-    A.String -> [t|'TPrimitive T.Text|]+    A.Bytes _ -> [t|'TPrimitive B.ByteString|]+    A.String (Just A.UUID) -> [t|'TPrimitive UUID|]+    A.String _ -> [t|'TPrimitive T.Text|]     A.Array item -> [t|'TList $(schemaFromAvroType item)|]     A.Map values -> [t|'TMap T.Text $(schemaFromAvroType values)|]     A.NamedType typeName ->@@ -94,36 +142,56 @@     A.Enum {} -> fail "should never happen, please, file an issue"     A.Record {} -> fail "should never happen, please, file an issue"     A.Union options ->-      case toList options of+      case V.toList options of         [A.Null, x] -> toOption x         [x, A.Null] -> toOption x         _ ->-          [t|'TUnion $(typesToList <$> mapM schemaFromAvroType (toList options))|]+          [t|'TUnion $(typesToList <$> mapM schemaFromAvroType (V.toList options))|]       where toOption x = [t|'TOption $(schemaFromAvroType x)|]     A.Fixed {} -> fail "fixed integers are not currently supported" -flattenAvroDecls :: [A.Type] -> [A.Type]+flattenAvroDecls :: [A.Schema] -> [A.Schema] flattenAvroDecls = concatMap (uncurry (:) . flattenDecl)   where-    flattenDecl :: A.Type -> (A.Type, [A.Type])+    flattenDecl :: A.Schema -> (A.Schema, [A.Schema])     flattenDecl (A.Record name a d o fields) =       let (flds, tts) = unzip (flattenAvroField <$> fields)        in (A.Record name a d o flds, concat tts)     flattenDecl (A.Union _) = error "should never happen, please, file an issue"     flattenDecl t = (t, [])-    flattenAvroType :: A.Type -> (A.Type, [A.Type])+    flattenAvroType :: A.Schema -> (A.Schema, [A.Schema])     flattenAvroType (A.Record name a d o fields) =       let (flds, tts) = unzip (flattenAvroField <$> fields)        in (A.NamedType name, A.Record name a d o flds : concat tts)-    flattenAvroType (A.Union (toList -> ts)) =+    flattenAvroType (A.Union (V.toList -> ts)) =       let (us, tts) = unzip (map flattenAvroType ts)-       in (A.Union $ fromList us, concat tts)+       in (A.Union $ V.fromList us, concat tts)     flattenAvroType e@A.Enum {A.name} = (A.NamedType name, [e])     flattenAvroType t = (t, [])-    flattenAvroField :: A.Field -> (A.Field, [A.Type])+    flattenAvroField :: A.Field -> (A.Field, [A.Schema])     flattenAvroField f =       let (t, decs) = flattenAvroType (A.fldType f)        in (f {A.fldType = t}, decs)++avroMethodToType :: Name -> A.Method -> Q Type+avroMethodToType schemaName m+  = [t| 'Method $(textToStrLit (A.mname m)) '[]+                $(typesToList <$> mapM argToType (A.args m))+                $(retToType (A.result m)) |]+  where+    argToType :: A.Argument -> Q Type+    argToType (A.Argument (A.NamedType a) _)+      = [t| 'ArgSingle ('ViaSchema $(conT schemaName) $(textToStrLit (A.baseName a))) |]+    argToType (A.Argument _ _)+      = fail "only named types may be used as arguments"++    retToType :: A.Schema -> Q Type+    retToType A.Null+      = [t| 'RetNothing |]+    retToType (A.NamedType a)+      = [t| 'RetSingle ('ViaSchema $(conT schemaName) $(textToStrLit (A.baseName a))) |]+    retToType _+      = fail "only named types may be used as results"  typesToList :: [Type] -> Type typesToList = foldr (\y ys -> AppT (AppT PromotedConsT y) ys) PromotedNilT

@@ -19,7 +19,7 @@ exampleAddress = Address "1111BB" "Spain"  examplePerson1, examplePerson2 :: Person-examplePerson1 = Person "Haskellio" "Gómez" (Just 30) (Just Male) exampleAddress+examplePerson1 = Person "Haskellio" "Gomez" (Just 30) (Just Male) exampleAddress examplePerson2 = Person "Cuarenta" "Siete" Nothing Nothing exampleAddress  deriving via (WithSchema Identity ExampleSchema "person" Person) instance HasAvroSchema Person