module Hydra.Ext.Avro.Coder where

import Hydra.All
import Hydra.Adapters.Coders
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms
import Hydra.Util.Codetree.Script
import Hydra.Adapters.UtilsEtc
import qualified Hydra.Ext.Avro.Schema as Avro
import qualified Hydra.Ext.Json.Model as Json
import Hydra.Ext.Json.Eliminate
import Hydra.CoreEncoding

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
import qualified Text.Read as TR


data AvroEnvironment m = AvroEnvironment {
  forall m.
AvroEnvironment m -> Map AvroQualifiedName (AvroHydraAdapter m)
avroEnvironmentNamedAdapters :: M.Map AvroQualifiedName (AvroHydraAdapter m),
  forall m. AvroEnvironment m -> Maybe String
avroEnvironmentNamespace :: Maybe String,
  forall m. AvroEnvironment m -> Map Name (Element m)
avroEnvironmentElements :: M.Map Name (Element m)} -- note: only used in the term coders

type AvroHydraAdapter m = Adapter (AvroEnvironment m) (AvroEnvironment m) Avro.Schema (Type m) Json.Value (Term m)

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

data ForeignKey = ForeignKey Name (String -> Name)

data PrimaryKey = PrimaryKey FieldName (String -> Name)

emptyEnvironment :: AvroEnvironment m
emptyEnvironment = forall m.
Map AvroQualifiedName (AvroHydraAdapter m)
-> Maybe String -> Map Name (Element m) -> AvroEnvironment m
AvroEnvironment forall k a. Map k a
M.empty forall a. Maybe a
Nothing forall k a. Map k a
M.empty

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

avroHydraAdapter :: (Ord m, Show m) => Avro.Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter :: forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter Schema
schema = case Schema
schema of
    Avro.SchemaArray (Avro.Array Schema
s) -> do
      AvroHydraAdapter m
ad <- forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter Schema
s
      let coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
            coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \(Json.ValueArray [Value]
vals) -> forall m. [Term m] -> Term m
Terms.list forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) [Value]
vals),
            coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = \(TermList [Term m]
vals) -> [Value] -> Value
Json.ValueArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) [Term m]
vals)}
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter m
ad) Schema
schema (forall m. Type m -> Type m
Types.list forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
ad) Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
    Avro.SchemaMap (Avro.Map_ Schema
s) -> do
      AvroHydraAdapter m
ad <- forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter Schema
s
      let pairToHydra :: (String, Value) -> Flow (AvroEnvironment m) (Term m, Term m)
pairToHydra (String
k, Value
v) = do
            Term m
v' <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) Value
v
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall m. String -> Term m
Terms.string String
k, Term m
v')
      let coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
            coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \(Json.ValueObject Map String Value
m) -> forall m. Map (Term m) (Term m) -> Term m
Terms.map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
(String, Value) -> Flow (AvroEnvironment m) (Term m, Term m)
pairToHydra forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m),
            coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = \Term m
m -> Map String Value -> Value
Json.ValueObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k m s v.
(Ord k, Show m) =>
(Term m -> Flow s k)
-> (Term m -> Flow s v) -> Term m -> Flow s (Map k v)
Terms.expectMap forall m s. Show m => Term m -> Flow s String
Terms.expectString (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad)) Term m
m}
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter m
ad) Schema
schema (forall m. Type m -> Type m -> Type m
Types.map forall m. Type m
Types.string forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
ad) Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
    Avro.SchemaNamed Named
n -> do
        let ns :: Maybe String
ns = Named -> Maybe String
Avro.namedNamespace Named
n
        AvroEnvironment m
env <- forall s. Flow s s
getState
        let lastNs :: Maybe String
lastNs = forall m. AvroEnvironment m -> Maybe String
avroEnvironmentNamespace AvroEnvironment m
env
        let nextNs :: Maybe String
nextNs = forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe Maybe String
lastNs forall a. a -> Maybe a
Just Maybe String
ns
        forall s. s -> Flow s ()
