module Hydra.Langs.Avro.Coder (
  AvroEnvironment(..),
  AvroHydraAdapter(..),
  AvroQualifiedName(..),
  avroHydraAdapter,
  emptyAvroEnvironment,
) where

import Hydra.Kernel
import Hydra.Langs.Json.Eliminate
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Dsl.Expect as Expect
import qualified Hydra.Dsl.Types as Types
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Langs.Avro.Schema as Avro
import qualified Hydra.Json as Json

import qualified Text.Read as TR
import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


data AvroEnvironment = AvroEnvironment {
  AvroEnvironment -> Map AvroQualifiedName AvroHydraAdapter
avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName AvroHydraAdapter,
  AvroEnvironment -> Maybe String
avroEnvironmentNamespace :: Maybe String,
  AvroEnvironment -> Map Name Element
avroEnvironmentElements :: M.Map Name Element} -- note: only used in the term coders
type AvroHydraAdapter = Adapter AvroEnvironment AvroEnvironment Avro.Schema Type Json.Value Term

data AvroQualifiedName = AvroQualifiedName (Maybe String) String deriving (AvroQualifiedName -> AvroQualifiedName -> Bool
(AvroQualifiedName -> AvroQualifiedName -> Bool)
-> (AvroQualifiedName -> AvroQualifiedName -> Bool)
-> Eq AvroQualifiedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AvroQualifiedName -> AvroQualifiedName -> Bool
== :: AvroQualifiedName -> AvroQualifiedName -> Bool
$c/= :: AvroQualifiedName -> AvroQualifiedName -> Bool
/= :: AvroQualifiedName -> AvroQualifiedName -> Bool
Eq, Eq AvroQualifiedName
Eq AvroQualifiedName =>
(AvroQualifiedName -> AvroQualifiedName -> Ordering)
-> (AvroQualifiedName -> AvroQualifiedName -> Bool)
-> (AvroQualifiedName -> AvroQualifiedName -> Bool)
-> (AvroQualifiedName -> AvroQualifiedName -> Bool)
-> (AvroQualifiedName -> AvroQualifiedName -> Bool)
-> (AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName)
-> (AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName)
-> Ord AvroQualifiedName
AvroQualifiedName -> AvroQualifiedName -> Bool
AvroQualifiedName -> AvroQualifiedName -> Ordering
AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AvroQualifiedName -> AvroQualifiedName -> Ordering
compare :: AvroQualifiedName -> AvroQualifiedName -> Ordering
$c< :: AvroQualifiedName -> AvroQualifiedName -> Bool
< :: AvroQualifiedName -> AvroQualifiedName -> Bool
$c<= :: AvroQualifiedName -> AvroQualifiedName -> Bool
<= :: AvroQualifiedName -> AvroQualifiedName -> Bool
$c> :: AvroQualifiedName -> AvroQualifiedName -> Bool
> :: AvroQualifiedName -> AvroQualifiedName -> Bool
$c>= :: AvroQualifiedName -> AvroQualifiedName -> Bool
>= :: AvroQualifiedName -> AvroQualifiedName -> Bool
$cmax :: AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName
max :: AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName
$cmin :: AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName
min :: AvroQualifiedName -> AvroQualifiedName -> AvroQualifiedName
Ord, Int -> AvroQualifiedName -> ShowS
[AvroQualifiedName] -> ShowS
AvroQualifiedName -> String
(Int -> AvroQualifiedName -> ShowS)
-> (AvroQualifiedName -> String)
-> ([AvroQualifiedName] -> ShowS)
-> Show AvroQualifiedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AvroQualifiedName -> ShowS
showsPrec :: Int -> AvroQualifiedName -> ShowS
$cshow :: AvroQualifiedName -> String
show :: AvroQualifiedName -> String
$cshowList :: [AvroQualifiedName] -> ShowS
showList :: [AvroQualifiedName] -> ShowS
Show)

data ForeignKey = ForeignKey Name (String -> Name)

data PrimaryKey = PrimaryKey Name (String -> Name)

emptyAvroEnvironment :: AvroEnvironment
emptyAvroEnvironment = Map AvroQualifiedName AvroHydraAdapter
-> Maybe String -> Map Name Element -> AvroEnvironment
AvroEnvironment Map AvroQualifiedName AvroHydraAdapter
forall k a. Map k a
M.empty Maybe String
forall a. Maybe a
Nothing Map Name Element
forall k a. Map k a
M.empty

avro_foreignKey :: String
avro_foreignKey = String
"@foreignKey"
avro_primaryKey :: String
avro_primaryKey = String
"@primaryKey"

avroHydraAdapter :: Avro.Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter :: Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter Schema
schema = case Schema
schema of
    Avro.SchemaArray (Avro.Array Schema
s) -> do
      AvroHydraAdapter
ad <- Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter Schema
s
      let coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
            coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \(Json.ValueArray [Value]
vals) -> [Term] -> Term
Terms.list ([Term] -> Term)
-> Flow AvroEnvironment [Term] -> Flow AvroEnvironment Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value -> Flow AvroEnvironment Term)
-> [Value] -> Flow AvroEnvironment [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Coder AvroEnvironment AvroEnvironment Value Term
-> Value -> Flow AvroEnvironment Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (Coder AvroEnvironment AvroEnvironment Value Term
 -> Value -> Flow AvroEnvironment Term)
-> Coder AvroEnvironment AvroEnvironment Value Term
-> Value
-> Flow AvroEnvironment Term
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) [Value]
vals),
            coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = \(TermList [Term]
vals) -> [Value] -> Value
Json.ValueArray ([Value] -> Value)
-> Flow AvroEnvironment [Value] -> Flow AvroEnvironment Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term -> Flow AvroEnvironment Value)
-> [Term] -> Flow AvroEnvironment [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Coder AvroEnvironment AvroEnvironment Value Term
-> Term -> Flow AvroEnvironment Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (Coder AvroEnvironment AvroEnvironment Value Term
 -> Term -> Flow AvroEnvironment Value)
-> Coder AvroEnvironment AvroEnvironment Value Term
-> Term
-> Flow AvroEnvironment Value
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) [Term]
vals)}
      AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> AvroHydraAdapter
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (AvroHydraAdapter -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter
ad) Schema
schema (Type -> Type
Types.list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) Coder AvroEnvironment AvroEnvironment Value Term
coder
    Avro.SchemaMap (Avro.Map_ Schema
s) -> do
      AvroHydraAdapter
ad <- Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter Schema
s
      let pairToHydra :: (String, Value) -> Flow AvroEnvironment (Term, Term)
pairToHydra (String
k, Value
v) = do
            Term
v' <- Coder AvroEnvironment AvroEnvironment Value Term
-> Value -> Flow AvroEnvironment Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Value
v
            (Term, Term) -> Flow AvroEnvironment (Term, Term)
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Term
Terms.string String
k, Term
v')
      let coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
            coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \(Json.ValueObject Map String Value
m) -> Map Term Term -> Term
Terms.map (Map Term Term -> Term)
-> ([(Term, Term)] -> Map Term Term) -> [(Term, Term)] -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Term, Term)] -> Map Term Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Term, Term)] -> Term)
-> Flow AvroEnvironment [(Term, Term)] -> Flow AvroEnvironment Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((String, Value) -> Flow AvroEnvironment (Term, Term))
-> [(String, Value)] -> Flow AvroEnvironment [(Term, Term)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (String, Value) -> Flow AvroEnvironment (Term, Term)
pairToHydra ([(String, Value)] -> Flow AvroEnvironment [(Term, Term)])
-> [(String, Value)] -> Flow AvroEnvironment [(Term, Term)]
forall a b. (a -> b) -> a -> b
$ Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m),
            coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = \Term
