mu-avro 0.3.0.0 → 0.4.0.0

raw patch · 5 files changed

+132/−149 lines, 5 filesdep +transformersdep ~aesondep ~avrodep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: aeson, avro, bytestring, containers, deepseq, language-avro, mu-avro, mu-rpc, mu-schema, sop-core, tagged, template-haskell, text, time, unordered-containers, uuid, vector

API changes (from Hackage documentation)

Files

• mu-avro.cabal +23/−22
• src/Mu/Adapter/Avro.hs +66/−95
• src/Mu/Quasi/Avro.hs +7/−5
• src/Mu/Quasi/Avro/Example.hs +13/−4
• test/avro/example.avsc +23/−23

@@ -1,5 +1,5 @@ name:          mu-avro-version:       0.3.0.0+version:       0.4.0.0 synopsis:      Avro serialization support for Mu microservices description:   You can use @mu-avro@ to read AVRO Schema Declarations for mu-haskell@@ -28,23 +28,24 @@     Mu.Quasi.Avro.Example    build-depends:-      aeson-    , avro                  >=0.5.1-    , base                  >=4.12    && <5-    , bytestring-    , containers-    , deepseq-    , language-avro         >=0.1.3.1-    , mu-rpc                >=0.3.0-    , mu-schema             >=0.3.0-    , sop-core-    , tagged-    , template-haskell      >=2.12-    , text-    , time-    , unordered-containers-    , uuid-    , vector+      aeson                 >=1.4    && <2+    , avro                  >=0.5.1  && <0.6+    , base                  >=4.12   && <5+    , bytestring            >=0.10   && <0.11+    , containers            >=0.6    && <0.7+    , deepseq               >=1.4    && <2+    , language-avro         >=0.1.3  && <0.2+    , mu-rpc                ==0.4.*+    , mu-schema             ==0.3.*+    , sop-core              >=0.5.0  && <0.6+    , tagged                >=0.8.6  && <0.9+    , template-haskell      >=2.14   && <2.16+    , text                  >=1.2    && <2+    , time                  >=1.9    && <2+    , transformers          >=0.5    && <0.6+    , unordered-containers  >=0.2    && <0.3+    , uuid                  >=1.3    && <2+    , vector                >=0.12   && <0.13    hs-source-dirs:   src   default-language: Haskell2010@@ -53,11 +54,11 @@ executable test-avro   main-is:          Avro.hs   build-depends:-      avro        >=0.5+      avro        >=0.5.1 && <0.6     , base        >=4.12  && <5-    , bytestring-    , mu-avro     >=0.3.0-    , mu-schema   >=0.3.0+    , bytestring  >=0.10  && <0.11+    , mu-avro+    , mu-schema   ==0.3.*    hs-source-dirs:   test   default-language: Haskell2010