putState forall a b. (a -> b) -> a -> b
$ AvroEnvironment m
env {avroEnvironmentNamespace :: Maybe String
avroEnvironmentNamespace = Maybe String
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 m
ad <- case forall m.
AvroQualifiedName
-> AvroEnvironment m -> Maybe (AvroHydraAdapter m)
getAvroHydraAdapter AvroQualifiedName
qname AvroEnvironment m
env of
          Just AvroHydraAdapter m
ad -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Avro named type defined more than once: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show AvroQualifiedName
qname
          Maybe (AvroHydraAdapter m)
Nothing -> do
            AvroHydraAdapter m
ad <- case Named -> NamedType
Avro.namedType Named
n of
              Avro.NamedTypeEnum (Avro.Enum_ [String]
syms Maybe String
mdefault) -> 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 forall m. Type m
typ forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m :: * -> *} {m}. Monad m => Term m -> m Value
decode  -- TODO: use default value
                where
                  typ :: Type m
typ = forall m. RowType m -> Type m
TypeUnion (forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
hydraName forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall {m}. String -> FieldType m
toField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
syms)
                    where
                      toField :: String -> FieldType m
toField String
s = forall m. FieldName -> Type m -> FieldType m
FieldType (String -> FieldName
FieldName String
s) forall m. Type m
Types.unit
                  encode :: Value -> f (Term m)
encode (Json.ValueString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Union m -> Term m
TermUnion (forall m. Name -> Field m -> Union m
Union Name
hydraName forall a b. (a -> b) -> a -> b
$ forall m. FieldName -> Term m -> Field m
Field (String -> FieldName
FieldName String
s) forall m. Term m
Terms.unit)
                  -- Note: we simply trust that data coming from the Hydra side is correct
                  decode :: Term m -> m Value
decode (TermUnion (Union Name
_ (Field FieldName
fn Term m
_))) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Value
Json.ValueString forall a b. (a -> b) -> a -> b
$ FieldName -> String
unFieldName FieldName
fn
              Avro.NamedTypeFixed (Avro.Fixed Int
size) -> 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 forall m. Type m
Types.binary forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
                where
                  encode :: Value -> f (Term m)
encode (Json.ValueString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
Terms.binary String
s
                  decode :: Term m -> Flow s Value
decode Term m
term = String -> Value
Json.ValueString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s String
Terms.expectBinary Term m
term
              Avro.NamedTypeRecord Record
r -> do
                  let avroFields :: [Field]
avroFields = Record -> [Field]
Avro.recordFields Record
r
                  Map String (Field, AvroHydraAdapter m)
adaptersByFieldName <- forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}.
(Ord m, Show m) =>
Field
-> Flow (AvroEnvironment m) (String, (Field, AvroHydraAdapter m))
prepareField [Field]
avroFields)
                  Maybe PrimaryKey
pk <- 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 m) (Field m)
encodePair (String
k, Value
v) = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Field, AvroHydraAdapter m)
adaptersByFieldName of
                        Maybe (Field, AvroHydraAdapter m)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unrecognized field for " forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
showQname AvroQualifiedName
qname forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
k
                        Just (Field
f, AvroHydraAdapter m
ad) -> do
                          Term m
v' <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) Value
v
                          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m. FieldName -> Term m -> Field m
Field (String -> FieldName
FieldName String
k) Term m
v'
                  let decodeField :: Field m -> Flow (AvroEnvironment m) (String, Value)
decodeField (Field (FieldName String
k) Term m
v) = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String (Field, AvroHydraAdapter m)
adaptersByFieldName of
                        Maybe (Field, AvroHydraAdapter m)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unrecognized field for " forall a. [a] -> [a] -> [a]
++ AvroQualifiedName -> String
showQname AvroQualifiedName
qname forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
k
                        Just (Field
f, AvroHydraAdapter m
ad) -> do
                          Value
v' <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) Term m
v
                          forall (m :: * -> *) a. Monad m => a -> m a