m -> Map String Value -> Value
Json.ValueObject (Map String Value -> Value)
-> Flow AvroEnvironment (Map String Value)
-> Flow AvroEnvironment Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> Flow AvroEnvironment String)
-> (Term -> Flow AvroEnvironment Value)
-> Term
-> Flow AvroEnvironment (Map String Value)
forall k s v.
Ord k =>
(Term -> Flow s k)
-> (Term -> Flow s v) -> Term -> Flow s (Map k v)
Expect.map Term -> Flow AvroEnvironment String
forall s. Term -> Flow s String
Expect.string (Coder AvroEnvironment AvroEnvironment Value Term
-> Term -> Flow AvroEnvironment Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad)) Term
m}
      AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> AvroHydraAdapter
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (AvroHydraAdapter -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter
ad) Schema
schema (Type -> Type -> Type
Types.map Type
Types.string (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) Coder AvroEnvironment AvroEnvironment Value Term
coder
    Avro.SchemaNamed Named
n -> do
        let ns :: Maybe String
ns = Named -> Maybe String
Avro.namedNamespace Named
n
        AvroEnvironment
env <- Flow AvroEnvironment AvroEnvironment
forall s. Flow s s
getState

        let manns :: Map String Term
manns = Named -> Map String Term
namedAnnotationsToCore Named
n
        let ann :: Maybe (Map String Term)
ann = if Map String Term -> Bool
forall k a. Map k a -> Bool
M.null Map String Term
manns then Maybe (Map String Term)
forall a. Maybe a
Nothing else (Map String Term -> Maybe (Map String Term)
forall a. a -> Maybe a
Just Map String Term
manns)

        let lastNs :: Maybe String
lastNs = AvroEnvironment -> Maybe String
avroEnvironmentNamespace AvroEnvironment
env
        let nextNs :: Maybe String
nextNs = Maybe String
-> (String -> Maybe String) -> Maybe String -> Maybe String
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe Maybe String
lastNs String -> Maybe String
forall a. a -> Maybe a
Just Maybe String
ns
        AvroEnvironment -> Flow AvroEnvironment ()
forall s. s -> Flow s ()
putState (AvroEnvironment -> Flow AvroEnvironment ())
-> AvroEnvironment -> Flow AvroEnvironment ()
forall a b. (a -> b) -> a -> b
$ AvroEnvironment
env {avroEnvironmentNamespace = nextNs}

        let qname :: AvroQualifiedName
qname = Maybe String -> String -> AvroQualifiedName
AvroQualifiedName Maybe String
nextNs (Named -> String
Avro.namedName Named
n)
        let hydraName :: Name
hydraName = AvroQualifiedName -> Name
avroNameToHydraName AvroQualifiedName
qname

        -- Note: if a named type is redefined (an illegal state for which the Avro spec does not provide a resolution),
        --       we just take the first definition and ignore the second.
        AvroHydraAdapter
ad <- case AvroQualifiedName -> AvroEnvironment -> Maybe AvroHydraAdapter
getAvroHydraAdapter AvroQualifiedName
qname AvroEnvironment
env of
          Just AvroHydraAdapter
ad -> String -> Flow AvroEnvironment AvroHydraAdapter
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment AvroHydraAdapter)
-> String -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ String
"Avro named type defined more than once: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
forall a. Show a => a -> String
show AvroQualifiedName
qname
          Maybe AvroHydraAdapter
Nothing -> do
            AvroHydraAdapter
ad <- case Named -> NamedType
Avro.namedType Named
n of
              Avro.NamedTypeEnum (Avro.Enum_ [String]
syms Maybe String
mdefault) -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
typ Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {m :: * -> *}. Monad m => Term -> m Value
decode  -- TODO: use default value
                where
                  typ :: Type
typ = RowType -> Type
TypeUnion (Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
hydraName Maybe Name
forall a. Maybe a
Nothing ([FieldType] -> RowType) -> [FieldType] -> RowType
forall a b. (a -> b) -> a -> b
$ String -> FieldType
toField (String -> FieldType) -> [String] -> [FieldType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
syms)
                    where
                      toField :: String -> FieldType
toField String
s = Name -> Type -> FieldType
FieldType (String -> Name
Name String
s) Type
Types.unit
                  encode :: Value -> f Term
encode (Json.ValueString String
s) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Injection -> Term
TermUnion (Name -> Field -> Injection
Injection Name
hydraName (Field -> Injection) -> Field -> Injection
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field (String -> Name
Name String
s) Term
Terms.unit)
                  -- Note: we simply trust that data coming from the Hydra side is correct
                  decode :: Term -> m Value
decode (TermUnion (Injection Name
_ (Field Name
fn Term
_))) = Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
fn
              Avro.NamedTypeFixed (Avro.Fixed Int
size) -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.binary Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
                where
                  encode :: Value -> f Term
encode (Json.ValueString String
s) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.binary String
s
                  decode :: Term -> Flow s Value
decode Term
term = String -> Value
Json.ValueString (String -> Value) -> Flow s String -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s String
forall s. Term -> Flow s String
Expect.binary Term
term
              Avro.NamedTypeRecord Record
r -> do
                  let avroFields :: [Field]
avroFields = Record -> [Field]
Avro.recordFields Record
r
                  Map String (Field, AvroHydraAdapter)
adaptersByFieldName <- [(String, (Field, AvroHydraAdapter))]
-> Map String (Field, AvroHydraAdapter)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, (Field, AvroHydraAdapter))]
 -> Map String (Field, AvroHydraAdapter))
-> Flow AvroEnvironment [(String, (Field, AvroHydraAdapter))]
-> Flow AvroEnvironment (Map String (Field, AvroHydraAdapter))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Field -> Flow AvroEnvironment (String, (Field, AvroHydraAdapter)))
-> [Field]
-> Flow AvroEnvironment [(String, (Field, AvroHydraAdapter))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Field -> Flow AvroEnvironment (String, (Field, AvroHydraAdapter))
prepareField [Field]
avroFields)
                  Maybe PrimaryKey
pk <- AvroQualifiedName
-> [Field] -> Flow AvroEnvironment (Maybe PrimaryKey)
forall {a} {s}. Show a => a -> [Field] -> Flow s (Maybe PrimaryKey)
findPrimaryKeyField AvroQualifiedName
qname [Field]
avroFields
                  -- TODO: Nothing values for optional fields
                  let encodePair :: (String, Value) -> Flow AvroEnvironment Field
encodePair (String
k, Value
v) = case String
-> Map String (Field, AvroHydraAdapter)
-> Maybe (Field, AvroHydraAdapter)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Field, AvroHydraAdapter)
adaptersByFieldName of
                        Maybe (Field, AvroHydraAdapter)
Nothing -> String -> Flow AvroEnvironment Field
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment Field)
-> String -> Flow AvroEnvironment Field
forall a b. (a -> b) -> a -> b
$ String
"unrecognized field for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
showQname AvroQualifiedName
qname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
k
                        Just (Field
f, AvroHydraAdapter
ad) -> do
                          Term
v' <- Coder AvroEnvironment AvroEnvironment Value Term
-> Value -> Flow AvroEnvironment Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Value
v
                          Field -> Flow AvroEnvironment Field
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Flow AvroEnvironment Field)
-> Field -> Flow AvroEnvironment Field
forall a b. (a -> b) -> a -> b
$ Name -> Term -> Field
Field (String -> Name
Name String
k) Term
v'
                  let decodeField :: Field -> Flow AvroEnvironment (String, Value)
decodeField (Field (Name String
k) Term
v) = case String
-> Map String (Field, AvroHydraAdapter)
-> Maybe (Field, AvroHydraAdapter)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Field, AvroHydraAdapter)
adaptersByFieldName of
                        Maybe (Field, AvroHydraAdapter)
