Use newer Avro parser to support decimals (#109)

adapter/avro/mu-avro.cabal

@@ -36,6 +36,8 @@ library
                      , bytestring
                      , template-haskell >= 2.12
                      , language-avro
+                     , uuid
+                     , time
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall

adapter/avro/src/Mu/Quasi/Avro.hs

@@ -29,10 +29,13 @@ module Mu.Quasi.Avro (
 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.Text                  as T
+import           Data.Time
+import           Data.UUID
 import           Data.Vector                (fromList, toList)
 import           Language.Avro.Parser
 import qualified Language.Avro.Types        as A
@@ -91,11 +94,11 @@ avdlToDecls schemaName serviceName protocol
     pkgType (Just (A.Namespace p))
                     = [t| '[ Package $(textToStrLit (T.intercalate "." p)) ] |]
 
-schemaFromAvro :: [A.Type] -> Q Type
+schemaFromAvro :: [A.Schema] -> Q Type
 schemaFromAvro =
   (typesToList <$>) . mapM schemaDecFromAvroType . flattenAvroDecls
 
-schemaDecFromAvroType :: A.Type -> Q Type
+schemaDecFromAvroType :: A.Schema -> Q Type
 schemaDecFromAvroType (A.Record name _ _ _ fields) =
   [t|'DRecord $(textToStrLit $ A.baseName name)
               $(typesToList <$> mapM avroFieldToType fields)|]
@@ -113,17 +116,22 @@ schemaDecFromAvroType (A.Enum name _ _ symbols) =
 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 _ -> [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 ->
@@ -139,16 +147,16 @@ schemaFromAvroType =
       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)
@@ -157,7 +165,7 @@ flattenAvroDecls = concatMap (uncurry (:) . flattenDecl)
        in (A.Union $ 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)
@@ -174,7 +182,7 @@ avroMethodToType schemaName m
     argToType (A.Argument _ _)
       = fail "only named types may be used as arguments"
 
-    retToType :: A.Type -> Q Type
+    retToType :: A.Schema -> Q Type
     retToType A.Null
       = [t| 'RetNothing |]
     retToType (A.NamedType a)

stack-nightly.yaml

@@ -28,8 +28,13 @@ extra-deps:
 - http2-grpc-proto3-wire-0.1.0.0
 - warp-grpc-0.3.0.0
 - http2-client-grpc-0.8.0.0
-- avro-0.4.6.0
+# - avro-0.4.6.0
+- git: https://github.com/haskell-works/avro.git
+  commit: 93bc12fdb807e9567ef113ed71c7b3487516a371
 - language-protobuf-1.0.1
-- language-avro-0.1.0.0
+# - language-avro-0.1.0.0
+- git: https://github.com/higherkindness/avro-parser-haskell.git
+  commit: c8f7497766d0d1be8579fb03b302340adafeaf49
 - hw-kafka-client-3.0.0
 - hw-kafka-conduit-2.6.0
+- HasBigDecimal-0.1.1

stack.yaml

@@ -28,9 +28,16 @@ extra-deps:
 - http2-grpc-proto3-wire-0.1.0.0
 - warp-grpc-0.3.0.0
 - http2-client-grpc-0.8.0.0
-- avro-0.4.6.0
+# - avro-0.4.6.0
+- git: https://github.com/haskell-works/avro.git
+  commit: 93bc12fdb807e9567ef113ed71c7b3487516a371
 - language-protobuf-1.0.1
-- language-avro-0.1.0.0
+# - language-avro-0.1.0.0
+- git: https://github.com/higherkindness/avro-parser-haskell.git
+  commit: c8f7497766d0d1be8579fb03b302340adafeaf49
+- hw-kafka-client-3.0.0
+- hw-kafka-conduit-2.6.0
+- HasBigDecimal-0.1.1
 # missing in the current LTS
 - primitive-0.7.0.0
 - primitive-extras-0.8
@@ -40,5 +47,4 @@ extra-deps:
 - AC-Angle-1.0
 - optics-core-0.2
 - indexed-profunctors-0.1
-- hw-kafka-client-3.0.0
-- hw-kafka-conduit-2.6.0
+