return (String
k, Value
v')
                  let lossy :: Bool
lossy = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (\Bool
b (Field
_, AvroHydraAdapter m
ad) -> Bool
b Bool -> Bool -> Bool
|| forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter m
ad) Bool
False forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map String (Field, AvroHydraAdapter m)
adaptersByFieldName
                  let hfields :: [FieldType m]
hfields = forall {s1} {s2} {t1} {m} {v1} {v2}.
(Field, Adapter s1 s2 t1 (Type m) v1 v2) -> FieldType m
toHydraField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
M.elems Map String (Field, AvroHydraAdapter m)
adaptersByFieldName
                  let target :: Type m
target = forall m. RowType m -> Type m
TypeRecord forall a b. (a -> b) -> a -> b
$ forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
hydraName forall a. Maybe a
Nothing [FieldType m]
hfields
                  let coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
                    -- Note: the order of the fields is changed
                    coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \(Json.ValueObject Map String Value
m) -> do
                      [Field m]
fields <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM (String, Value) -> Flow (AvroEnvironment m) (Field m)
encodePair forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String Value
m
                      let term :: Term m
term = forall m. Record m -> Term m
TermRecord forall a b. (a -> b) -> a -> b
$ forall m. Name -> [Field m] -> Record m
Record Name
hydraName [Field m]
fields
                      forall {m} {m}.
Show m =>
Term m
-> Type m
-> Maybe PrimaryKey
-> [Field m]
-> Flow (AvroEnvironment m) ()
addElement Term m
term Type m
target Maybe PrimaryKey
pk [Field m]
fields
                      forall (m :: * -> *) a. Monad m => a -> m a
return Term m
term,
                    coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = \(TermRecord (Record Name
_ [Field m]
fields)) -> Map String Value -> Value
Json.ValueObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Field m -> Flow (AvroEnvironment m) (String, Value)
decodeField [Field m]
fields)}
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 m
target Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
                where
                  toHydraField :: (Field, Adapter s1 s2 t1 (Type m) v1 v2) -> FieldType m
toHydraField (Field
f, Adapter s1 s2 t1 (Type m) v1 v2
ad) = forall m. FieldName -> Type m -> FieldType m
FieldType (String -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Field -> String
Avro.fieldName Field
f) forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget Adapter s1 s2 t1 (Type m) v1 v2
ad
            AvroEnvironment m
env <- forall s. Flow s s
getState
            forall s. s -> Flow s ()
putState forall a b. (a -> b) -> a -> b
$ forall m.
AvroQualifiedName
-> AvroHydraAdapter m -> AvroEnvironment m -> AvroEnvironment m
putAvroHydraAdapter AvroQualifiedName
qname AvroHydraAdapter m
ad AvroEnvironment m
env
            forall (m :: * -> *) a. Monad m => a -> m a
return AvroHydraAdapter m
ad

        AvroEnvironment m
env2 <- forall s. Flow s s
getState
        forall s. s -> Flow s ()
putState forall a b. (a -> b) -> a -> b
$ AvroEnvironment m
env2 {avroEnvironmentNamespace :: Maybe String
avroEnvironmentNamespace = Maybe String
lastNs}
        forall (m :: * -> *) a. Monad m => a -> m a
return AvroHydraAdapter m
ad
      where
        addElement :: Term m