Nothing -> String -> Flow AvroEnvironment (String, Value)
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment (String, Value))
-> String -> Flow AvroEnvironment (String, Value)
forall a b. (a -> b) -> a -> b
$ String
"unrecognized field for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
showQname AvroQualifiedName
qname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
k
                        Just (Field
f, AvroHydraAdapter
ad) -> do
                          Value
v' <- Coder AvroEnvironment AvroEnvironment Value Term
-> Term -> Flow AvroEnvironment Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Term
v
                          (String, Value) -> Flow AvroEnvironment (String, Value)
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
k, Value
v')
                  let lossy :: Bool
lossy = (Bool -> (Field, AvroHydraAdapter) -> Bool)
-> Bool -> [(Field, AvroHydraAdapter)] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (\Bool
b (Field
_, AvroHydraAdapter
ad) -> Bool
b Bool -> Bool -> Bool
|| AvroHydraAdapter -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter
ad) Bool
False ([(Field, AvroHydraAdapter)] -> Bool)
-> [(Field, AvroHydraAdapter)] -> Bool
forall a b. (a -> b) -> a -> b
$ Map String (Field, AvroHydraAdapter) -> [(Field, AvroHydraAdapter)]
forall k a. Map k a -> [a]
M.elems Map String (Field, AvroHydraAdapter)
adaptersByFieldName
                  let hfields :: [FieldType]
hfields = (Field, AvroHydraAdapter) -> FieldType
forall {s1} {s2} {t1} {v1} {v2}.
(Field, Adapter s1 s2 t1 Type v1 v2) -> FieldType
toHydraField ((Field, AvroHydraAdapter) -> FieldType)
-> [(Field, AvroHydraAdapter)] -> [FieldType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Field, AvroHydraAdapter) -> [(Field, AvroHydraAdapter)]
forall k a. Map k a -> [a]
M.elems Map String (Field, AvroHydraAdapter)
adaptersByFieldName
                  let target :: Type
target = RowType -> Type
TypeRecord (RowType -> Type) -> RowType -> Type
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> [FieldType] -> RowType
RowType Name
hydraName Maybe Name
forall a. Maybe a
Nothing [FieldType]
hfields
                  let coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
                    -- Note: the order of the fields is changed
                    coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \(Json.ValueObject Map String Value
m) -> do
                      [Field]
fields <- ((String, Value) -> Flow AvroEnvironment Field)
-> [(String, Value)] -> Flow AvroEnvironment [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (String, Value) -> Flow AvroEnvironment Field
encodePair ([(String, Value)] -> Flow AvroEnvironment [Field])
-> [(String, Value)] -> Flow AvroEnvironment [Field]
forall a b. (a -> b) -> a -> b
$ Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m
                      let term :: Term
term = Record -> Term
TermRecord (Record -> Term) -> Record -> Term
forall a b. (a -> b) -> a -> b
$ Name -> [Field] -> Record
Record Name
hydraName [Field]
fields
                      Term
-> Type -> Maybe PrimaryKey -> [Field] -> Flow AvroEnvironment ()
forall {p}.
Term -> p -> Maybe PrimaryKey -> [Field] -> Flow AvroEnvironment ()
addElement Term
term Type
target Maybe PrimaryKey
pk [Field]
fields
                      Term -> Flow AvroEnvironment Term
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return Term
term,
                    coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = \(TermRecord (Record Name
_ [Field]
fields)) -> Map String Value -> Value
Json.ValueObject (Map String Value -> Value)
-> ([(String, Value)] -> Map String Value)
-> [(String, Value)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Value)] -> Value)
-> Flow AvroEnvironment [(String, Value)]
-> Flow AvroEnvironment Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Field -> Flow AvroEnvironment (String, Value))
-> [Field] -> Flow AvroEnvironment [(String, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Field -> Flow AvroEnvironment (String, Value)
decodeField [Field]
fields)}
                  AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> AvroHydraAdapter
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
lossy Schema
schema Type
target Coder AvroEnvironment AvroEnvironment Value Term
coder
                where
                  toHydraField :: (Field, Adapter s1 s2 t1 Type v1 v2) -> FieldType
toHydraField (Field
f, Adapter s1 s2 t1 Type v1 v2
ad) = Name -> Type -> FieldType
FieldType (String -> Name
Name (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Field -> String
Avro.fieldName Field
f) (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ Adapter s1 s2 t1 Type v1 v2 -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget Adapter s1 s2 t1 Type v1 v2
ad
            AvroEnvironment
env <- Flow AvroEnvironment AvroEnvironment
forall s. Flow s s
getState
            AvroEnvironment -> Flow AvroEnvironment ()
forall s. s -> Flow s ()
putState (AvroEnvironment -> Flow AvroEnvironment ())
-> AvroEnvironment -> Flow AvroEnvironment ()
forall a b. (a -> b) -> a -> b
$ AvroQualifiedName
-> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment
putAvroHydraAdapter AvroQualifiedName
qname AvroHydraAdapter
ad AvroEnvironment
env
            AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Maybe (Map String Term) -> AvroHydraAdapter -> AvroHydraAdapter
forall {s1} {s2} {t1} {v1} {v2}.
Maybe (Map String Term)
-> Adapter s1 s2 t1 Type v1 v2 -> Adapter s1 s2 t1 Type v1 v2
annotate Maybe (Map String Term)
ann AvroHydraAdapter
ad

        AvroEnvironment
env2 <- Flow AvroEnvironment AvroEnvironment
forall s. Flow s s
getState
        AvroEnvironment -> Flow AvroEnvironment ()
forall s. s -> Flow s ()
putState (AvroEnvironment -> Flow AvroEnvironment ())
-> AvroEnvironment -> Flow AvroEnvironment ()
forall a b. (a -> b) -> a -> b
$ AvroEnvironment
env2 {avroEnvironmentNamespace = lastNs}
        AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return AvroHydraAdapter
ad
      where
        addElement :: Term -> p -> Maybe PrimaryKey -> [Field] -> Flow AvroEnvironment ()
addElement Term
term p
typ Maybe PrimaryKey
pk [Field]
fields = case Maybe PrimaryKey
pk of
          Maybe PrimaryKey
Nothing -> () -> Flow AvroEnvironment ()
forall a. a -> Flow AvroEnvironment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just (PrimaryKey Name
fname String -> Name
constr) -> case (Field -> Bool) -> [Field] -> [Field]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Field -> Bool
isPkField [Field]
fields of
              [] -> () -> Flow AvroEnvironment ()
forall a. a -> Flow AvroEnvironment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              [Field
field] -> do
                  String
s <- Term -> Flow AvroEnvironment String
forall s. Term -> Flow s String
termToString (Term -> Flow AvroEnvironment String)
-> Term -> Flow AvroEnvironment String
forall a b. (a -> b) -> a -> b
$ Field -> Term
fieldTerm Field
field
                  let name :: Name
name = String -> Name
constr String
s
                  let el :: Element
el = Name -> Term -> Element
Element Name
name Term
term
                  AvroEnvironment
env <- Flow AvroEnvironment AvroEnvironment
forall s. Flow s s
getState
                  AvroEnvironment -> Flow AvroEnvironment ()
forall s. s -> Flow s ()
putState (AvroEnvironment -> Flow AvroEnvironment ())
-> AvroEnvironment -> Flow AvroEnvironment ()
forall a b. (a -> b) -> a -> b
$ AvroEnvironment
env {avroEnvironmentElements = M.insert name el (avroEnvironmentElements env)}
                  () -> Flow AvroEnvironment ()
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              [Field]
_ -> String -> Flow AvroEnvironment ()
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment ())
-> String -> Flow AvroEnvironment ()
forall a b. (a -> b) -> a -> b
$ String
"multiple fields named " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
fname
            where
              isPkField :: Field -> Bool
isPkField Field
field = Field -> Name
fieldName Field
field Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fname
        findPrimaryKeyField :: a -> [Field] -> Flow s (Maybe PrimaryKey)
findPrimaryKeyField a
qname [Field]
avroFields = do
          [PrimaryKey]
keys <- [Maybe PrimaryKey] -> [PrimaryKey]
forall a. [Maybe a] -> [a]
Y.catMaybes ([Maybe PrimaryKey] -> [PrimaryKey])
-> Flow s [Maybe PrimaryKey] -> Flow s [PrimaryKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Field -> Flow s (Maybe PrimaryKey))
-> [Field] -> Flow s [Maybe PrimaryKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Field -> Flow s (Maybe PrimaryKey)
forall s. Field -> Flow s (Maybe PrimaryKey)
primaryKey [Field]
avroFields
          case [PrimaryKey]
keys of
            [] -> Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PrimaryKey
forall a. Maybe a
Nothing
            [PrimaryKey
k] -> Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrimaryKey -> Flow s (Maybe PrimaryKey))
-> Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a b. (a -> b) -> a -> b
$ PrimaryKey -> Maybe PrimaryKey
forall a. a -> Maybe a
Just PrimaryKey
k
            [PrimaryKey]
_ -> String -> Flow s (Maybe PrimaryKey)
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s (Maybe PrimaryKey))
-> String -> Flow s (Maybe PrimaryKey)
forall a b. (a -> b) -> a -> b
$ String
"multiple primary key fields for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
qname
        prepareField :: Field -> Flow AvroEnvironment (String, (Field, AvroHydraAdapter))
