{-# 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 #-}
{-|
Description : Adapter for Avro serialization

Just import the module and you can turn any
value with a 'ToSchema' and 'FromSchema' from
and to Avro values.
-}
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
-- 'Tagged . unTagged' can be replaced by 'coerce'
-- eliminating some run-time overhead
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)

-- 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 :: 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
-- These are the only two versions of Map supported by the library
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)

-- FromAvro instances

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
-- These are the only two versions of Map supported by the library
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)

-- ToAvro instances

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
-- These are the only two versions of Map supported by the library
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

-- Conversion of symbols to other things
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