-> Type m
-> Maybe PrimaryKey
-> [Field m]
-> Flow (AvroEnvironment m) ()
addElement Term m
term Type m
typ Maybe PrimaryKey
pk [Field m]
fields = case Maybe PrimaryKey
pk of
          Maybe PrimaryKey
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just (PrimaryKey FieldName
fname String -> Name
constr) -> case forall a. (a -> Bool) -> [a] -> [a]
L.filter forall {m}. Field m -> Bool
isPkField [Field m]
fields of
              [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              [Field m
field] -> do
                  String
s <- forall m s. Show m => Term m -> Flow s String
termToString forall a b. (a -> b) -> a -> b
$ forall m. Field m -> Term m
fieldTerm Field m
field
                  let name :: Name
name = String -> Name
constr String
s
                  let el :: Element m
el = forall m. Name -> Term m -> Term m -> Element m
Element Name
name (forall m. Type m -> Term m
encodeType Type m
typ) Term m
term
                  AvroEnvironment m
env <- forall s. Flow s s
getState
                  forall s. s -> Flow s ()
putState forall a b. (a -> b) -> a -> b
$ AvroEnvironment m
env {avroEnvironmentElements :: Map Name (Element m)
avroEnvironmentElements = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name Element m
el (forall m. AvroEnvironment m -> Map Name (Element m)
avroEnvironmentElements AvroEnvironment m
env)}
                  forall (m :: * -> *) a. Monad m => a -> m a
return ()
              [Field m]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"multiple fields named " forall a. [a] -> [a] -> [a]
++ FieldName -> String
unFieldName FieldName
fname
            where
              isPkField :: Field m -> Bool
isPkField Field m
field = forall m. Field m -> FieldName
fieldName Field m
field forall a. Eq a => a -> a -> Bool
== FieldName
fname
        findPrimaryKeyField :: a -> [Field] -> Flow s (Maybe PrimaryKey)
findPrimaryKeyField a
qname [Field]
avroFields = do
          [PrimaryKey]
keys <- forall a. [Maybe a] -> [a]
Y.catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall s. Field -> Flow s (Maybe PrimaryKey)
primaryKey [Field]
avroFields
          case [PrimaryKey]
keys of
            [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
            [PrimaryKey
k] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just PrimaryKey
k
            [PrimaryKey]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"multiple primary key fields for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
qname
        prepareField :: Field
-> Flow (AvroEnvironment m) (String, (Field, AvroHydraAdapter m))
prepareField Field
f = do
          Maybe ForeignKey
fk <- forall s. Field -> Flow s (Maybe ForeignKey)
foreignKey Field
f
          AvroHydraAdapter m
ad <- case Maybe ForeignKey
fk of
            Maybe ForeignKey
Nothing -> forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
            Just (ForeignKey Name
name String -> Name
constr) -> do
                AvroHydraAdapter m
ad <- forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
                let decodeTerm :: Term m -> Flow (AvroEnvironment m) Value
decodeTerm = \(TermElement Name
name) -> do -- TODO: not symmetrical
                      Term m
term <- forall m s. Show m => Type m -> String -> Flow s (Term m)
stringToTerm (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
ad) forall a b. (a -> b) -> a -> b
$ Name -> String
unName Name
name
                      forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) Term m
term
                let encodeValue :: Value -> Flow (AvroEnvironment m) (Term m)
encodeValue Value
v = do
                      String
s <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad) Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall m s. Show m => Term m -> Flow s String
termToString
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall m. Name -> Term m
TermElement 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 forall m. Type m -> Type m
stripType (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
ad) of
                  TypeOptional (TypeLiteral LiteralType
lit) -> 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 m
ad (forall m. Type m -> Type m
Types.optional forall m. Type m
elTyp) forall {m}.
Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
                    where
                      coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
                        coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \Value
json -> (forall m. Maybe (Term m) -> Term m
TermOptional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m}. Value -> Flow (AvroEnvironment m) (Term m)
encodeValue Value
json,
                        coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = forall {m}. Term m -> Flow (AvroEnvironment m) Value
decodeTerm}
                  TypeList (TypeLiteral LiteralType
lit) -> 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 m
ad (forall m. Type m -> Type m
Types.list forall m. Type m
elTyp) forall {m}.
Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
                    where
                      coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
                        coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \Value
json -> forall m. [Term m] -> Term m
TermList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Value -> Flow s [Value]
expectArray Value
json forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall {m}. Value -> Flow (AvroEnvironment m) (Term m)
encodeValue),
                        coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = forall {m}. Term m -> Flow (AvroEnvironment m) Value
decodeTerm}
                  TypeLiteral LiteralType