prepareField Field
f = do
          Maybe ForeignKey
fk <- Field -> Flow AvroEnvironment (Maybe ForeignKey)
forall s. Field -> Flow s (Maybe ForeignKey)
foreignKey Field
f

          let manns :: Map String Term
manns = Field -> Map String Term
fieldAnnotationsToCore Field
f
          let ann :: Maybe (Map String Term)
ann = if Map String Term -> Bool
forall k a. Map k a -> Bool
M.null Map String Term
manns then Maybe (Map String Term)
forall a. Maybe a
Nothing else (Map String Term -> Maybe (Map String Term)
forall a. a -> Maybe a
Just Map String Term
manns)

          AvroHydraAdapter
ad <- case Maybe ForeignKey
fk of
            Maybe ForeignKey
Nothing -> Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter (Schema -> Flow AvroEnvironment AvroHydraAdapter)
-> Schema -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
            Just (ForeignKey Name
name String -> Name
constr) -> do
                AvroHydraAdapter
ad <- Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter (Schema -> Flow AvroEnvironment AvroHydraAdapter)
-> Schema -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
                let decodeTerm :: Term -> Flow AvroEnvironment Value
decodeTerm = \(TermVariable Name
name) -> do -- TODO: not symmetrical
                      Term
term <- Type -> String -> Flow AvroEnvironment Term
forall s. Type -> String -> Flow s Term
stringToTerm (AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) (String -> Flow AvroEnvironment Term)
-> String -> Flow AvroEnvironment Term
forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
name
                      Coder AvroEnvironment AvroEnvironment Value Term
-> Term -> Flow AvroEnvironment Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Term
term
                let encodeValue :: Value -> Flow AvroEnvironment Term
encodeValue Value
v = do
                      String
s <- Coder AvroEnvironment AvroEnvironment Value Term
-> Value -> Flow AvroEnvironment Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Value
v Flow AvroEnvironment Term
-> (Term -> Flow AvroEnvironment String)
-> Flow AvroEnvironment String
forall a b.
Flow AvroEnvironment a
-> (a -> Flow AvroEnvironment b) -> Flow AvroEnvironment b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Term -> Flow AvroEnvironment String
forall s. Term -> Flow s String
termToString
                      Term -> Flow AvroEnvironment Term
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Flow AvroEnvironment Term)
-> Term -> Flow AvroEnvironment Term
forall a b. (a -> b) -> a -> b
$ Name -> Term
TermVariable (Name -> Term) -> Name -> Term
forall a b. (a -> b) -> a -> b
$ String -> Name
constr String
s
                -- Support three special cases of foreign key types: plain, optional, and list
                case Type -> Type
stripType (AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) of
                  TypeOptional (TypeLiteral LiteralType
lit) -> AvroHydraAdapter
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {s1} {s2} {t1} {t2} {v1} {v2} {t2} {s1} {s2}
       {v1} {v2}.
Applicative f =>
Adapter s1 s2 t1 t2 v1 v2
-> t2 -> Coder s1 s2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forTypeAndCoder AvroHydraAdapter
ad (Type -> Type
Types.optional Type
elTyp) Coder AvroEnvironment AvroEnvironment Value Term
coder
                    where
                      coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
                        coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \Value
json -> (Maybe Term -> Term
TermOptional (Maybe Term -> Term) -> (Term -> Maybe Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term
forall a. a -> Maybe a
Just) (Term -> Term)
-> Flow AvroEnvironment Term -> Flow AvroEnvironment Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Flow AvroEnvironment Term
encodeValue Value
json,
                        coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = Term -> Flow AvroEnvironment Value
decodeTerm}
                  TypeList (TypeLiteral LiteralType
lit) -> AvroHydraAdapter
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {s1} {s2} {t1} {t2} {v1} {v2} {t2} {s1} {s2}
       {v1} {v2}.
Applicative f =>
Adapter s1 s2 t1 t2 v1 v2
-> t2 -> Coder s1 s2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forTypeAndCoder AvroHydraAdapter
ad (Type -> Type
Types.list Type
elTyp) Coder AvroEnvironment AvroEnvironment Value Term
coder
                    where
                      coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
                        coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \Value
json -> [Term] -> Term
TermList ([Term] -> Term)
-> Flow AvroEnvironment [Term] -> Flow AvroEnvironment Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Flow AvroEnvironment [Value]
forall s. Value -> Flow s [Value]
expectArray Value
json Flow AvroEnvironment [Value]
-> ([Value] -> Flow AvroEnvironment [Term])
-> Flow AvroEnvironment [Term]
forall a b.
Flow AvroEnvironment a
-> (a -> Flow AvroEnvironment b) -> Flow AvroEnvironment b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Flow AvroEnvironment Term)
-> [Value] -> Flow AvroEnvironment [Term]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Value -> Flow AvroEnvironment Term
encodeValue),
                        coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = Term -> Flow AvroEnvironment Value
decodeTerm}
                  TypeLiteral LiteralType
lit -> AvroHydraAdapter
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {s1} {s2} {t1} {t2} {v1} {v2} {t2} {s1} {s2}
       {v1} {v2}.
Applicative f =>
Adapter s1 s2 t1 t2 v1 v2
-> t2 -> Coder s1 s2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forTypeAndCoder AvroHydraAdapter
ad Type
elTyp Coder AvroEnvironment AvroEnvironment Value Term
coder
                    where
                      coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
                        coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = Value -> Flow AvroEnvironment Term
encodeValue,
                        coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = Term -> Flow AvroEnvironment Value
decodeTerm}
                  Type
_ -> String -> Flow AvroEnvironment AvroHydraAdapter
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment AvroHydraAdapter)
-> String -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ String
"unsupported type annotated as foreign key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TypeVariant -> String
forall a. Show a => a -> String
show (TypeVariant -> String) -> TypeVariant -> String
forall a b. (a -> b) -> a -> b
$ Type -> TypeVariant
typeVariant (Type -> TypeVariant) -> Type -> TypeVariant
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad)
              where
                forTypeAndCoder :: Adapter s1 s2 t1 t2 v1 v2