@@ -21,7 +21,6 @@ -} module Mu.Adapter.Avro () where -import           Control.Applicative                 ((<|>)) import           Control.Arrow                       ((***)) import qualified Data.Avro                           as A import qualified Data.Avro.Encoding.FromAvro         as AVal@@ -30,11 +29,11 @@ import qualified Data.Avro.Schema.Schema             as ASch -- 'Tagged . unTagged' can be replaced by 'coerce' -- eliminating some run-time overhead+import           Control.Monad.Trans.State import           Data.Avro.EitherN                   (putIndexedValue) import           Data.ByteString.Builder             (Builder, word8) import           Data.Coerce                         (coerce) import qualified Data.HashMap.Strict                 as HM-import           Data.List                           ((\\)) import           Data.List.NonEmpty                  (NonEmpty (..)) import qualified Data.List.NonEmpty                  as NonEmptyList import qualified Data.Map                            as M@@ -51,8 +50,9 @@   toSchemalessTerm (AVal.Record s r)     = case s of         RSch.Record { RSch.fields = fs }-          -> SLess.TRecord $ map (\(k,v) -> SLess.Field k (SLess.toSchemalessValue v))-                           $ zip (map RSch.fldName fs) (V.toList r)+          -> SLess.TRecord $+               zipWith (\k v -> SLess.Field k (SLess.toSchemalessValue v))+                       (map RSch.fldName fs) (V.toList r)         _ -> error ("this should never happen:\n" ++ show s)   toSchemalessTerm (AVal.Enum _ i _)     = SLess.TEnum i@@ -83,148 +83,118 @@   toSchemalessValue e@AVal.Enum {}     = SLess.FSchematic (SLess.toSchemalessTerm e) -instance (HasAvroSchemas sch sch)+instance (HasAvroSchema' (Term sch (sch :/: sty)))          => A.HasAvroSchema (WithSchema sch sty t) where-  schema = Tagged $ ASch.Union $ schemas (Proxy @sch) (Proxy @sch) ts-    where ts = typeNames (Proxy @sch) (Proxy @sch)+  schema = coerce $ evalState (schema' @(Term sch (sch :/: sty))) [] instance ( FromSchema sch sty t          , A.FromAvro (Term sch (sch :/: sty)) )          => A.FromAvro (WithSchema sch sty t) where-  fromAvro entire@(AVal.Union _ _ v)-    =   -- remove first layer of union-        WithSchema . fromSchema' @_ @_ @sch <$> AVal.fromAvro v-    <|> -- try with the entire thing-        WithSchema . fromSchema' @_ @_ @sch <$> AVal.fromAvro entire   fromAvro entire-    =   WithSchema . fromSchema' @_ @_ @sch <$> AVal.fromAvro entire+    = WithSchema . fromSchema' @_ @_ @sch <$> AVal.fromAvro entire instance ( ToSchema sch sty t-         , A.ToAvro (Term sch (sch :/: sty))-         , KnownNat (IxOf sch sty) )+         , A.ToAvro (Term sch (sch :/: sty)) )          => A.ToAvro (WithSchema sch sty t) where-  toAvro (ASch.Union vs) (WithSchema v)-    = putIndexedValue (fromInteger $ natVal (Proxy @(IxOf sch sty)))-                      vs-                      (toSchema' @_ @_ @sch v)-  toAvro s _ = error ("this should never happen:\n" ++ show s)--class HasAvroSchemas (r :: Schema tn fn) (sch :: Schema tn fn) where-  schemas   :: Proxy r -> Proxy sch -> [ASch.TypeName] -> V.Vector ASch.Schema-  typeNames :: Proxy r -> Proxy sch -> [ASch.TypeName]-instance HasAvroSchemas r '[] where-  schemas _ _ _ = V.empty-  typeNames _ _ = []-instance forall r d ds.-         (HasAvroSchema' (Term r d), HasAvroSchemas r ds)-         => HasAvroSchemas r (d ': ds) where-  schemas pr _ tys = V.cons thisSchema (schemas pr (Proxy @ds) tys)-    where thisSchema = unTagged $ schema' @(Term r d) (tys \\ typeName' (Proxy @(Term r d)))-  typeNames pr _ = typeName' (Proxy @(Term r d)) ++ typeNames pr (Proxy @ds)--type family IxOf (sch :: Schema tn fn) (sty :: tn) :: Nat where-  IxOf ('DRecord nm fs ': rest) nm = 0-  IxOf ('DEnum   nm cs ': rest) nm = 0-  IxOf (other          ': rest) nm = 1 + IxOf rest nm+  toAvro sch (WithSchema v)+    = A.toAvro sch (toSchema' @_ @_ @sch v)  -- HasAvroSchema instances  class HasAvroSchema' x where-  typeName' :: Proxy x -> [ASch.TypeName]-  schema' :: [ASch.TypeName] -> Tagged x ASch.Schema+  schema' :: State [ASch.TypeName] (Tagged x ASch.Schema)  instance TypeError ('Text "you should never use HasAvroSchema directly on Term, use WithSchema")          => A.HasAvroSchema (Term sch t) where   schema = error "this should never happen" instance HasAvroSchema' (FieldValue sch t)          => A.HasAvroSchema (FieldValue sch t) where-  schema = schema' []+  schema = evalState schema' []  instance (KnownName name, HasAvroSchemaFields sch args)          => HasAvroSchema' (Term sch ('DRecord name args)) where-  typeName' _ = [nameTypeName (Proxy @name)]-  schema' visited-    = if recordName `elem` visited-         then Tagged $ ASch.NamedType recordName-         else Tagged $ ASch.Record recordName [] Nothing fields-    where recordName = nameTypeName (Proxy @name)-          fields = schemaF (Proxy @sch) (Proxy @args) visited+  schema'+    = do let recordName = nameTypeName (Proxy @name)+         visited <- gets (recordName `elem`)+         if visited+            then pure $ Tagged $ ASch.NamedType recordName+            else do modify (recordName :)+                    fields <- schemaF (Proxy @sch) (Proxy @args)+                    pure $ Tagged $ ASch.Record recordName [] Nothing fields instance (KnownName name, HasAvroSchemaEnum choices)           => HasAvroSchema' (Term sch ('DEnum name choices)) where-  typeName' _ = [nameTypeName (Proxy @name)]-  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)+  schema'+    = do let enumName = nameTypeName (Proxy @name)+             choicesNames = schemaE (Proxy @choices)+         visited <- gets (enumName `elem`)+         if visited+            then pure $ Tagged $ ASch.NamedType enumName+            else do modify (enumName :)+                    pure $ Tagged $ ASch.mkEnum enumName [] Nothing choicesNames+ instance HasAvroSchema' (FieldValue sch t)          => HasAvroSchema' (Term sch ('DSimple t)) where-  typeName' _ = []-  schema' visited = coerce $ schema' @(FieldValue sch t) visited+  schema' = coerce <$> schema' @(FieldValue sch t)  instance HasAvroSchema' (FieldValue sch 'TNull) where-  typeName' _ = []-  schema' _ = Tagged ASch.Null+  schema' = pure $ Tagged ASch.Null instance A.HasAvroSchema t          => HasAvroSchema' (FieldValue sch ('TPrimitive t)) where-  typeName' _ = []-  schema' _ = coerce $ A.schema @t+  schema' = pure $ coerce $ A.schema @t instance (HasAvroSchema' (Term sch (sch :/: t)))          => HasAvroSchema' (FieldValue sch ('TSchematic t)) where-  typeName' _ = []-  schema' visited = coerce $ schema' @(Term sch (sch :/: t)) visited+  schema' = coerce <$> schema' @(Term sch (sch :/: t)) instance forall sch choices.          HasAvroSchemaUnion (FieldValue sch) choices          => HasAvroSchema' (FieldValue sch ('TUnion choices)) where-  typeName' _ = []-  schema' visited-    = Tagged $ ASch.mkUnion $ schemaU (Proxy @(FieldValue sch)) (Proxy @choices) visited+  schema' = do+    schs <- schemaU (Proxy @(FieldValue sch)) (Proxy @choices)+    pure $ Tagged $ ASch.mkUnion schs instance HasAvroSchema' (FieldValue sch t)          => HasAvroSchema' (FieldValue sch ('TOption t)) where-  typeName' _ = []-  schema' visited-    = Tagged $ ASch.mkUnion $ ASch.Null :| [iSchema]-    where iSchema = unTagged $ schema' @(FieldValue sch t) visited+  schema' = do+    iSchema <- unTagged <$> schema' @(FieldValue sch t)+    pure $ Tagged $ ASch.mkUnion $ ASch.Null :| [iSchema] instance HasAvroSchema' (FieldValue sch t)          => HasAvroSchema' (FieldValue sch ('TList t)) where-  typeName' _ = []-  schema' visited-    = Tagged $ ASch.Array iSchema-    where iSchema = unTagged $ schema' @(FieldValue sch t) visited+  schema' = do+    iSchema <- unTagged <$> schema' @(FieldValue sch t)+    pure $ Tagged $ ASch.Array iSchema -- These are the only two versions of Map supported by the library instance HasAvroSchema' (FieldValue sch v)          => HasAvroSchema' (FieldValue sch ('TMap ('TPrimitive T.Text) v)) where-  typeName' _ = []-  schema' visited-    = Tagged $ ASch.Map iSchema-    where iSchema = unTagged $ schema' @(FieldValue sch v) visited+  schema' = do+    iSchema <- unTagged <$> schema' @(FieldValue sch v)+    pure $ Tagged $ ASch.Map iSchema instance HasAvroSchema' (FieldValue sch v)          => HasAvroSchema' (FieldValue sch ('TMap ('TPrimitive String) v)) where-  typeName' _ = []-  schema' visited-    = Tagged $ ASch.Map iSchema-    where iSchema = unTagged $ schema' @(FieldValue sch v) visited+  schema' = do+    iSchema <- unTagged <$> schema' @(FieldValue sch v)+    pure $ Tagged $ ASch.Map iSchema  class HasAvroSchemaUnion (f :: k -> *) (xs :: [k]) where-  schemaU :: Proxy f -> Proxy xs -> [ASch.TypeName] -> NonEmpty ASch.Schema+  schemaU :: Proxy f -> Proxy xs -> State [ASch.TypeName] (NonEmpty ASch.Schema) instance HasAvroSchema' (f v) => HasAvroSchemaUnion f '[v] where-  schemaU _ _ visited = vSchema :| []-    where vSchema = unTagged (schema' @(f v) visited)+  schemaU _ _ = do+    vSchema <- unTagged <$> schema' @(f v)+    pure $ vSchema :| [] instance (HasAvroSchema' (f x), HasAvroSchemaUnion f (y ': zs))          => HasAvroSchemaUnion f (x ': y ': zs) where-  schemaU p _ visited = xSchema :| NonEmptyList.toList yzsSchema-    where xSchema = unTagged (schema' @(f x) visited)-          yzsSchema = schemaU p (Proxy @(y ': zs)) visited+  schemaU p _ = do+    xSchema   <- unTagged <$> schema' @(f x)+    yzsSchema <- schemaU p (Proxy @(y ': zs))+    pure $ xSchema :| NonEmptyList.toList yzsSchema  class HasAvroSchemaFields sch (fs :: [FieldDef tn fn]) where-  schemaF :: Proxy sch -> Proxy fs -> [ASch.TypeName] -> [ASch.Field]+  schemaF :: Proxy sch -> Proxy fs -> State [ASch.TypeName] [ASch.Field] instance HasAvroSchemaFields sch '[] where-  schemaF _ _ _ = []+  schemaF _ _ = pure [] instance (KnownName name, HasAvroSchema' (FieldValue sch t), HasAvroSchemaFields sch fs)          => HasAvroSchemaFields sch ('FieldDef name t ': fs) where-  schemaF psch _ visited = schemaThis : schemaF psch (Proxy @fs) visited-    where fieldName = nameText (Proxy @name)-          schemaT = unTagged $ schema' @(FieldValue sch t) visited-          schemaThis = ASch.Field fieldName [] Nothing Nothing schemaT Nothing+  schemaF psch _ = do+    let fieldName = nameText (Proxy @name)+    schemaT <- unTagged <$> schema' @(FieldValue sch t)+    let schemaThis = ASch.Field fieldName [] Nothing Nothing schemaT Nothing+    rest <- schemaF psch (Proxy @fs)+    pure $ schemaThis : rest  class HasAvroSchemaEnum (fs :: [ChoiceDef fn]) where   schemaE :: Proxy fs -> [T.Text]@@ -317,7 +287,8 @@     = A.record s $ toAvroF fields   -- if we don't have a record, fall back to the one from schema   toAvro _ (TRecord fields)-    = A.record (unTagged $ schema' @(Term sch ('DRecord name args)) []) $ toAvroF fields+    = A.record sch (toAvroF fields)+    where sch = unTagged $ evalState (schema' @(Term sch ('DRecord name args))) [] instance (KnownName name, ToAvroEnum choices, HasAvroSchemaEnum choices)           => A.ToAvro (Term sch ('DEnum name choices)) where   toAvro ASch.Enum { ASch.symbols = ss } (TEnum n)

@@ -1,4 +1,5 @@ {-# language DataKinds         #-}+{-# language KindSignatures    #-} {-# language LambdaCase        #-} {-# language NamedFieldPuns    #-} {-# language OverloadedStrings #-}@@ -39,6 +40,7 @@ import           Data.Time.Millis import           Data.UUID import qualified Data.Vector                as V+import           GHC.TypeLits import           Language.Avro.Parser import qualified Language.Avro.Types        as A import           Language.Haskell.TH@@ -88,12 +90,12 @@        schemaDec <- tySynD schemaName' [] (schemaFromAvro $ S.toList (A.types protocol))        serviceDec <- tySynD serviceName' []          [t| 'Package $(pkgType (A.ns protocol))-                '[ 'Service $(textToStrLit (A.pname protocol)) '[]+                '[ 'Service $(textToStrLit (A.pname protocol))                             $(typesToList <$> mapM (avroMethodToType schemaName')                             (S.toList $ A.messages protocol)) ] |]        pure [schemaDec, serviceDec]   where-    pkgType Nothing = [t| 'Nothing |]+    pkgType Nothing = [t| ('Nothing :: Maybe Symbol) |]     pkgType (Just (A.Namespace p))                     = [t| 'Just $(textToStrLit (T.intercalate "." p)) |] @@ -176,13 +178,13 @@  avroMethodToType :: Name -> A.Method -> Q Type avroMethodToType schemaName m-  = [t| 'Method $(textToStrLit (A.mname 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 'Nothing '[] ('SchemaRef $(conT schemaName) $(textToStrLit (A.baseName a))) |]+      = [t| 'ArgSingle ('Nothing :: Maybe Symbol) ('SchemaRef $(conT schemaName) $(textToStrLit (A.baseName a))) |]     argToType (A.Argument _ _)       = fail "only named types may be used as arguments" @@ -195,7 +197,7 @@       = fail "only named types may be used as results"  typesToList :: [Type] -> Type-typesToList = foldr (\y ys -> AppT (AppT PromotedConsT y) ys) PromotedNilT+typesToList = foldr (AppT . AppT PromotedConsT) PromotedNilT  textToStrLit :: T.Text -> Q Type textToStrLit s = litT $ strTyLit $ T.unpack s

@@ -1,6 +1,9 @@-{-# language CPP         #-}-{-# language DataKinds   #-}-{-# language QuasiQuotes #-}+{-# language CPP             #-}+{-# language DataKinds       #-}+{-# language KindSignatures  #-}+{-# language QuasiQuotes     #-}+{-# language TemplateHaskell #-}+ {-| Description : Examples for Avro quasi-quoters @@ -8,7 +11,7 @@ -} module Mu.Quasi.Avro.Example where -import           Mu.Quasi.Avro (avro, avroFile)+import           Mu.Quasi.Avro (avdl, avro, avroFile)  type Example = [avro| {@@ -44,4 +47,10 @@ type ExampleFromFile = [avroFile|adapter/avro/test/avro/example.avsc|] #else type ExampleFromFile = [avroFile|test/avro/example.avsc|]+#endif++#if __GHCIDE__+avdl "ExampleProtocol" "ExampleService" "." "adapter/avro/test/avro/example.avdl"+#else+avdl "ExampleProtocol" "ExampleService" "." "test/avro/example.avdl" #endif

@@ -1,23 +1,23 @@-[ { "type": "enum",-    "name": "gender",-    "symbols" : ["male", "female", "nb"]-  }-, { "type": "record"-  , "name": "address"-  , "fields": [-      {"name": "postcode", "type": "string"},-      {"name": "country", "type": "string"}-    ]-  }-,{ "type": "record",-    "name": "person",-    "fields": [-      {"name": "firstName", "type": "string"},-      {"name": "lastName", "type": "string"},-      {"name": "age",  "type": ["long", "null"]},-      {"name": "gender", "type": ["gender", "null"]},-      {"name": "address", "type": "address"},-      {"name": "lucky_numbers", "type": { "type": "array", "items": "long" } }-    ]-  }-]+{ "type": "record",+  "name": "person",+  "fields": [+    {"name": "firstName", "type": "string"},+    {"name": "lastName", "type": "string"},+    {"name": "age",  "type": ["long", "null"]},+    {"name": "gender", "type": [+      { "type": "enum",+        "name": "gender",+        "symbols" : ["male", "female", "nb"]+      } , "null"]},+    {"name": "address", "type":+      { "type": "record"+        , "name": "address"+        , "fields": [+            {"name": "postcode", "type": "string"},+            {"name": "country", "type": "string"}+          ]+      }+    },+    {"name": "lucky_numbers", "type": { "type": "array", "items": "long" } }+  ]+}