lit -> 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 m
ad forall m. Type m
elTyp forall {m}.
Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder
                    where
                      coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
                        coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = forall {m}. Value -> Flow (AvroEnvironment m) (Term m)
encodeValue,
                        coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = forall {m}. Term m -> Flow (AvroEnvironment m) Value
decodeTerm}
                  Type m
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"unsupported type annotated as foreign key: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall m. Type m -> TypeVariant
typeVariant forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (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 m
elTyp = forall m. Type m -> Type m
Types.element forall a b. (a -> b) -> a -> b
$ forall m. Name -> Type m
Types.nominal Name
name
          forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> String
Avro.fieldName Field
f, (Field
f, AvroHydraAdapter m
ad))
    Avro.SchemaPrimitive Primitive
p -> case Primitive
p of
        Primitive
Avro.PrimitiveNull -> 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 forall m. Type m
Types.unit forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
Terms.string String
s
            decode :: Term m -> Flow s Value
decode Term m
term = String -> Value
Json.ValueString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s String
Terms.expectString Term m
term
        Primitive
Avro.PrimitiveBoolean -> 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 forall m. Type m
Types.boolean forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueBoolean Bool
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Bool -> Term m
Terms.boolean Bool
b
            decode :: Term m -> Flow s Value
decode Term m
term = Bool -> Value
Json.ValueBoolean forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s Bool
Terms.expectBoolean Term m
term
        Primitive
Avro.PrimitiveInt -> 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 forall m. Type m
Types.int32 forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueNumber Double
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Int -> Term m
Terms.int32 forall a b. (a -> b) -> a -> b
$ forall {a} {b}. (RealFrac a, Integral b) => a -> b
doubleToInt Double
d
            decode :: Term m -> Flow s Value
decode Term m
term = Double -> Value
Json.ValueNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s Int
Terms.expectInt32 Term m
term
        Primitive
Avro.PrimitiveLong -> 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 forall m. Type m
Types.int64 forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueNumber Double
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Int64 -> Term m
Terms.int64 forall a b. (a -> b) -> a -> b
$ forall {a} {b}. (RealFrac a, Integral b) => a -> b
doubleToInt Double
d
            decode :: Term m -> Flow s Value
decode Term m
term = Double -> Value
Json.ValueNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s Integer
Terms.expectInt64 Term m
term
        Primitive
Avro.PrimitiveFloat -> 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 forall m. Type m
Types.float32 forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueNumber Double
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Float -> Term m
Terms.float32 forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d
            decode :: Term m -> Flow s Value
decode Term m
term = Double -> Value
Json.ValueNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s Float
Terms.expectFloat32 Term m
term
        Primitive
Avro.PrimitiveDouble -> 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 forall m. Type m
Types.float64 forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueNumber Double
d) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Double -> Term m
Terms.float64 Double
d
            decode :: Term m -> Flow s Value
decode Term m
term = Double -> Value
Json.ValueNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s Double
Terms.expectFloat64 Term m
term
        Primitive
Avro.PrimitiveBytes -> 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 forall m. Type m
Types.binary forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
Terms.binary String
s
            decode :: Term m -> Flow s Value
decode Term m
term = String -> Value
Json.ValueString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s String
Terms.expectBinary Term m
term
        Primitive
Avro.PrimitiveString -> 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 forall m. Type m
Types.string forall {f :: * -> *} {m}. Applicative f => Value -> f (Term m)
encode forall {m} {s}. Show m => Term m -> Flow s Value
decode
          where
            encode :: Value -> f (Term m)
encode (Json.ValueString String
s) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. String -> Term m
Terms.string String
s
            decode :: Term m -> Flow s Value
decode Term m
term = String -> Value
Json.ValueString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m s. Show m => Term m -> Flow s String
Terms.expectString Term m
term
      where
        doubleToInt :: a -> b
doubleToInt a
d = if a
d forall a. Ord a => a -> a -> Bool
< a
0 then forall a b. (RealFrac a, Integral b) => a -> b
ceiling a
d else forall a b. (RealFrac a, Integral b) => a -> b
floor a
d
    Avro.SchemaReference String