-> t2 -> Coder s1 s2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forTypeAndCoder Adapter s1 s2 t1 t2 v1 v2
ad t2
typ Coder s1 s2 v1 v2
coder = Adapter s1 s2 Schema t2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Adapter s1 s2 Schema t2 v1 v2
 -> f (Adapter s1 s2 Schema t2 v1 v2))
-> Adapter s1 s2 Schema t2 v1 v2
-> f (Adapter s1 s2 Schema t2 v1 v2)
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> t2
-> Coder s1 s2 v1 v2
-> Adapter s1 s2 Schema t2 v1 v2
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (Adapter s1 s2 t1 t2 v1 v2 -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy Adapter s1 s2 t1 t2 v1 v2
ad) (Field -> Schema
Avro.fieldType Field
f) t2
typ Coder s1 s2 v1 v2
coder
                elTyp :: Type
elTyp = Name -> Type
TypeVariable Name
name
          (String, (Field, AvroHydraAdapter))
-> Flow AvroEnvironment (String, (Field, AvroHydraAdapter))
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> String
Avro.fieldName Field
f, (Field
f, Maybe (Map String Term) -> AvroHydraAdapter -> AvroHydraAdapter
forall {s1} {s2} {t1} {v1} {v2}.
Maybe (Map String Term)
-> Adapter s1 s2 t1 Type v1 v2 -> Adapter s1 s2 t1 Type v1 v2
annotate Maybe (Map String Term)
ann AvroHydraAdapter
ad))
    Avro.SchemaPrimitive Primitive
p -> case Primitive
p of
        Primitive
Avro.PrimitiveNull -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.unit Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueString String
s) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.string String
s
            decode :: Term -> Flow s Value
decode Term
term = String -> Value
Json.ValueString (String -> Value) -> Flow s String -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s String
forall s. Term -> Flow s String
Expect.string Term
term
        Primitive
Avro.PrimitiveBoolean -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.boolean Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueBoolean Bool
b) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Bool -> Term
Terms.boolean Bool
b
            decode :: Term -> Flow s Value
decode Term
term = Bool -> Value
Json.ValueBoolean (Bool -> Value) -> Flow s Bool -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Bool
forall s. Term -> Flow s Bool
Expect.boolean Term
term
        Primitive
Avro.PrimitiveInt -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.int32 Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueNumber Double
d) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Int -> Term
Terms.int32 (Int -> Term) -> Int -> Term
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall {a} {b}. (RealFrac a, Integral b) => a -> b
doubleToInt Double
d
            decode :: Term -> Flow s Value
decode Term
term = Double -> Value
Json.ValueNumber (Double -> Value) -> (Int -> Double) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Value) -> Flow s Int -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Int
forall s. Term -> Flow s Int
Expect.int32 Term
term
        Primitive
Avro.PrimitiveLong -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.int64 Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueNumber Double
d) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Int64 -> Term
Terms.int64 (Int64 -> Term) -> Int64 -> Term
forall a b. (a -> b) -> a -> b
$ Double -> Int64
forall {a} {b}. (RealFrac a, Integral b) => a -> b
doubleToInt Double
d
            decode :: Term -> Flow s Value
decode Term
term = Double -> Value
Json.ValueNumber (Double -> Value) -> (Int64 -> Double) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Value) -> Flow s Int64 -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Int64
forall s. Term -> Flow s Int64
Expect.int64 Term
term
        Primitive
Avro.PrimitiveFloat -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.float32 Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueNumber Double
d) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Float -> Term
Terms.float32 (Float -> Term) -> Float -> Term
forall a b. (a -> b) -> a -> b
$ Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
            decode :: Term -> Flow s Value
decode Term
term = Double -> Value
Json.ValueNumber (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float -> Value) -> Flow s Float -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Float
forall s. Term -> Flow s Float
Expect.float32 Term
term
        Primitive
Avro.PrimitiveDouble -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.float64 Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueNumber Double
d) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ Double -> Term
Terms.float64 Double
d
            decode :: Term -> Flow s Value
decode Term
term = Double -> Value
Json.ValueNumber (Double -> Value) -> Flow s Double -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Double
forall s. Term -> Flow s Double
Expect.float64 Term
term
        Primitive
Avro.PrimitiveBytes -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.binary Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueString String
s) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.binary String
s
            decode :: Term -> Flow s Value
decode Term
term = String -> Value
Json.ValueString (String -> Value) -> Flow s String -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s String
forall s. Term -> Flow s String
Expect.binary Term
term
        Primitive
Avro.PrimitiveString -> Type
-> (Value -> Flow AvroEnvironment Term)
-> (Term -> Flow AvroEnvironment Value)
-> Flow AvroEnvironment AvroHydraAdapter
forall {f :: * -> *} {t2} {v1} {s1} {v2} {s2}.
Applicative f =>
t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter Type
Types.string Value -> Flow AvroEnvironment Term
forall {f :: * -> *}. Applicative f => Value -> f Term
encode Term -> Flow AvroEnvironment Value
forall {s}. Term -> Flow s Value
decode
          where
            encode :: Value -> f Term
encode (Json.ValueString String
s) = Term -> f Term
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> f Term) -> Term -> f Term
forall a b. (a -> b) -> a -> b
$ String -> Term
Terms.string String
s
            decode :: Term -> Flow s Value
decode Term
term = String -> Value
Json.ValueString (String -> Value) -> Flow s String -> Flow s Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s String
forall s. Term -> Flow s String
Expect.string Term
term
      where
        doubleToInt :: a -> b
doubleToInt a
d = if a
d a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling a
d else a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
d
    Avro.SchemaReference String
name -> do
      AvroEnvironment
env <- Flow AvroEnvironment AvroEnvironment
forall s. Flow s s
getState
      let qname :: AvroQualifiedName
qname = Maybe String -> String -> AvroQualifiedName
parseAvroName (AvroEnvironment -> Maybe String
avroEnvironmentNamespace AvroEnvironment
env) String
name
      case AvroQualifiedName -> AvroEnvironment -> Maybe AvroHydraAdapter
getAvroHydraAdapter AvroQualifiedName
qname AvroEnvironment
env of
        Maybe AvroHydraAdapter
Nothing -> String -> Flow AvroEnvironment AvroHydraAdapter
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment AvroHydraAdapter)
-> String -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ String
"Referenced Avro type has not been defined: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
forall a. Show a => a -> String
show AvroQualifiedName
qname
         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Defined types: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [AvroQualifiedName] -> String
forall a. Show a => a -> String
show (Map AvroQualifiedName AvroHydraAdapter -> [AvroQualifiedName]
forall k a. Map k a -> [k]
M.keys (Map AvroQualifiedName AvroHydraAdapter -> [AvroQualifiedName])
-> Map AvroQualifiedName AvroHydraAdapter -> [AvroQualifiedName]
forall a b. (a -> b) -> a -> b
$ AvroEnvironment -> Map AvroQualifiedName AvroHydraAdapter
avroEnvironmentNamedAdapters AvroEnvironment
env)
        Just AvroHydraAdapter
ad -> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AvroHydraAdapter
ad
    Avro.SchemaUnion (Avro.Union [Schema]
schemas) -> if [Schema] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Schema]
nonNulls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
        then String -> Flow AvroEnvironment AvroHydraAdapter
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment AvroHydraAdapter)
-> String -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ String
"general-purpose unions are not yet supported: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Schema -> String
forall a. Show a => a -> String
show Schema
schema
        else if [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Schema]
nonNulls
        then String -> Flow AvroEnvironment AvroHydraAdapter
