{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language MultiParamTypeClasses #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Mu.Adapter.Avro () where
import Control.Arrow ((***))
import qualified Data.Avro as A
import qualified Data.Avro.Schema as ASch
import qualified Data.Avro.Types.Value as AVal
import Data.Coerce (coerce)
import Data.Functor.Identity
import qualified Data.HashMap.Strict as HM
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmptyList
import qualified Data.Map as M
import Data.Tagged
import qualified Data.Text as T
import qualified Data.Vector as V
import GHC.TypeLits
import Mu.Schema
import qualified Mu.Schema.Interpretation.Schemaless as SLess
instance SLess.ToSchemalessTerm (AVal.Value t) Identity where
toSchemalessTerm :: Value t -> Term Identity
toSchemalessTerm (AVal.Record _ r :: HashMap Text (Value t)
r)
= [Field Identity] -> Term Identity
forall (w :: * -> *). [Field w] -> Term w
SLess.TRecord ([Field Identity] -> Term Identity)
-> [Field Identity] -> Term Identity
forall a b. (a -> b) -> a -> b
$ ((Text, Value t) -> Field Identity)
-> [(Text, Value t)] -> [Field Identity]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: Text
k,v :: Value t
v) -> Text -> Identity (FieldValue Identity) -> Field Identity
forall (w :: * -> *). Text -> w (FieldValue w) -> Field w
SLess.Field Text
k (FieldValue Identity -> Identity (FieldValue Identity)
forall a. a -> Identity a
Identity (FieldValue Identity -> Identity (FieldValue Identity))
-> FieldValue Identity -> Identity (FieldValue Identity)
forall a b. (a -> b) -> a -> b
$ Value t -> FieldValue Identity
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue Value t
v))
([(Text, Value t)] -> [Field Identity])
-> [(Text, Value t)] -> [Field Identity]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Value t) -> [(Text, Value t)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text (Value t)
r
toSchemalessTerm (AVal.Enum _ i :: Int
i _)
= Int -> Term Identity
forall (w :: * -> *). Int -> Term w
SLess.TEnum Int
i
toSchemalessTerm (AVal.Union _ _ v :: Value t
v)
= Value t -> Term Identity
forall t (w :: * -> *). ToSchemalessTerm t w => t -> Term w
SLess.toSchemalessTerm Value t
v
toSchemalessTerm v :: Value t
v = FieldValue Identity -> Term Identity
forall (w :: * -> *). FieldValue w -> Term w
SLess.TSimple (Value t -> FieldValue Identity
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue Value t
v)
instance SLess.ToSchemalessValue (AVal.Value t) Identity where
toSchemalessValue :: Value t -> FieldValue Identity
toSchemalessValue AVal.Null = FieldValue Identity
forall (w :: * -> *). FieldValue w
SLess.FNull
toSchemalessValue (AVal.Boolean b :: Bool
b) = Bool -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Bool
b
toSchemalessValue (AVal.Int b :: Int32
b) = Int32 -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Int32
b
toSchemalessValue (AVal.Long b :: Int64
b) = Int64 -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Int64
b
toSchemalessValue (AVal.Float b :: Float
b) = Float -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Float
b
toSchemalessValue (AVal.Double b :: Double
b) = Double -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Double
b
toSchemalessValue (AVal.String b :: Text
b) = Text -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive Text
b
toSchemalessValue (AVal.Fixed _ b :: ByteString
b) = ByteString -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive ByteString
b
toSchemalessValue (AVal.Bytes b :: ByteString
b) = ByteString -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive ByteString
b
toSchemalessValue (AVal.Array v :: Vector (Value t)
v)
= [FieldValue Identity] -> FieldValue Identity
forall (w :: * -> *). [FieldValue w] -> FieldValue w
SLess.FList ([FieldValue Identity] -> FieldValue Identity)
-> [FieldValue Identity] -> FieldValue Identity
forall a b. (a -> b) -> a -> b
$ (Value t -> FieldValue Identity)
-> [Value t] -> [FieldValue Identity]
forall a b. (a -> b) -> [a] -> [b]
map Value t -> FieldValue Identity
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue ([Value t] -> [FieldValue Identity])
-> [Value t] -> [FieldValue Identity]
forall a b. (a -> b) -> a -> b
$ Vector (Value t) -> [Value t]
forall a. Vector a -> [a]
V.toList Vector (Value t)
v
toSchemalessValue (AVal.Map hm :: HashMap Text (Value t)
hm)
= Map (FieldValue Identity) (FieldValue Identity)
-> FieldValue Identity
forall (w :: * -> *).
Map (FieldValue w) (FieldValue w) -> FieldValue w
SLess.FMap (Map (FieldValue Identity) (FieldValue Identity)
-> FieldValue Identity)
-> Map (FieldValue Identity) (FieldValue Identity)
-> FieldValue Identity
forall a b. (a -> b) -> a -> b
$ [(FieldValue Identity, FieldValue Identity)]
-> Map (FieldValue Identity) (FieldValue Identity)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(FieldValue Identity, FieldValue Identity)]
-> Map (FieldValue Identity) (FieldValue Identity))
-> [(FieldValue Identity, FieldValue Identity)]
-> Map (FieldValue Identity) (FieldValue Identity)
forall a b. (a -> b) -> a -> b
$ ((Text, Value t) -> (FieldValue Identity, FieldValue Identity))
-> [(Text, Value t)]
-> [(FieldValue Identity, FieldValue Identity)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> FieldValue Identity
forall t (w :: * -> *).
(Typeable t, Eq t, Ord t, Show t) =>
t -> FieldValue w
SLess.FPrimitive (Text -> FieldValue Identity)
-> (Value t -> FieldValue Identity)
-> (Text, Value t)
-> (FieldValue Identity, FieldValue Identity)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Value t -> FieldValue Identity
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue)
([(Text, Value t)] -> [(FieldValue Identity, FieldValue Identity)])
-> [(Text, Value t)]
-> [(FieldValue Identity, FieldValue Identity)]
forall a b. (a -> b) -> a -> b
$ HashMap Text (Value t) -> [(Text, Value t)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text (Value t)
hm
toSchemalessValue (AVal.Union _ _ v :: Value t
v)
= Value t -> FieldValue Identity
forall t (w :: * -> *). ToSchemalessValue t w => t -> FieldValue w
SLess.toSchemalessValue Value t
v
toSchemalessValue r :: Value t
r@(AVal.Record _ _)
= Term Identity -> FieldValue Identity
forall (w :: * -> *). Term w -> FieldValue w
SLess.FSchematic (Value t -> Term Identity
forall t (w :: * -> *). ToSchemalessTerm t w => t -> Term w
SLess.toSchemalessTerm Value t
r)
toSchemalessValue e :: Value t
e@AVal.Enum {}
= Term Identity -> FieldValue Identity
forall (w :: * -> *). Term w -> FieldValue w
SLess.FSchematic (Value t -> Term Identity
forall t (w :: * -> *). ToSchemalessTerm t w => t -> Term w
SLess.toSchemalessTerm Value t
e)
instance A.HasAvroSchema (Term f sch (sch :/: sty))
=> A.HasAvroSchema (WithSchema f sch sty t) where
schema :: Tagged (WithSchema f sch sty t) Schema
schema = Tagged (Term f sch (sch :/: sty)) Schema
-> Tagged (WithSchema f sch sty t) Schema
forall a b. Coercible a b => a -> b
coerce (Tagged (Term f sch (sch :/: sty)) Schema
-> Tagged (WithSchema f sch sty t) Schema)
-> Tagged (Term f sch (sch :/: sty)) Schema
-> Tagged (WithSchema f sch sty t) Schema
forall a b. (a -> b) -> a -> b
$ HasAvroSchema (Term f sch (sch :/: sty)) =>
Tagged (Term f sch (sch :/: sty)) Schema
forall a. HasAvroSchema a => Tagged a Schema
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 :: Value Schema -> Result (WithSchema f sch sty t)
fromAvro v :: Value Schema
v = t -> WithSchema f sch sty t
forall tn fn (w :: * -> *) (sch :: Schema tn fn) (sty :: tn) a.
a -> WithSchema w sch sty a
WithSchema (t -> WithSchema f sch sty t)
-> (Term f sch (sch :/: sty) -> t)
-> Term f sch (sch :/: sty)
-> WithSchema f sch sty t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (sty :: tn).
FromSchema f sch sty t =>
Term f sch (sch :/: sty) -> t
forall fn tn (sch :: Schema tn fn) (w :: * -> *) t (sty :: tn).
FromSchema w sch sty t =>
Term w sch (sch :/: sty) -> t
fromSchema' @_ @_ @sch @f (Term f sch (sch :/: sty) -> WithSchema f sch sty t)
-> Result (Term f sch (sch :/: sty))
-> Result (WithSchema f sch sty t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (Term f sch (sch :/: sty))
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
instance ( ToSchema Identity sch sty t
, A.ToAvro (Term Identity sch (sch :/: sty)) )
=> A.ToAvro (WithSchema Identity sch sty t) where
toAvro :: WithSchema Identity sch sty t -> Value Schema
toAvro (WithSchema v :: t
v) = Term Identity sch (sch :/: sty) -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro (t -> Term Identity sch (sch :/: sty)
forall fn tn (sch :: Schema tn fn) (w :: * -> *) t (sty :: tn).
ToSchema w sch sty t =>
t -> Term w sch (sch :/: sty)
toSchema' @_ @_ @sch @Identity t
v)
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 :: Tagged (Term f sch t) Schema
schema = [TypeName] -> Tagged (Term f sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' []
instance HasAvroSchema' (FieldValue f sch t)
=> A.HasAvroSchema (FieldValue f sch t) where
schema :: Tagged (FieldValue f sch t) Schema
schema = [TypeName] -> Tagged (FieldValue f sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' []
instance (KnownName name, HasAvroSchemaFields sch args)
=> HasAvroSchema' (Term f sch ('DRecord name args)) where
schema' :: [TypeName] -> Tagged (Term f sch ('DRecord name args)) Schema
schema' visited :: [TypeName]
visited
= if TypeName
recordName TypeName -> [TypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TypeName]
visited
then Schema -> Tagged (Term f sch ('DRecord name args)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (Term f sch ('DRecord name args)) Schema)
-> Schema -> Tagged (Term f sch ('DRecord name args)) Schema
forall a b. (a -> b) -> a -> b
$ TypeName -> Schema
ASch.NamedType TypeName
recordName
else Schema -> Tagged (Term f sch ('DRecord name args)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (Term f sch ('DRecord name args)) Schema)
-> Schema -> Tagged (Term f sch ('DRecord name args)) Schema
forall a b. (a -> b) -> a -> b
$ TypeName
-> [TypeName] -> Maybe Text -> Maybe Order -> [Field] -> Schema
ASch.Record TypeName
recordName [] Maybe Text
forall a. Maybe a
Nothing Maybe Order
forall a. Maybe a
Nothing [Field]
fields
where recordName :: TypeName
recordName = Proxy name -> TypeName
forall k (s :: k) (proxy :: k -> *).
KnownName s =>
proxy s -> TypeName
nameTypeName (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
fields :: [Field]
fields = Proxy sch -> Proxy args -> [TypeName] -> [Field]
forall k tn fn (sch :: k) (fs :: [FieldDef tn fn]).
HasAvroSchemaFields sch fs =>
Proxy sch -> Proxy fs -> [TypeName] -> [Field]
schemaF (Proxy sch
forall k (t :: k). Proxy t
Proxy @sch) (Proxy args
forall k (t :: k). Proxy t
Proxy @args) [TypeName]
visited
instance (KnownName name, HasAvroSchemaEnum choices)
=> HasAvroSchema' (Term f sch ('DEnum name choices)) where
schema' :: [TypeName] -> Tagged (Term f sch ('DEnum name choices)) Schema
schema' visited :: [TypeName]
visited
= if TypeName
enumName TypeName -> [TypeName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TypeName]
visited
then Schema -> Tagged (Term f sch ('DEnum name choices)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (Term f sch ('DEnum name choices)) Schema)
-> Schema -> Tagged (Term f sch ('DEnum name choices)) Schema
forall a b. (a -> b) -> a -> b
$ TypeName -> Schema
ASch.NamedType TypeName
enumName
else Schema -> Tagged (Term f sch ('DEnum name choices)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (Term f sch ('DEnum name choices)) Schema)
-> Schema -> Tagged (Term f sch ('DEnum name choices)) Schema
forall a b. (a -> b) -> a -> b
$ TypeName -> [TypeName] -> Maybe Text -> [Text] -> Schema
ASch.mkEnum TypeName
enumName [] Maybe Text
forall a. Maybe a
Nothing [Text]
choicesNames
where enumName :: TypeName
enumName = Proxy name -> TypeName
forall k (s :: k) (proxy :: k -> *).
KnownName s =>
proxy s -> TypeName
nameTypeName (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
choicesNames :: [Text]
choicesNames = Proxy choices -> [Text]
forall fn (fs :: [ChoiceDef fn]).
HasAvroSchemaEnum fs =>
Proxy fs -> [Text]
schemaE (Proxy choices
forall k (t :: k). Proxy t
Proxy @choices)
instance HasAvroSchema' (FieldValue f sch t)
=> HasAvroSchema' (Term f sch ('DSimple t)) where
schema' :: [TypeName] -> Tagged (Term f sch ('DSimple t)) Schema
schema' visited :: [TypeName]
visited = Tagged (FieldValue f sch t) Schema
-> Tagged (Term f sch ('DSimple t)) Schema
forall a b. Coercible a b => a -> b
coerce (Tagged (FieldValue f sch t) Schema
-> Tagged (Term f sch ('DSimple t)) Schema)
-> Tagged (FieldValue f sch t) Schema
-> Tagged (Term f sch ('DSimple t)) Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue f sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue f sch t) [TypeName]
visited
instance HasAvroSchema' (FieldValue f sch 'TNull) where
schema' :: [TypeName] -> Tagged (FieldValue f sch 'TNull) Schema
schema' _ = Schema -> Tagged (FieldValue f sch 'TNull) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged Schema
ASch.Null
instance A.HasAvroSchema t
=> HasAvroSchema' (FieldValue f sch ('TPrimitive t)) where
schema' :: [TypeName] -> Tagged (FieldValue f sch ('TPrimitive t)) Schema
schema' _ = Tagged t Schema -> Tagged (FieldValue f sch ('TPrimitive t)) Schema
forall a b. Coercible a b => a -> b
coerce (Tagged t Schema
-> Tagged (FieldValue f sch ('TPrimitive t)) Schema)
-> Tagged t Schema
-> Tagged (FieldValue f sch ('TPrimitive t)) Schema
forall a b. (a -> b) -> a -> b
$ HasAvroSchema t => Tagged t Schema
forall a. HasAvroSchema a => Tagged a Schema
A.schema @t
instance (HasAvroSchema' (Term f sch (sch :/: t)))
=> HasAvroSchema' (FieldValue f sch ('TSchematic t)) where
schema' :: [TypeName] -> Tagged (FieldValue f sch ('TSchematic t)) Schema
schema' visited :: [TypeName]
visited = Tagged (Term f sch (sch :/: t)) Schema
-> Tagged (FieldValue f sch ('TSchematic t)) Schema
forall a b. Coercible a b => a -> b
coerce (Tagged (Term f sch (sch :/: t)) Schema
-> Tagged (FieldValue f sch ('TSchematic t)) Schema)
-> Tagged (Term f sch (sch :/: t)) Schema
-> Tagged (FieldValue f sch ('TSchematic t)) Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (Term f sch (sch :/: t)) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(Term f sch (sch :/: t)) [TypeName]
visited
instance forall sch f choices.
HasAvroSchemaUnion (FieldValue f sch) choices
=> HasAvroSchema' (FieldValue f sch ('TUnion choices)) where
schema' :: [TypeName] -> Tagged (FieldValue f sch ('TUnion choices)) Schema
schema' visited :: [TypeName]
visited
= Schema -> Tagged (FieldValue f sch ('TUnion choices)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (FieldValue f sch ('TUnion choices)) Schema)
-> Schema -> Tagged (FieldValue f sch ('TUnion choices)) Schema
forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
ASch.mkUnion (NonEmpty Schema -> Schema) -> NonEmpty Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Proxy (FieldValue f sch)
-> Proxy choices -> [TypeName] -> NonEmpty Schema
forall k (f :: k -> *) (xs :: [k]).
HasAvroSchemaUnion f xs =>
Proxy f -> Proxy xs -> [TypeName] -> NonEmpty Schema
schemaU (Proxy (FieldValue f sch)
forall k (t :: k). Proxy t
Proxy @(FieldValue f sch)) (Proxy choices
forall k (t :: k). Proxy t
Proxy @choices) [TypeName]
visited
instance HasAvroSchema' (FieldValue f sch t)
=> HasAvroSchema' (FieldValue f sch ('TOption t)) where
schema' :: [TypeName] -> Tagged (FieldValue f sch ('TOption t)) Schema
schema' visited :: [TypeName]
visited
= Schema -> Tagged (FieldValue f sch ('TOption t)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (FieldValue f sch ('TOption t)) Schema)
-> Schema -> Tagged (FieldValue f sch ('TOption t)) Schema
forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
ASch.mkUnion (NonEmpty Schema -> Schema) -> NonEmpty Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema
ASch.Null Schema -> [Schema] -> NonEmpty Schema
forall a. a -> [a] -> NonEmpty a
:| [Schema
iSchema]
where iSchema :: Schema
iSchema = Tagged (FieldValue f sch t) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged (FieldValue f sch t) Schema -> Schema)
-> Tagged (FieldValue f sch t) Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue f sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue f sch t) [TypeName]
visited
instance HasAvroSchema' (FieldValue f sch t)
=> HasAvroSchema' (FieldValue f sch ('TList t)) where
schema' :: [TypeName] -> Tagged (FieldValue f sch ('TList t)) Schema
schema' visited :: [TypeName]
visited
= Schema -> Tagged (FieldValue f sch ('TList t)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema -> Tagged (FieldValue f sch ('TList t)) Schema)
-> Schema -> Tagged (FieldValue f sch ('TList t)) Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
ASch.Array Schema
iSchema
where iSchema :: Schema
iSchema = Tagged (FieldValue f sch t) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged (FieldValue f sch t) Schema -> Schema)
-> Tagged (FieldValue f sch t) Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue f sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue f sch t) [TypeName]
visited
instance HasAvroSchema' (FieldValue f sch v)
=> HasAvroSchema' (FieldValue f sch ('TMap ('TPrimitive T.Text) v)) where
schema' :: [TypeName]
-> Tagged (FieldValue f sch ('TMap ('TPrimitive Text) v)) Schema
schema' visited :: [TypeName]
visited
= Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive Text) v)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive Text) v)) Schema)
-> Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive Text) v)) Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
ASch.Map Schema
iSchema
where iSchema :: Schema
iSchema = Tagged (FieldValue f sch v) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged (FieldValue f sch v) Schema -> Schema)
-> Tagged (FieldValue f sch v) Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue f sch v) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue f sch v) [TypeName]
visited
instance HasAvroSchema' (FieldValue f sch v)
=> HasAvroSchema' (FieldValue f sch ('TMap ('TPrimitive String) v)) where
schema' :: [TypeName]
-> Tagged (FieldValue f sch ('TMap ('TPrimitive String) v)) Schema
schema' visited :: [TypeName]
visited
= Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive String) v)) Schema
forall k (s :: k) b. b -> Tagged s b
Tagged (Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive String) v)) Schema)
-> Schema
-> Tagged (FieldValue f sch ('TMap ('TPrimitive String) v)) Schema
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
ASch.Map Schema
iSchema
where iSchema :: Schema
iSchema = Tagged (FieldValue f sch v) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged (FieldValue f sch v) Schema -> Schema)
-> Tagged (FieldValue f sch v) Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue f sch v) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue f sch v) [TypeName]
visited
class HasAvroSchemaUnion (f :: k -> *) (xs :: [k]) where
schemaU :: Proxy f -> Proxy xs -> [ASch.TypeName] -> NonEmpty ASch.Type
instance HasAvroSchema' (f v) => HasAvroSchemaUnion f '[v] where
schemaU :: Proxy f -> Proxy '[v] -> [TypeName] -> NonEmpty Schema
schemaU _ _ visited :: [TypeName]
visited = Schema
vSchema Schema -> [Schema] -> NonEmpty Schema
forall a. a -> [a] -> NonEmpty a
:| []
where vSchema :: Schema
vSchema = Tagged (f v) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged ([TypeName] -> Tagged (f v) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(f v) [TypeName]
visited)
instance (HasAvroSchema' (f x), HasAvroSchemaUnion f (y ': zs))
=> HasAvroSchemaUnion f (x ': y ': zs) where
schemaU :: Proxy f -> Proxy (x : y : zs) -> [TypeName] -> NonEmpty Schema
schemaU p :: Proxy f
p _ visited :: [TypeName]
visited = Schema
xSchema Schema -> [Schema] -> NonEmpty Schema
forall a. a -> [a] -> NonEmpty a
:| NonEmpty Schema -> [Schema]
forall a. NonEmpty a -> [a]
NonEmptyList.toList NonEmpty Schema
yzsSchema
where xSchema :: Schema
xSchema = Tagged (f x) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged ([TypeName] -> Tagged (f x) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(f x) [TypeName]
visited)
yzsSchema :: NonEmpty Schema
yzsSchema = Proxy f -> Proxy (y : zs) -> [TypeName] -> NonEmpty Schema
forall k (f :: k -> *) (xs :: [k]).
HasAvroSchemaUnion f xs =>
Proxy f -> Proxy xs -> [TypeName] -> NonEmpty Schema
schemaU Proxy f
p (Proxy (y : zs)
forall k (t :: k). Proxy t
Proxy @(y ': zs)) [TypeName]
visited
class HasAvroSchemaFields sch (fs :: [FieldDef tn fn]) where
schemaF :: Proxy sch -> Proxy fs -> [ASch.TypeName] -> [ASch.Field]
instance HasAvroSchemaFields sch '[] where
schemaF :: Proxy sch -> Proxy '[] -> [TypeName] -> [Field]
schemaF _ _ _ = []
instance (KnownName name, HasAvroSchema' (FieldValue Identity sch t), HasAvroSchemaFields sch fs)
=> HasAvroSchemaFields sch ('FieldDef name t ': fs) where
schemaF :: Proxy sch -> Proxy ('FieldDef name t : fs) -> [TypeName] -> [Field]
schemaF psch :: Proxy sch
psch _ visited :: [TypeName]
visited = Field
schemaThis Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
: Proxy sch -> Proxy fs -> [TypeName] -> [Field]
forall k tn fn (sch :: k) (fs :: [FieldDef tn fn]).
HasAvroSchemaFields sch fs =>
Proxy sch -> Proxy fs -> [TypeName] -> [Field]
schemaF Proxy sch
psch (Proxy fs
forall k (t :: k). Proxy t
Proxy @fs) [TypeName]
visited
where fieldName :: Text
fieldName = Proxy name -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
schemaT :: Schema
schemaT = Tagged (FieldValue Identity sch t) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged (FieldValue Identity sch t) Schema -> Schema)
-> Tagged (FieldValue Identity sch t) Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeName] -> Tagged (FieldValue Identity sch t) Schema
forall k (x :: k).
HasAvroSchema' x =>
[TypeName] -> Tagged x Schema
schema' @(FieldValue Identity sch t) [TypeName]
visited
schemaThis :: Field
schemaThis = Text
-> [Text]
-> Maybe Text
-> Maybe Order
-> Schema
-> Maybe (Value Schema)
-> Field
ASch.Field Text
fieldName [] Maybe Text
forall a. Maybe a
Nothing Maybe Order
forall a. Maybe a
Nothing Schema
schemaT Maybe (Value Schema)
forall a. Maybe a
Nothing
class HasAvroSchemaEnum (fs :: [ChoiceDef fn]) where
schemaE :: Proxy fs -> [T.Text]
instance HasAvroSchemaEnum '[] where
schemaE :: Proxy '[] -> [Text]
schemaE _ = []
instance (KnownName name, HasAvroSchemaEnum fs)
=> HasAvroSchemaEnum ('ChoiceDef name ': fs) where
schemaE :: Proxy ('ChoiceDef name : fs) -> [Text]
schemaE _ = Proxy name -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText (Proxy name
forall k (t :: k). Proxy t
Proxy @name) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Proxy fs -> [Text]
forall fn (fs :: [ChoiceDef fn]).
HasAvroSchemaEnum fs =>
Proxy fs -> [Text]
schemaE (Proxy fs
forall k (t :: k). Proxy t
Proxy @fs)
instance (KnownName name, HasAvroSchemaFields sch args, FromAvroFields f sch args)
=> A.FromAvro (Term f sch ('DRecord name args)) where
fromAvro :: Value Schema -> Result (Term f sch ('DRecord name args))
fromAvro (AVal.Record _ fields :: HashMap Text (Value Schema)
fields) = NP (Field f sch) args -> Term f sch ('DRecord name args)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName)
(args :: [FieldDef typeName fieldName]) (name :: typeName).
NP (Field w sch) args -> Term w sch ('DRecord name args)
TRecord (NP (Field f sch) args -> Term f sch ('DRecord name args))
-> Result (NP (Field f sch) args)
-> Result (Term f sch ('DRecord name args))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Value Schema) -> Result (NP (Field f sch) args)
forall (f :: * -> *) (sch :: Schema Symbol Symbol)
(fs :: [FieldDef Symbol Symbol]).
FromAvroFields f sch fs =>
HashMap Text (Value Schema) -> Result (NP (Field f sch) fs)
fromAvroF HashMap Text (Value Schema)
fields
fromAvro v :: Value Schema
v = Value Schema -> String -> Result (Term f sch ('DRecord name args))
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "record"
instance (KnownName name, HasAvroSchemaEnum choices, FromAvroEnum choices)
=> A.FromAvro (Term f sch ('DEnum name choices)) where
fromAvro :: Value Schema -> Result (Term f sch ('DEnum name choices))
fromAvro v :: Value Schema
v@(AVal.Enum _ n :: Int
n _) = NS Proxy choices -> Term f sch ('DEnum name choices)
forall fieldName typeName (choices :: [ChoiceDef fieldName])
(w :: * -> *) (sch :: Schema typeName fieldName)
(name :: typeName).
NS Proxy choices -> Term w sch ('DEnum name choices)
TEnum (NS Proxy choices -> Term f sch ('DEnum name choices))
-> Result (NS Proxy choices)
-> Result (Term f sch ('DEnum name choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Int -> Result (NS Proxy choices)
forall fn (vs :: [ChoiceDef fn]).
FromAvroEnum vs =>
Value Schema -> Int -> Result (NS Proxy vs)
fromAvroEnum Value Schema
v Int
n
fromAvro v :: Value Schema
v = Value Schema -> String -> Result (Term f sch ('DEnum name choices))
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "enum"
instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))
=> A.FromAvro (Term f sch ('DSimple t)) where
fromAvro :: Value Schema -> Result (Term f sch ('DSimple t))
fromAvro v :: Value Schema
v = FieldValue f sch t -> Term f sch ('DSimple t)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (t1 :: FieldType typeName).
FieldValue w sch t1 -> Term w sch ('DSimple t1)
TSimple (FieldValue f sch t -> Term f sch ('DSimple t))
-> Result (FieldValue f sch t) -> Result (Term f sch ('DSimple t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (FieldValue f sch t)
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
instance A.FromAvro (FieldValue f sch 'TNull) where
fromAvro :: Value Schema -> Result (FieldValue f sch 'TNull)
fromAvro AVal.Null = FieldValue f sch 'TNull -> Result (FieldValue f sch 'TNull)
forall (m :: * -> *) a. Monad m => a -> m a
return FieldValue f sch 'TNull
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName).
FieldValue w sch 'TNull
FNull
fromAvro v :: Value Schema
v = Value Schema -> String -> Result (FieldValue f sch 'TNull)
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "null"
instance A.FromAvro t => A.FromAvro (FieldValue f sch ('TPrimitive t)) where
fromAvro :: Value Schema -> Result (FieldValue f sch ('TPrimitive t))
fromAvro v :: Value Schema
v = t -> FieldValue f sch ('TPrimitive t)
forall typeName fieldName t1 (w :: * -> *)
(sch :: Schema typeName fieldName).
t1 -> FieldValue w sch ('TPrimitive t1)
FPrimitive (t -> FieldValue f sch ('TPrimitive t))
-> Result t -> Result (FieldValue f sch ('TPrimitive t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result t
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
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 :: Value Schema -> Result (FieldValue f sch ('TSchematic t))
fromAvro v :: Value Schema
v = Term f sch (sch :/: t) -> FieldValue f sch ('TSchematic t)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (t1 :: typeName).
Term w sch (sch :/: t1) -> FieldValue w sch ('TSchematic t1)
FSchematic (Term f sch (sch :/: t) -> FieldValue f sch ('TSchematic t))
-> Result (Term f sch (sch :/: t))
-> Result (FieldValue f sch ('TSchematic t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (Term f sch (sch :/: t))
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
instance (HasAvroSchemaUnion (FieldValue f sch) choices, FromAvroUnion f sch choices)
=> A.FromAvro (FieldValue f sch ('TUnion choices)) where
fromAvro :: Value Schema -> Result (FieldValue f sch ('TUnion choices))
fromAvro (AVal.Union _ branch :: Schema
branch v :: Value Schema
v) = NS (FieldValue f sch) choices -> FieldValue f sch ('TUnion choices)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName)
(choices :: [FieldType typeName]).
NS (FieldValue w sch) choices -> FieldValue w sch ('TUnion choices)
FUnion (NS (FieldValue f sch) choices
-> FieldValue f sch ('TUnion choices))
-> Result (NS (FieldValue f sch) choices)
-> Result (FieldValue f sch ('TUnion choices))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> Value Schema -> Result (NS (FieldValue f sch) choices)
forall typeName fieldName (f :: * -> *)
(sch :: Schema typeName fieldName)
(choices :: [FieldType typeName]).
FromAvroUnion f sch choices =>
Schema -> Value Schema -> Result (NS (FieldValue f sch) choices)
fromAvroU Schema
branch Value Schema
v
fromAvro v :: Value Schema
v = Value Schema
-> String -> Result (FieldValue f sch ('TUnion choices))
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "union"
instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))
=> A.FromAvro (FieldValue f sch ('TOption t)) where
fromAvro :: Value Schema -> Result (FieldValue f sch ('TOption t))
fromAvro v :: Value Schema
v = Maybe (FieldValue f sch t) -> FieldValue f sch ('TOption t)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (t1 :: FieldType typeName).
Maybe (FieldValue w sch t1) -> FieldValue w sch ('TOption t1)
FOption (Maybe (FieldValue f sch t) -> FieldValue f sch ('TOption t))
-> Result (Maybe (FieldValue f sch t))
-> Result (FieldValue f sch ('TOption t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (Maybe (FieldValue f sch t))
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
instance (HasAvroSchema' (FieldValue f sch t), A.FromAvro (FieldValue f sch t))
=> A.FromAvro (FieldValue f sch ('TList t)) where
fromAvro :: Value Schema -> Result (FieldValue f sch ('TList t))
fromAvro v :: Value Schema
v = [FieldValue f sch t] -> FieldValue f sch ('TList t)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (t1 :: FieldType typeName).
[FieldValue w sch t1] -> FieldValue w sch ('TList t1)
FList ([FieldValue f sch t] -> FieldValue f sch ('TList t))
-> Result [FieldValue f sch t]
-> Result (FieldValue f sch ('TList t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result [FieldValue f sch t]
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
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 :: Value Schema
-> Result (FieldValue f sch ('TMap ('TPrimitive Text) v))
fromAvro v :: Value Schema
v = Map (FieldValue f sch ('TPrimitive Text)) (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive Text) v)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (k :: FieldType typeName)
(v :: FieldType typeName).
Ord (FieldValue w sch k) =>
Map (FieldValue w sch k) (FieldValue w sch v)
-> FieldValue w sch ('TMap k v)
FMap (Map (FieldValue f sch ('TPrimitive Text)) (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive Text) v))
-> (Map Text (FieldValue f sch v)
-> Map (FieldValue f sch ('TPrimitive Text)) (FieldValue f sch v))
-> Map Text (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive Text) v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FieldValue f sch ('TPrimitive Text))
-> Map Text (FieldValue f sch v)
-> Map (FieldValue f sch ('TPrimitive Text)) (FieldValue f sch v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Text -> FieldValue f sch ('TPrimitive Text)
forall typeName fieldName t1 (w :: * -> *)
(sch :: Schema typeName fieldName).
t1 -> FieldValue w sch ('TPrimitive t1)
FPrimitive (Map Text (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive Text) v))
-> Result (Map Text (FieldValue f sch v))
-> Result (FieldValue f sch ('TMap ('TPrimitive Text) v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (Map Text (FieldValue f sch v))
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
instance (HasAvroSchema' (FieldValue f sch v), A.FromAvro (FieldValue f sch v))
=> A.FromAvro (FieldValue f sch ('TMap ('TPrimitive String) v)) where
fromAvro :: Value Schema
-> Result (FieldValue f sch ('TMap ('TPrimitive String) v))
fromAvro v :: Value Schema
v = Map (FieldValue f sch ('TPrimitive String)) (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive String) v)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (k :: FieldType typeName)
(v :: FieldType typeName).
Ord (FieldValue w sch k) =>
Map (FieldValue w sch k) (FieldValue w sch v)
-> FieldValue w sch ('TMap k v)
FMap (Map (FieldValue f sch ('TPrimitive String)) (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive String) v))
-> (Map Text (FieldValue f sch v)
-> Map
(FieldValue f sch ('TPrimitive String)) (FieldValue f sch v))
-> Map Text (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive String) v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FieldValue f sch ('TPrimitive String))
-> Map Text (FieldValue f sch v)
-> Map (FieldValue f sch ('TPrimitive String)) (FieldValue f sch v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (String -> FieldValue f sch ('TPrimitive String)
forall typeName fieldName t1 (w :: * -> *)
(sch :: Schema typeName fieldName).
t1 -> FieldValue w sch ('TPrimitive t1)
FPrimitive (String -> FieldValue f sch ('TPrimitive String))
-> (Text -> String)
-> Text
-> FieldValue f sch ('TPrimitive String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Map Text (FieldValue f sch v)
-> FieldValue f sch ('TMap ('TPrimitive String) v))
-> Result (Map Text (FieldValue f sch v))
-> Result (FieldValue f sch ('TMap ('TPrimitive String) v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (Map Text (FieldValue f sch v))
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
class FromAvroEnum (vs :: [ChoiceDef fn]) where
fromAvroEnum :: AVal.Value ASch.Type -> Int -> A.Result (NS Proxy vs)
instance FromAvroEnum '[] where
fromAvroEnum :: Value Schema -> Int -> Result (NS Proxy '[])
fromAvroEnum v :: Value Schema
v _ = Value Schema -> String -> Result (NS Proxy '[])
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "element not found"
instance FromAvroEnum vs => FromAvroEnum (v ': vs) where
fromAvroEnum :: Value Schema -> Int -> Result (NS Proxy (v : vs))
fromAvroEnum _ 0 = NS Proxy (v : vs) -> Result (NS Proxy (v : vs))
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy v -> NS Proxy (v : vs)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z Proxy v
forall k (t :: k). Proxy t
Proxy)
fromAvroEnum v :: Value Schema
v n :: Int
n = NS Proxy vs -> NS Proxy (v : vs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS Proxy vs -> NS Proxy (v : vs))
-> Result (NS Proxy vs) -> Result (NS Proxy (v : vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Int -> Result (NS Proxy vs)
forall fn (vs :: [ChoiceDef fn]).
FromAvroEnum vs =>
Value Schema -> Int -> Result (NS Proxy vs)
fromAvroEnum Value Schema
v (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
class FromAvroUnion f sch choices where
fromAvroU :: ASch.Type -> AVal.Value ASch.Type -> ASch.Result (NS (FieldValue f sch) choices)
instance FromAvroUnion f sch '[] where
fromAvroU :: Schema -> Value Schema -> Result (NS (FieldValue f sch) '[])
fromAvroU _ v :: Value Schema
v = Value Schema -> String -> Result (NS (FieldValue f sch) '[])
forall t a. Show t => t -> String -> Result a
A.badValue Value Schema
v "union choice not found"
instance (A.FromAvro (FieldValue f sch u), FromAvroUnion f sch us)
=> FromAvroUnion f sch (u ': us) where
fromAvroU :: Schema -> Value Schema -> Result (NS (FieldValue f sch) (u : us))
fromAvroU branch :: Schema
branch v :: Value Schema
v
| Schema -> Schema -> Bool
ASch.matches Schema
branch (Tagged (FieldValue f sch u) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (HasAvroSchema (FieldValue f sch u) =>
Tagged (FieldValue f sch u) Schema
forall a. HasAvroSchema a => Tagged a Schema
A.schema @(FieldValue f sch u)))
= FieldValue f sch u -> NS (FieldValue f sch) (u : us)
forall k (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (FieldValue f sch u -> NS (FieldValue f sch) (u : us))
-> Result (FieldValue f sch u)
-> Result (NS (FieldValue f sch) (u : us))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (FieldValue f sch u)
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
v
| Bool
otherwise
= NS (FieldValue f sch) us -> NS (FieldValue f sch) (u : us)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (NS (FieldValue f sch) us -> NS (FieldValue f sch) (u : us))
-> Result (NS (FieldValue f sch) us)
-> Result (NS (FieldValue f sch) (u : us))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> Value Schema -> Result (NS (FieldValue f sch) us)
forall typeName fieldName (f :: * -> *)
(sch :: Schema typeName fieldName)
(choices :: [FieldType typeName]).
FromAvroUnion f sch choices =>
Schema -> Value Schema -> Result (NS (FieldValue f sch) choices)
fromAvroU Schema
branch Value Schema
v
class FromAvroFields f sch (fs :: [FieldDef Symbol Symbol]) where
fromAvroF :: HM.HashMap T.Text (AVal.Value ASch.Type) -> A.Result (NP (Field f sch) fs)
instance FromAvroFields f sch '[] where
fromAvroF :: HashMap Text (Value Schema) -> Result (NP (Field f sch) '[])
fromAvroF _ = NP (Field f sch) '[] -> Result (NP (Field f sch) '[])
forall (m :: * -> *) a. Monad m => a -> m a
return NP (Field f sch) '[]
forall k (a :: k -> *). NP a '[]
Nil
instance (Applicative f, KnownName name, A.FromAvro (FieldValue f sch t), FromAvroFields f sch fs)
=> FromAvroFields f sch ('FieldDef name t ': fs) where
fromAvroF :: HashMap Text (Value Schema)
-> Result (NP (Field f sch) ('FieldDef name t : fs))
fromAvroF v :: HashMap Text (Value Schema)
v = case Text -> HashMap Text (Value Schema) -> Maybe (Value Schema)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
fieldName HashMap Text (Value Schema)
v of
Nothing -> HashMap Text (Value Schema)
-> String -> Result (NP (Field f sch) ('FieldDef name t : fs))
forall t a. Show t => t -> String -> Result a
A.badValue HashMap Text (Value Schema)
v "field not found"
Just f :: Value Schema
f -> Field f sch ('FieldDef name t)
-> NP (Field f sch) fs -> NP (Field f sch) ('FieldDef name t : fs)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (Field f sch ('FieldDef name t)
-> NP (Field f sch) fs -> NP (Field f sch) ('FieldDef name t : fs))
-> Result (Field f sch ('FieldDef name t))
-> Result
(NP (Field f sch) fs -> NP (Field f sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f (FieldValue f sch t) -> Field f sch ('FieldDef name t)
forall typeName fieldName (w :: * -> *)
(sch :: Schema typeName fieldName) (t :: FieldType typeName)
(name :: fieldName).
w (FieldValue w sch t) -> Field w sch ('FieldDef name t)
Field (f (FieldValue f sch t) -> Field f sch ('FieldDef name t))
-> (FieldValue f sch t -> f (FieldValue f sch t))
-> FieldValue f sch t
-> Field f sch ('FieldDef name t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldValue f sch t -> f (FieldValue f sch t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue f sch t -> Field f sch ('FieldDef name t))
-> Result (FieldValue f sch t)
-> Result (Field f sch ('FieldDef name t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Schema -> Result (FieldValue f sch t)
forall a. FromAvro a => Value Schema -> Result a
A.fromAvro Value Schema
f) Result
(NP (Field f sch) fs -> NP (Field f sch) ('FieldDef name t : fs))
-> Result (NP (Field f sch) fs)
-> Result (NP (Field f sch) ('FieldDef name t : fs))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text (Value Schema) -> Result (NP (Field f sch) fs)
forall (f :: * -> *) (sch :: Schema Symbol Symbol)
(fs :: [FieldDef Symbol Symbol]).
FromAvroFields f sch fs =>
HashMap Text (Value Schema) -> Result (NP (Field f sch) fs)
fromAvroF HashMap Text (Value Schema)
v
where fieldName :: Text
fieldName = Proxy name -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
instance (KnownName name, HasAvroSchemaFields sch args, ToAvroFields sch args)
=> A.ToAvro (Term Identity sch ('DRecord name args)) where
toAvro :: Term Identity sch ('DRecord name args) -> Value Schema
toAvro (TRecord fields :: NP (Field Identity sch) args
fields) = Schema -> HashMap Text (Value Schema) -> Value Schema
forall f. f -> HashMap Text (Value f) -> Value f
AVal.Record Schema
wholeSchema (NP (Field Identity sch) args -> HashMap Text (Value Schema)
forall (sch :: Schema Symbol Symbol)
(fs :: [FieldDef Symbol Symbol]).
ToAvroFields sch fs =>
NP (Field Identity sch) fs -> HashMap Text (Value Schema)
toAvroF NP (Field Identity sch) args
fields)
where wholeSchema :: Schema
wholeSchema = Tagged (Term Identity sch ('DRecord name args)) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (HasAvroSchema (Term Identity sch ('DRecord name args)) =>
Tagged (Term Identity sch ('DRecord name args)) Schema
forall a. HasAvroSchema a => Tagged a Schema
A.schema @(Term Identity sch ('DRecord name args)))
instance (KnownName name, HasAvroSchemaEnum choices, ToAvroEnum choices)
=> A.ToAvro (Term Identity sch ('DEnum name choices)) where
toAvro :: Term Identity sch ('DEnum name choices) -> Value Schema
toAvro (TEnum n :: NS Proxy choices
n) = Schema -> Int -> Text -> Value Schema
forall f. f -> Int -> Text -> Value f
AVal.Enum Schema
wholeSchema Int
choice Text
text
where wholeSchema :: Schema
wholeSchema = Tagged (Term Identity sch ('DEnum name choices)) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (HasAvroSchema (Term Identity sch ('DEnum name choices)) =>
Tagged (Term Identity sch ('DEnum name choices)) Schema
forall a. HasAvroSchema a => Tagged a Schema
A.schema @(Term Identity sch ('DEnum name choices)))
(choice :: Int
choice, text :: Text
text) = NS Proxy choices -> (Int, Text)
forall k (choices :: [k]).
ToAvroEnum choices =>
NS Proxy choices -> (Int, Text)
toAvroE NS Proxy choices
n
instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))
=> A.ToAvro (Term Identity sch ('DSimple t)) where
toAvro :: Term Identity sch ('DSimple t) -> Value Schema
toAvro (TSimple v :: FieldValue Identity sch t1
v) = FieldValue Identity sch t1 -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro FieldValue Identity sch t1
v
instance A.ToAvro (FieldValue Identity sch 'TNull) where
toAvro :: FieldValue Identity sch 'TNull -> Value Schema
toAvro FNull = Value Schema
forall f. Value f
AVal.Null
instance A.ToAvro t => A.ToAvro (FieldValue Identity sch ('TPrimitive t)) where
toAvro :: FieldValue Identity sch ('TPrimitive t) -> Value Schema
toAvro (FPrimitive v :: t1
v) = t1 -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro t1
v
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 :: FieldValue Identity sch ('TSchematic t) -> Value Schema
toAvro (FSchematic v :: Term Identity sch (sch :/: t1)
v) = Term Identity sch (sch :/: t) -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro Term Identity sch (sch :/: t)
Term Identity sch (sch :/: t1)
v
instance forall sch choices.
(HasAvroSchemaUnion (FieldValue Identity sch) choices, ToAvroUnion sch choices)
=> A.ToAvro (FieldValue Identity sch ('TUnion choices)) where
toAvro :: FieldValue Identity sch ('TUnion choices) -> Value Schema
toAvro (FUnion v :: NS (FieldValue Identity sch) choices
v) = Vector Schema -> Schema -> Value Schema -> Value Schema
forall f. Vector f -> f -> Value f -> Value f
AVal.Union Vector Schema
wholeSchema' Schema
chosenTy Value Schema
chosenVal
where wholeSchema :: NonEmpty Schema
wholeSchema = Proxy (FieldValue Identity sch)
-> Proxy choices -> [TypeName] -> NonEmpty Schema
forall k (f :: k -> *) (xs :: [k]).
HasAvroSchemaUnion f xs =>
Proxy f -> Proxy xs -> [TypeName] -> NonEmpty Schema
schemaU (Proxy (FieldValue Identity sch)
forall k (t :: k). Proxy t
Proxy @(FieldValue Identity sch)) (Proxy choices
forall k (t :: k). Proxy t
Proxy @choices) []
wholeSchema' :: Vector Schema
wholeSchema' = [Schema] -> Vector Schema
forall a. [a] -> Vector a
V.fromList (NonEmpty Schema -> [Schema]
forall a. NonEmpty a -> [a]
NonEmptyList.toList NonEmpty Schema
wholeSchema)
(chosenTy :: Schema
chosenTy, chosenVal :: Value Schema
chosenVal) = NS (FieldValue Identity sch) choices -> (Schema, Value Schema)
forall typeName fieldName (sch :: Schema typeName fieldName)
(choices :: [FieldType typeName]).
ToAvroUnion sch choices =>
NS (FieldValue Identity sch) choices -> (Schema, Value Schema)
toAvroU NS (FieldValue Identity sch) choices
v
instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))
=> A.ToAvro (FieldValue Identity sch ('TOption t)) where
toAvro :: FieldValue Identity sch ('TOption t) -> Value Schema
toAvro (FOption v :: Maybe (FieldValue Identity sch t1)
v) = Maybe (FieldValue Identity sch t1) -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro Maybe (FieldValue Identity sch t1)
v
instance (HasAvroSchema' (FieldValue Identity sch t), A.ToAvro (FieldValue Identity sch t))
=> A.ToAvro (FieldValue Identity sch ('TList t)) where
toAvro :: FieldValue Identity sch ('TList t) -> Value Schema
toAvro (FList v :: [FieldValue Identity sch t1]
v) = Vector (Value Schema) -> Value Schema
forall f. Vector (Value f) -> Value f
AVal.Array (Vector (Value Schema) -> Value Schema)
-> Vector (Value Schema) -> Value Schema
forall a b. (a -> b) -> a -> b
$ [Value Schema] -> Vector (Value Schema)
forall a. [a] -> Vector a
V.fromList ([Value Schema] -> Vector (Value Schema))
-> [Value Schema] -> Vector (Value Schema)
forall a b. (a -> b) -> a -> b
$ FieldValue Identity sch t1 -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro (FieldValue Identity sch t1 -> Value Schema)
-> [FieldValue Identity sch t1] -> [Value Schema]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldValue Identity sch t1]
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 :: FieldValue Identity sch ('TMap ('TPrimitive Text) v)
-> Value Schema
toAvro (FMap v :: Map (FieldValue Identity sch k) (FieldValue Identity sch v)
v) = Map Text (FieldValue Identity sch v) -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro (Map Text (FieldValue Identity sch v) -> Value Schema)
-> Map Text (FieldValue Identity sch v) -> Value Schema
forall a b. (a -> b) -> a -> b
$ (FieldValue Identity sch k -> Text)
-> Map (FieldValue Identity sch k) (FieldValue Identity sch v)
-> Map Text (FieldValue Identity sch v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\(FPrimitive k :: t1
k) -> t1
Text
k) Map (FieldValue Identity sch k) (FieldValue Identity sch v)
v
instance (HasAvroSchema' (FieldValue Identity sch v), A.ToAvro (FieldValue Identity sch v))
=> A.ToAvro (FieldValue Identity sch ('TMap ('TPrimitive String) v)) where
toAvro :: FieldValue Identity sch ('TMap ('TPrimitive String) v)
-> Value Schema
toAvro (FMap v :: Map (FieldValue Identity sch k) (FieldValue Identity sch v)
v) = Map String (FieldValue Identity sch v) -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro (Map String (FieldValue Identity sch v) -> Value Schema)
-> Map String (FieldValue Identity sch v) -> Value Schema
forall a b. (a -> b) -> a -> b
$ (FieldValue Identity sch k -> String)
-> Map (FieldValue Identity sch k) (FieldValue Identity sch v)
-> Map String (FieldValue Identity sch v)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (\(FPrimitive k :: t1
k) -> t1
String
k) Map (FieldValue Identity sch k) (FieldValue Identity sch v)
v
class ToAvroUnion sch choices where
toAvroU :: NS (FieldValue Identity sch) choices -> (ASch.Type, AVal.Value ASch.Type)
instance ToAvroUnion sch '[] where
toAvroU :: NS (FieldValue Identity sch) '[] -> (Schema, Value Schema)
toAvroU _ = String -> (Schema, Value Schema)
forall a. HasCallStack => String -> a
error "ToAvro in an empty union"
instance forall sch u us.
(A.ToAvro (FieldValue Identity sch u), ToAvroUnion sch us)
=> ToAvroUnion sch (u ': us) where
toAvroU :: NS (FieldValue Identity sch) (u : us) -> (Schema, Value Schema)
toAvroU (Z v :: FieldValue Identity sch x
v) = (Tagged (FieldValue Identity sch u) Schema -> Schema
forall k (s :: k) b. Tagged s b -> b
unTagged (HasAvroSchema (FieldValue Identity sch u) =>
Tagged (FieldValue Identity sch u) Schema
forall a. HasAvroSchema a => Tagged a Schema
A.schema @(FieldValue Identity sch u)), FieldValue Identity sch x -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro FieldValue Identity sch x
v)
toAvroU (S n :: NS (FieldValue Identity sch) xs
n) = NS (FieldValue Identity sch) xs -> (Schema, Value Schema)
forall typeName fieldName (sch :: Schema typeName fieldName)
(choices :: [FieldType typeName]).
ToAvroUnion sch choices =>
NS (FieldValue Identity sch) choices -> (Schema, Value Schema)
toAvroU NS (FieldValue Identity sch) xs
n
class ToAvroEnum choices where
toAvroE :: NS Proxy choices -> (Int, T.Text)
instance ToAvroEnum '[] where
toAvroE :: NS Proxy '[] -> (Int, Text)
toAvroE = String -> NS Proxy '[] -> (Int, Text)
forall a. HasCallStack => String -> a
error "ToAvro in an empty enum"
instance (KnownName u, ToAvroEnum us)
=> ToAvroEnum ('ChoiceDef u ': us) where
toAvroE :: NS Proxy ('ChoiceDef u : us) -> (Int, Text)
toAvroE (Z _) = (0, Proxy u -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText (Proxy u
forall k (t :: k). Proxy t
Proxy @u))
toAvroE (S v :: NS Proxy xs
v) = let (n :: Int
n, t :: Text
t) = NS Proxy xs -> (Int, Text)
forall k (choices :: [k]).
ToAvroEnum choices =>
NS Proxy choices -> (Int, Text)
toAvroE NS Proxy xs
v in (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Text
t)
class ToAvroFields sch (fs :: [FieldDef Symbol Symbol]) where
toAvroF :: NP (Field Identity sch) fs -> HM.HashMap T.Text (AVal.Value ASch.Type)
instance ToAvroFields sch '[] where
toAvroF :: NP (Field Identity sch) '[] -> HashMap Text (Value Schema)
toAvroF _ = HashMap Text (Value Schema)
forall k v. HashMap k v
HM.empty
instance (KnownName name, A.ToAvro (FieldValue Identity sch t), ToAvroFields sch fs)
=> ToAvroFields sch ('FieldDef name t ': fs) where
toAvroF :: NP (Field Identity sch) ('FieldDef name t : fs)
-> HashMap Text (Value Schema)
toAvroF (Field (Identity v :: FieldValue Identity sch t
v) :* rest :: NP (Field Identity sch) xs
rest) = Text
-> Value Schema
-> HashMap Text (Value Schema)
-> HashMap Text (Value Schema)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
fieldName Value Schema
fieldValue (NP (Field Identity sch) xs -> HashMap Text (Value Schema)
forall (sch :: Schema Symbol Symbol)
(fs :: [FieldDef Symbol Symbol]).
ToAvroFields sch fs =>
NP (Field Identity sch) fs -> HashMap Text (Value Schema)
toAvroF NP (Field Identity sch) xs
rest)
where fieldName :: Text
fieldName = Proxy name -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText (Proxy name
forall k (t :: k). Proxy t
Proxy @name)
fieldValue :: Value Schema
fieldValue = FieldValue Identity sch t -> Value Schema
forall a. ToAvro a => a -> Value Schema
A.toAvro FieldValue Identity sch t
v
nameText :: KnownName s => proxy s -> T.Text
nameText :: proxy s -> Text
nameText = String -> Text
T.pack (String -> Text) -> (proxy s -> String) -> proxy s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy s -> String
forall k (a :: k) (proxy :: k -> *).
KnownName a =>
proxy a -> String
nameVal
nameTypeName :: KnownName s => proxy s -> ASch.TypeName
nameTypeName :: proxy s -> TypeName
nameTypeName = Text -> TypeName
ASch.parseFullname (Text -> TypeName) -> (proxy s -> Text) -> proxy s -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy s -> Text
forall k (s :: k) (proxy :: k -> *). KnownName s => proxy s -> Text
nameText