name -> do
      AvroEnvironment m
env <- forall s. Flow s s
getState
      let qname :: AvroQualifiedName
qname = Maybe String -> String -> AvroQualifiedName
parseAvroName (forall m. AvroEnvironment m -> Maybe String
avroEnvironmentNamespace AvroEnvironment m
env) String
name
      case forall m.
AvroQualifiedName
-> AvroEnvironment m -> Maybe (AvroHydraAdapter m)
getAvroHydraAdapter AvroQualifiedName
qname AvroEnvironment m
env of
        Maybe (AvroHydraAdapter m)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Referenced Avro type has not been defined: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show AvroQualifiedName
qname
         forall a. [a] -> [a] -> [a]
++ String
". Defined types: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall m.
AvroEnvironment m -> Map AvroQualifiedName (AvroHydraAdapter m)
avroEnvironmentNamedAdapters AvroEnvironment m
env)
        Just AvroHydraAdapter m
ad -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AvroHydraAdapter m
ad
    Avro.SchemaUnion (Avro.Union [Schema]
schemas) -> if forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Schema]
nonNulls forall a. Ord a => a -> a -> Bool
> Int
1
        then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"general-purpose unions are not yet supported: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Schema
schema
        else if forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Schema]
nonNulls
        then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot generate the empty type"
        else if Bool
hasNull
        then forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
forOptional forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
L.head [Schema]
nonNulls
        else do
          AvroHydraAdapter m
ad <- forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
L.head [Schema]
nonNulls
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy AvroHydraAdapter m
ad) Schema
schema (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget AvroHydraAdapter m
ad) (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder AvroHydraAdapter m
ad)
      where
        hasNull :: Bool
hasNull = (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
L.filter Schema -> Bool
isNull) [Schema]
schemas
        nonNulls :: [Schema]
nonNulls = forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not 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 m)
     (Adapter
        (AvroEnvironment m)
        (AvroEnvironment m)
        Schema
        (Type m)
        Value
        (Term m))
forOptional Schema
s = do
          Adapter
  (AvroEnvironment m)
  (AvroEnvironment m)
  Schema
  (Type m)
  Value
  (Term m)
ad <- forall m.
(Ord m, Show m) =>
Schema -> Flow (AvroEnvironment m) (AvroHydraAdapter m)
avroHydraAdapter Schema
s
          let coder :: Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
coder = Coder {
                coderDecode :: Term m -> Flow (AvroEnvironment m) Value
coderDecode = \(TermOptional Maybe (Term m)
ot) -> case Maybe (Term m)
ot of
                  Maybe (Term m)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Value
Json.ValueNull
                  Just Term m
term -> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder Adapter
  (AvroEnvironment m)
  (AvroEnvironment m)
  Schema
  (Type m)
  Value
  (Term m)
ad) Term m
term,
                coderEncode :: Value -> Flow (AvroEnvironment m) (Term m)
coderEncode = \Value
v -> case Value
v of
                  Value
Json.ValueNull -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall m. Maybe (Term m) -> Term m
TermOptional forall a. Maybe a
Nothing
                  Value
_ -> forall m. Maybe (Term m) -> Term m
TermOptional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall s1 s2 t1 t2 v1 v2.
Adapter s1 s2 t1 t2 v1 v2 -> Coder s1 s2 v1 v2
adapterCoder Adapter
  (AvroEnvironment m)
  (AvroEnvironment m)
  Schema
  (Type m)
  Value
  (Term m)
ad) Value
v}
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2.
Bool -> t1 -> t2 -> Coder s1 s2 v1 v2 -> Adapter s1 s2 t1 t2 v1 v2
Adapter (forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> Bool
adapterIsLossy Adapter
  (AvroEnvironment m)
  (AvroEnvironment m)
  Schema
  (Type m)
  Value
  (Term m)
ad) Schema
schema (forall m. Type m -> Type m
Types.optional forall a b. (a -> b) -> a -> b
$ forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget Adapter
  (AvroEnvironment m)
  (AvroEnvironment m)
  Schema
  (Type m)
  Value
  (Term m)
ad) Coder (AvroEnvironment m) (AvroEnvironment m) Value (Term m)
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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