forall a. String -> Flow AvroEnvironment a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow AvroEnvironment AvroHydraAdapter)
-> String -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ String
"cannot generate the empty type"
        else if Bool
hasNull
        then Schema -> Flow AvroEnvironment AvroHydraAdapter
forOptional (Schema -> Flow AvroEnvironment AvroHydraAdapter)
-> Schema -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ [Schema] -> Schema
forall a. HasCallStack => [a] -> a
L.head [Schema]
nonNulls
        else do
          AvroHydraAdapter
ad <- Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter (Schema -> Flow AvroEnvironment AvroHydraAdapter)
-> Schema -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ [Schema] -> Schema
forall a. HasCallStack => [a] -> a
L.head [Schema]
nonNulls
          AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> AvroHydraAdapter
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (AvroHydraAdapter -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter
ad) Schema
schema (AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad)
      where
        hasNull :: Bool
hasNull = (Bool -> Bool
not (Bool -> Bool) -> ([Schema] -> Bool) -> [Schema] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null ([Schema] -> Bool) -> ([Schema] -> [Schema]) -> [Schema] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Bool) -> [Schema] -> [Schema]
forall a. (a -> Bool) -> [a] -> [a]
L.filter Schema -> Bool
isNull) [Schema]
schemas
        nonNulls :: [Schema]
nonNulls = (Schema -> Bool) -> [Schema] -> [Schema]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool) -> (Schema -> Bool) -> Schema -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Bool
isNull) [Schema]
schemas
        isNull :: Schema -> Bool
isNull Schema
schema = case Schema
schema of
          Avro.SchemaPrimitive Primitive
Avro.PrimitiveNull -> Bool
True
          Schema
_ -> Bool
False
        forOptional :: Schema -> Flow AvroEnvironment AvroHydraAdapter
forOptional Schema
s = do
          AvroHydraAdapter
ad <- Schema -> Flow AvroEnvironment AvroHydraAdapter
avroHydraAdapter Schema
s
          let coder :: Coder AvroEnvironment AvroEnvironment Value Term
coder = Coder {
                coderDecode :: Term -> Flow AvroEnvironment Value
coderDecode = \(TermOptional Maybe Term
ot) -> case Maybe Term
ot of
                  Maybe Term
Nothing -> Value -> Flow AvroEnvironment Value
forall a. a -> Flow AvroEnvironment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Flow AvroEnvironment Value)
-> Value -> Flow AvroEnvironment Value
forall a b. (a -> b) -> a -> b
$ Value
Json.ValueNull
                  Just Term
term -> Coder AvroEnvironment AvroEnvironment Value Term
-> Term -> Flow AvroEnvironment Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Term
term,
                coderEncode :: Value -> Flow AvroEnvironment Term
coderEncode = \Value
v -> case Value
v of
                  Value
Json.ValueNull -> Term -> Flow AvroEnvironment Term
forall a. a -> Flow AvroEnvironment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Flow AvroEnvironment Term)
-> Term -> Flow AvroEnvironment Term
forall a b. (a -> b) -> a -> b
$ Maybe Term -> Term
TermOptional Maybe Term
forall a. Maybe a
Nothing
                  Value
_ -> Maybe Term -> Term
TermOptional (Maybe Term -> Term) -> (Term -> Maybe Term) -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term -> Maybe Term
forall a. a -> Maybe a
Just (Term -> Term)
-> Flow AvroEnvironment Term -> Flow AvroEnvironment Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coder AvroEnvironment AvroEnvironment Value Term
-> Value -> Flow AvroEnvironment Term
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (AvroHydraAdapter
-> Coder AvroEnvironment AvroEnvironment Value Term
forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter
ad) Value
v}
          AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a. a -> Flow AvroEnvironment a
forall (m :: * -> *) a. Monad m => a -> m a
return (AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter)
-> AvroHydraAdapter -> Flow AvroEnvironment AvroHydraAdapter
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> Type
-> Coder AvroEnvironment AvroEnvironment Value Term
-> AvroHydraAdapter
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (AvroHydraAdapter -> Bool
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter
ad) Schema
schema (Type -> Type
Types.optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ AvroHydraAdapter -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter
ad) Coder AvroEnvironment AvroEnvironment Value Term
coder
  where
    simpleAdapter :: t2
-> (v1 -> Flow s1 v2)
-> (v2 -> Flow s2 v1)
-> f (Adapter s1 s2 Schema t2 v1 v2)
simpleAdapter t2
typ v1 -> Flow s1 v2
encode v2 -> Flow s2 v1
decode = Adapter s1 s2 Schema t2 v1 v2 -> f (Adapter s1 s2 Schema t2 v1 v2)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Adapter s1 s2 Schema t2 v1 v2
 -> f (Adapter s1 s2 Schema t2 v1 v2))
-> Adapter s1 s2 Schema t2 v1 v2
-> f (Adapter s1 s2 Schema t2 v1 v2)
forall a b. (a -> b) -> a -> b
$ Bool
-> Schema
-> t2
-> Coder s1 s2 v1 v2
-> Adapter s1 s2 Schema t2 v1 v2
forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter Bool
False Schema
schema t2
typ (Coder s1 s2 v1 v2 -> Adapter s1 s2 Schema t2 v1 v2)
-> Coder s1 s2 v1 v2 -> Adapter s1 s2 Schema t2 v1 v2
forall a b. (a -> b) -> a -> b
$ (v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder v1 -> Flow s1 v2
encode v2 -> Flow s2 v1
decode
    annotate :: Maybe (Map String Term)
-> Adapter s1 s2 t1 Type v1 v2 -> Adapter s1 s2 t1 Type v1 v2
annotate Maybe (Map String Term)
ann Adapter s1 s2 t1 Type v1 v2
ad = case Maybe (Map String Term)
ann of
      Maybe (Map String Term)
Nothing -> Adapter s1 s2 t1 Type v1 v2
ad
      Just Map String Term
n -> Adapter s1 s2 t1 Type v1 v2
ad {adapterTarget = Types.annot n (adapterTarget ad)}

avroNameToHydraName :: AvroQualifiedName -> Name
avroNameToHydraName :: AvroQualifiedName -> Name
avroNameToHydraName (AvroQualifiedName Maybe String
mns String
local) = QualifiedName -> Name
unqualifyName (QualifiedName -> Name) -> QualifiedName -> Name
forall a b. (a -> b) -> a -> b
$ Maybe Namespace -> String -> QualifiedName
QualifiedName (String -> Namespace
Namespace (String -> Namespace) -> Maybe String -> Maybe Namespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mns) String
local

-- TODO: use me (for encoding annotations for which the type is not know) or lose me
--       A more robust solution would use jsonCoder together with an expected type
encodeAnnotationValue :: Json.Value -> Term
encodeAnnotationValue :: Value -> Term
encodeAnnotationValue Value
v = case Value
v of
  Json.ValueArray [Value]
vals -> [Term] -> Term
Terms.list (Value -> Term
encodeAnnotationValue (Value -> Term) -> [Value] -> [Term]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value]
vals)
  Json.ValueBoolean Bool
b -> Bool -> Term
Terms.boolean Bool
b
  Value
Json.ValueNull -> [Term] -> Term
Terms.product []
  Json.ValueNumber Double
d -> Double -> Term
Terms.float64 Double
d
  -- Note: JSON objects are untyped maps, not records, in that fields are unordered
  Json.ValueObject Map String Value
m -> Map Term Term -> Term
Terms.map (Map Term Term -> Term) -> Map Term Term -> Term
forall a b. (a -> b) -> a -> b
$ [(Term, Term)] -> Map Term Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((String, Value) -> (Term, Term)
toEntry ((String, Value) -> (Term, Term))
-> [(String, Value)] -> [(Term, Term)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m)
    where
      toEntry :: (String, Value) -> (Term, Term)
toEntry (String
k, Value
v) = (String -> Term
Terms.string String
k, Value -> Term
encodeAnnotationValue Value
v)
  Json.ValueString String
s -> String -> Term
Terms.string String
s

fieldAnnotationsToCore :: Avro.Field -> M.Map String Term
fieldAnnotationsToCore :: Field -> Map String Term
fieldAnnotationsToCore Field
f = [(String, Term)] -> Map String Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((String, Value) -> (String, Term)
forall {a}. (a, Value) -> (a, Term)
toCore ((String, Value) -> (String, Term))
-> [(String, Value)] -> [(String, Term)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String Value -> [(String, Value)])
-> Map String Value -> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ Field -> Map String Value
Avro.fieldAnnotations Field
f))
  where
    toCore :: (a, Value) -> (a, Term)
toCore (a
k, Value
v) = (a
k, Value -> Term
encodeAnnotationValue Value
v)

namedAnnotationsToCore :: Avro.Named -> M.Map String Term
namedAnnotationsToCore :: Named -> Map String Term
namedAnnotationsToCore Named
n = [(String, Term)] -> Map String Term
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((String, Value) -> (String, Term)
forall {a}. (a, Value) -> (a, Term)
toCore ((String, Value) -> (String, Term))
-> [(String, Value)] -> [(String, Term)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map String Value -> [(String, Value)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String Value -> [(String, Value)])
-> Map String Value -> [(String, Value)]
forall a b. (a -> b) -> a -> b
$ Named -> Map String Value
Avro.namedAnnotations Named
n))
  where
    toCore :: (a, Value) -> (a, Term)
toCore (a
k, Value
v) = (a
k, Value -> Term
encodeAnnotationValue Value
v)

getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment -> Y.Maybe AvroHydraAdapter
getAvroHydraAdapter :: AvroQualifiedName -> AvroEnvironment -> Maybe AvroHydraAdapter
getAvroHydraAdapter AvroQualifiedName
qname = AvroQualifiedName
-> Map AvroQualifiedName AvroHydraAdapter -> Maybe AvroHydraAdapter
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AvroQualifiedName
qname (Map AvroQualifiedName AvroHydraAdapter -> Maybe AvroHydraAdapter)
-> (AvroEnvironment -> Map AvroQualifiedName AvroHydraAdapter)
-> AvroEnvironment
-> Maybe AvroHydraAdapter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvroEnvironment -> Map AvroQualifiedName AvroHydraAdapter
avroEnvironmentNamedAdapters

foreignKey :: Avro.Field -> Flow s (Maybe ForeignKey)
foreignKey :: forall s. Field -> Flow s (Maybe ForeignKey)
foreignKey Field
f = case String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
avro_foreignKey (Field -> Map String Value
Avro.fieldAnnotations Field
f) of
    Maybe Value
Nothing -> Maybe ForeignKey -> Flow s (Maybe ForeignKey)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ForeignKey
forall a. Maybe a
Nothing
    Just Value
v -> do
      Map String Value
m <- Value -> Flow s (Map String Value)
forall s. Value -> Flow s (Map String Value)
expectObject Value
v
      Name
tname <- String -> Name
Name (String -> Name) -> Flow s String -> Flow s Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Map String Value -> Flow s String
forall s. String -> Map String Value -> Flow s String
requireString String
"type" Map String Value
m
      Maybe String
pattern <- String -> Map String Value -> Flow s (Maybe String)
forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
"pattern" Map String Value
m
      let constr :: String -> Name
constr = case Maybe String
pattern of
            Maybe String
Nothing -> String -> Name
Name
            Just String
pat -> String -> String -> Name
patternToNameConstructor String
pat
      Maybe ForeignKey -> Flow s (Maybe ForeignKey)
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ForeignKey -> Flow s (Maybe ForeignKey))
-> Maybe ForeignKey -> Flow s (Maybe ForeignKey)
forall a b. (a -> b) -> a -> b
$ ForeignKey -> Maybe ForeignKey
forall a. a -> Maybe a
Just (ForeignKey -> Maybe ForeignKey) -> ForeignKey -> Maybe ForeignKey
forall a b. (a -> b) -> a -> b
$ Name -> (String -> Name) -> ForeignKey
ForeignKey Name
tname String -> Name
constr

patternToNameConstructor :: String -> String -> Name
patternToNameConstructor :: String -> String -> Name
patternToNameConstructor String
pat = \String
s -> String -> Name
Name (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
s ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"${}" String
pat

primaryKey :: Avro.Field -> Flow s (Maybe PrimaryKey)
primaryKey :: forall s. Field -> Flow s (Maybe PrimaryKey)
primaryKey Field
f = do
  case String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
avro_primaryKey (Map String Value -> Maybe Value)
-> Map String Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Field -> Map String Value
Avro.fieldAnnotations Field
f of
    Maybe Value
Nothing -> Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PrimaryKey
forall a. Maybe a
Nothing
    Just Value
v -> do
      String
s <- Value -> Flow s String
forall s. Value -> Flow s String
expectString Value
v
      Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PrimaryKey -> Flow s (Maybe PrimaryKey))
-> Maybe PrimaryKey -> Flow s (Maybe PrimaryKey)
forall a b. (a -> b) -> a -> b
$ PrimaryKey -> Maybe PrimaryKey
forall a. a -> Maybe a
Just (PrimaryKey -> Maybe PrimaryKey) -> PrimaryKey -> Maybe PrimaryKey
forall a b. (a -> b) -> a -> b
$ Name -> (String -> Name) -> PrimaryKey
PrimaryKey (String -> Name
Name (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Field -> String
Avro.fieldName Field
f) ((String -> Name) -> PrimaryKey) -> (String -> Name) -> PrimaryKey
forall a b. (a -> b) -> a -> b
$ String -> String -> Name
patternToNameConstructor String
s

parseAvroName :: Maybe String -> String -> AvroQualifiedName
parseAvroName :: Maybe String -> String -> AvroQualifiedName
parseAvroName Maybe String
mns String
name = case [String] -> [String]
forall a. [a] -> [a]
L.reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"." String
name of
  [String
local] -> Maybe String -> String -> AvroQualifiedName
AvroQualifiedName Maybe String
mns String
local
  (String
local:[String]
rest) -> Maybe String -> String -> AvroQualifiedName
AvroQualifiedName (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
L.reverse [String]
rest) String
local

putAvroHydraAdapter :: AvroQualifiedName -> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment
putAvroHydraAdapter :: AvroQualifiedName
-> AvroHydraAdapter -> AvroEnvironment -> AvroEnvironment
putAvroHydraAdapter AvroQualifiedName
qname AvroHydraAdapter
ad AvroEnvironment
env = AvroEnvironment
env {avroEnvironmentNamedAdapters = M.insert qname ad $ avroEnvironmentNamedAdapters env}

rewriteAvroSchemaM :: ((Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema) -> Avro.Schema -> Flow s Avro.Schema
rewriteAvroSchemaM :: forall s.
((Schema -> Flow s Schema) -> Schema -> Flow s Schema)
-> Schema -> Flow s Schema
rewriteAvroSchemaM (Schema -> Flow s Schema) -> Schema -> Flow s Schema
f = ((Schema -> Flow s Schema) -> Schema -> Flow s Schema)
-> ((Schema -> Flow s Schema) -> Schema -> Flow s Schema)
-> Schema
-> Flow s Schema
forall x y. ((x -> y) -> x -> y) -> ((x -> y) -> x -> y) -> x -> y
rewrite (Schema -> Flow s Schema) -> Schema -> Flow s Schema
forall {f :: * -> *}.
Monad f =>
(Schema -> f Schema) -> Schema -> f Schema
fsub (Schema -> Flow s Schema) -> Schema -> Flow s Schema
f
  where
    fsub :: (Schema -> f Schema) -> Schema -> f Schema
fsub Schema -> f Schema
recurse Schema
schema = case Schema
schema of
        Avro.SchemaArray (Avro.Array Schema
els) -> Array -> Schema
Avro.SchemaArray (Array -> Schema) -> f Array -> f Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Array
Avro.Array (Schema -> Array) -> f Schema -> f Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> f Schema
recurse Schema
els)
        Avro.SchemaMap (Avro.Map_ Schema
vschema) -> Map_ -> Schema
Avro.SchemaMap (Map_ -> Schema) -> f Map_ -> f Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Map_
Avro.Map_ (Schema -> Map_) -> f Schema -> f Map_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema -> f Schema
recurse Schema
vschema)
        Avro.SchemaNamed Named