avroNameToHydraName :: AvroQualifiedName -> Name
avroNameToHydraName :: AvroQualifiedName -> Name
avroNameToHydraName (AvroQualifiedName Maybe String
mns String
local) = Namespace -> String -> Name
fromQname (String -> Namespace
Namespace forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
Y.fromMaybe String
"DEFAULT" Maybe String
mns) String
local

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

foreignKey :: Avro.Field -> Flow s (Maybe ForeignKey)
foreignKey :: forall s. Field -> Flow s (Maybe ForeignKey)
foreignKey Field
f = case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Value
v -> do
      Map String Value
m <- forall s. Value -> Flow s (Map String Value)
expectObject Value
v
      Name
tname <- String -> Name
Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. String -> Map String Value -> Flow s String
requireString String
"type" Map String Value
m
      Maybe String
pattern <- 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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate String
s 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 forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
avro_primaryKey forall a b. (a -> b) -> a -> b
$ Field -> Map String Value
Avro.fieldAnnotations Field
f of
    Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Value
v -> do
      String
s <- forall s. Value -> Flow s String
expectString Value
v
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FieldName -> (String -> Name) -> PrimaryKey
PrimaryKey (String -> FieldName
FieldName forall a b. (a -> b) -> a -> b
$ Field -> String
Avro.fieldName Field
f) 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 forall a. [a] -> [a]
L.reverse 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 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [String]
rest) String
local

putAvroHydraAdapter :: AvroQualifiedName -> AvroHydraAdapter m -> AvroEnvironment m -> AvroEnvironment m
putAvroHydraAdapter :: forall m.
AvroQualifiedName
-> AvroHydraAdapter m -> AvroEnvironment m -> AvroEnvironment m
putAvroHydraAdapter AvroQualifiedName
qname AvroHydraAdapter m
ad AvroEnvironment m
env = AvroEnvironment m
env {avroEnvironmentNamedAdapters :: Map AvroQualifiedName (AvroHydraAdapter m)
avroEnvironmentNamedAdapters = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AvroQualifiedName
qname AvroHydraAdapter m
ad forall a b. (a -> b) -> a -> b
$ forall m.
AvroEnvironment m -> Map AvroQualifiedName (AvroHydraAdapter m)
avroEnvironmentNamedAdapters AvroEnvironment m
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 = forall a b. ((a -> b) -> a -> b) -> ((a -> b) -> a -> b) -> a -> b
rewrite 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Array
Avro.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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Map_
Avro.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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Field] -> Record
Avro.Record forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Field -> f Field
forField [Field]
fields))
            NamedType
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NamedType
t
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Named -> Schema
Avro.SchemaNamed forall a b. (a -> b) -> a -> b
$ Named
n {namedType :: NamedType
Avro.namedType = NamedType
nt}
        Avro.SchemaUnion (Avro.Union [Schema]
schemas) -> Union -> Schema
Avro.SchemaUnion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Schema] -> Union
Avro.Union forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM Schema -> f Schema
recurse [Schema]
schemas))
        Schema
_ -> 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 forall a b. (a -> b) -> a -> b
$ Field -> Schema
Avro.fieldType Field
f
          forall (m :: * -> *) a. Monad m => a -> m a
return Field
f {fieldType :: Schema
Avro.fieldType = Schema
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
b then String
"true" else String
"false"
  Json.ValueString String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
  Json.ValueNumber Double
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (RealFrac a, Integral b) => a -> b
round Double
d) forall a. Eq a => a -> a -> Bool
== Double
d
    then forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round Double
d)
    else forall a. Show a => a -> String
show Double
d
  Value
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"string, number, or boolean" Value
v

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

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

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