n -> do
          NamedType
nt <- case Named -> NamedType
Avro.namedType Named
n of
            Avro.NamedTypeRecord (Avro.Record [Field]
fields) -> Record -> NamedType
Avro.NamedTypeRecord (Record -> NamedType) -> f Record -> f NamedType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Field] -> Record
Avro.Record ([Field] -> Record) -> f [Field] -> f Record
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Field -> f Field) -> [Field] -> f [Field]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Field -> f Field
forField [Field]
fields))
            NamedType
t -> NamedType -> f NamedType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedType
t
          Schema -> f Schema
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema -> f Schema) -> Schema -> f Schema
forall a b. (a -> b) -> a -> b
$ Named -> Schema
Avro.SchemaNamed (Named -> Schema) -> Named -> Schema
forall a b. (a -> b) -> a -> b
$ Named
n {Avro.namedType = nt}
        Avro.SchemaUnion (Avro.Union [Schema]
schemas) -> Union -> Schema
Avro.SchemaUnion (Union -> Schema) -> f Union -> f Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Schema] -> Union
Avro.Union ([Schema] -> Union) -> f [Schema] -> f Union
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Schema -> f Schema) -> [Schema] -> f [Schema]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Schema -> f Schema
recurse [Schema]
schemas))
        Schema
_ -> Schema -> f Schema
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
schema
      where
        forField :: Field -> f Field
forField Field
f = do
          Schema
t <- Schema -> f Schema
recurse (Schema -> f Schema) -> Schema -> f Schema
forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
          Field -> f Field
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return Field
f {Avro.fieldType = t}

jsonToString :: Json.Value -> Flow s String
jsonToString :: forall s. Value -> Flow s String
jsonToString Value
v = case Value
v of
  Json.ValueBoolean Bool
b -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"true" else String
"false"
  Json.ValueString String
s -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
  Json.ValueNumber Double
d -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ if Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d) Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
d
    then Integer -> String
forall a. Show a => a -> String
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d)
    else Double -> String
forall a. Show a => a -> String
show Double
d
  Value
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"string, number, or boolean" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
v

showQname :: AvroQualifiedName -> String
showQname :: AvroQualifiedName -> String
showQname (AvroQualifiedName Maybe String
mns String
local) = (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe String
"" (\String
ns -> String
ns String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".") Maybe String
mns) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
local

stringToTerm :: Type -> String -> Flow s Term
stringToTerm :: forall s. Type -> String -> Flow s Term
stringToTerm Type
typ String
s = case Type -> Type
stripType Type
typ of
    TypeLiteral LiteralType
lt -> Literal -> Term
TermLiteral (Literal -> Term) -> Flow s Literal -> Flow s Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case LiteralType
lt of
      LiteralType
LiteralTypeBoolean -> Bool -> Literal
LiteralBoolean (Bool -> Literal) -> Flow s Bool -> Flow s Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Bool
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
      LiteralTypeInteger IntegerType
it -> IntegerValue -> Literal
LiteralInteger (IntegerValue -> Literal) -> Flow s IntegerValue -> Flow s Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case IntegerType
it of
        IntegerType
IntegerTypeBigint -> Integer -> IntegerValue
IntegerValueBigint (Integer -> IntegerValue) -> Flow s Integer -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Integer
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeInt8 -> Int8 -> IntegerValue
IntegerValueInt8 (Int8 -> IntegerValue) -> Flow s Int8 -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int8
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeInt16 -> Int16 -> IntegerValue
IntegerValueInt16 (Int16 -> IntegerValue) -> Flow s Int16 -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int16
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeInt32 -> Int -> IntegerValue
IntegerValueInt32 (Int -> IntegerValue) -> Flow s Int -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeInt64 -> Int64 -> IntegerValue
IntegerValueInt64 (Int64 -> IntegerValue) -> Flow s Int64 -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int64
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeUint8 -> Int16 -> IntegerValue
IntegerValueUint8 (Int16 -> IntegerValue) -> Flow s Int16 -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int16
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeUint16 -> Int -> IntegerValue
IntegerValueUint16 (Int -> IntegerValue) -> Flow s Int -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeUint32 -> Int64 -> IntegerValue
IntegerValueUint32 (Int64 -> IntegerValue) -> Flow s Int64 -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Int64
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
        IntegerType
IntegerTypeUint64 -> Integer -> IntegerValue
IntegerValueUint64 (Integer -> IntegerValue) -> Flow s Integer -> Flow s IntegerValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s Integer
forall {a} {m :: * -> *}. (Read a, MonadFail m) => String -> m a
doRead String
s
      LiteralType
LiteralTypeString -> String -> Literal
LiteralString (String -> Literal) -> Flow s String -> Flow s Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
      LiteralType
_ -> String -> String -> Flow s Literal
forall s x. String -> String -> Flow s x
unexpected String
"literal type" (String -> Flow s Literal) -> String -> Flow s Literal
forall a b. (a -> b) -> a -> b
$ LiteralType -> String
forall a. Show a => a -> String
show LiteralType
lt
  where
    doRead :: String -> m a
doRead String
s = case String -> Either String a
forall a. Read a => String -> Either String a
TR.readEither String
s of
      Left String
msg -> String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"failed to read value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
      Right a
term -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
term

termToString :: Term -> Flow s String
termToString :: forall s. Term -> Flow s String
termToString Term
term = case Term -> Term
stripTerm Term
term of
  TermLiteral Literal
l -> case Literal
l of
    LiteralBoolean Bool
b -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
b
    LiteralInteger IntegerValue
iv -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ case IntegerValue
iv of
      IntegerValueBigint Integer
i -> Integer -> String
forall a. Show a => a -> String
show Integer
i
      IntegerValueInt8 Int8
i -> Int8 -> String
forall a. Show a => a -> String
show Int8
i
      IntegerValueInt16 Int16
i -> Int16 -> String
forall a. Show a => a -> String
show Int16
i
      IntegerValueInt32 Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
      IntegerValueInt64 Int64
i -> Int64 -> String
forall a. Show a => a -> String
show Int64
i
      IntegerValueUint8 Int16
i -> Int16 -> String
forall a. Show a => a -> String
show Int16
i
      IntegerValueUint16 Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
      IntegerValueUint32 Int64
i -> Int64 -> String
forall a. Show a => a -> String
show Int64
i
      IntegerValueUint64 Integer
i -> Integer -> String
forall a. Show a => a -> String
show Integer
i
    LiteralString String
s -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
    Literal
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"boolean, integer, or string" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
l
  TermOptional (Just Term
term') -> Term -> Flow s String
forall s. Term -> Flow s String
termToString Term
term'
  Term
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"literal value" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term