module Hydra.Ext.Avro.SchemaJson where

import Hydra.All
import Hydra.Impl.Haskell.Dsl.Standard
import Hydra.Impl.Haskell.Ext.Json.Serde
import qualified Hydra.Ext.Avro.Schema as Avro
import qualified Hydra.Ext.Json.Model as Json
import Hydra.Ext.Json.Eliminate

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Maybe as Y


avro_aliases :: String
avro_aliases = String
"aliases"
avro_array :: String
avro_array = String
"array"
avro_ascending :: String
avro_ascending = String
"ascending"
avro_boolean :: String
avro_boolean = String
"boolean"
avro_bytes :: String
avro_bytes = String
"bytes"
avro_default :: String
avro_default = String
"default"
avro_descending :: String
avro_descending = String
"descending"
avro_doc :: String
avro_doc = String
"doc"
avro_double :: String
avro_double = String
"double"
avro_enum :: String
avro_enum = String
"enum"
avro_fields :: String
avro_fields = String
"fields"
avro_fixed :: String
avro_fixed = String
"fixed"
avro_float :: String
avro_float = String
"float"
avro_ignore :: String
avro_ignore = String
"ignore"
avro_int :: String
avro_int = String
"int"
avro_items :: String
avro_items = String
"items"
avro_long :: String
avro_long = String
"long"
avro_map :: String
avro_map = String
"map"
avro_name :: String
avro_name = String
"name"
avro_namespace :: String
avro_namespace = String
"namespace"
avro_null :: String
avro_null = String
"null"
avro_order :: String
avro_order = String
"order"
avro_record :: String
avro_record = String
"record"
avro_size :: String
avro_size = String
"size"
avro_string :: String
avro_string = String
"string"
avro_symbols :: String
avro_symbols = String
"symbols"
avro_type :: String
avro_type = String
"type"
avro_values :: String
avro_values = String
"values"

avroSchemaJsonCoder :: Coder s s Avro.Schema Json.Value
avroSchemaJsonCoder :: forall s. Coder s s Schema Value
avroSchemaJsonCoder = Coder {
  coderEncode :: Schema -> Flow s Value
coderEncode = \Schema
schema -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not implemented",
  coderDecode :: Value -> Flow s Schema
coderDecode = forall s. Value -> Flow s Schema
decodeNamedSchema}

avroSchemaStringCoder :: Coder s s Avro.Schema String
avroSchemaStringCoder :: forall s. Coder s s Schema String
avroSchemaStringCoder = Coder {
  coderEncode :: Schema -> Flow s String
coderEncode = \Schema
schema -> Value -> String
valueToString 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 s. Coder s s Schema Value
avroSchemaJsonCoder Schema
schema,
  coderDecode :: String -> Flow s Schema
coderDecode = \String
s -> do
    Value
json <- case String -> Either String Value
stringToValue 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 parse JSON: " forall a. [a] -> [a] -> [a]
++ String
msg
      Right Value
j -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
j
    forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall s. Coder s s Schema Value
avroSchemaJsonCoder Value
json}

decodeAliases :: M.Map String Json.Value -> Flow s (Maybe [String])
decodeAliases :: forall s. Map String Value -> Flow s (Maybe [String])
decodeAliases Map String Value
m = do
  Maybe [Value]
aliasesJson <- forall s. String -> Map String Value -> Flow s (Maybe [Value])
optArray String
avro_aliases Map String Value
m
  case Maybe [Value]
aliasesJson of
    Maybe [Value]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just [Value]
a -> forall a. a -> Maybe a
Just 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. Value -> Flow s String
expectString [Value]
a

decodeEnum :: M.Map String Json.Value -> Flow s Avro.NamedType
decodeEnum :: forall s. Map String Value -> Flow s NamedType
decodeEnum Map String Value
m = do
  [Value]
symbolsJson <- forall s. String -> Map String Value -> Flow s [Value]
requireArray String
avro_symbols Map String Value
m
  [String]
symbols <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
CM.mapM forall s. Value -> Flow s String
expectString [Value]
symbolsJson
  Maybe String
dflt <- forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
avro_default Map String Value
m
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Enum_ -> NamedType
Avro.NamedTypeEnum forall a b. (a -> b) -> a -> b
$ [String] -> Maybe String -> Enum_
Avro.Enum_ [String]
symbols Maybe String
dflt

decodeField :: M.Map String Json.Value -> Flow s Avro.Field
decodeField :: forall s. Map String Value -> Flow s Field
decodeField Map String Value
m = do
  String
fname <- forall s. String -> Map String Value -> Flow s String
requireString String
avro_name Map String Value
m
  Maybe String
doc <- forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
avro_doc Map String Value
m
  Schema
typ <- forall s. String -> Map String Value -> Flow s Value
require String
avro_type Map String Value
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Value -> Flow s Schema
decodeSchema
  let dflt :: Maybe Value
dflt = String -> Map String Value -> Maybe Value
opt String
avro_default Map String Value
m
  Maybe Order
order <- case String -> Map String Value -> Maybe Value
opt String
avro_order Map String Value
m of
    Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Value
o -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Value -> Flow s String
expectString Value
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. String -> Flow s Order
decodeOrder)
  Maybe [String]
aliases <- forall s. Map String Value -> Flow s (Maybe [String])
decodeAliases Map String Value
m
  let anns :: Map String Value
anns = Map String Value -> Map String Value
getAnnotations Map String Value
m
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
-> Maybe String
-> Schema
-> Maybe Value
-> Maybe Order
-> Maybe [String]
-> Map String Value
-> Field
Avro.Field String
fname Maybe String
doc Schema
typ Maybe Value
dflt Maybe Order
order Maybe [String]
aliases Map String Value
anns

decodeFixed :: M.Map String Json.Value -> Flow s Avro.NamedType
decodeFixed :: forall s. Map String Value -> Flow s NamedType
decodeFixed Map String Value
m = do
    Int
size <- forall {a} {b}. (RealFrac a, Integral b) => a -> b
doubleToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. String -> Map String Value -> Flow s Double
requireNumber String
avro_size Map String Value
m
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Fixed -> NamedType
Avro.NamedTypeFixed forall a b. (a -> b) -> a -> b
$ Int -> Fixed
Avro.Fixed Int
size
  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

decodeNamedSchema :: Json.Value -> Flow s Avro.Schema
decodeNamedSchema :: forall s. Value -> Flow s Schema
decodeNamedSchema Value
value = do
  Map String Value
m <- forall s. Value -> Flow s (Map String Value)
expectObject Value
value
  String
name <- forall s. String -> Map String Value -> Flow s String
requireString String
avro_name Map String Value
m
  Maybe String
ns <- forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
avro_namespace Map String Value
m
  String
typ <- forall s. String -> Map String Value -> Flow s String
requireString String
avro_type Map String Value
m
  NamedType
nt <- case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
typ forall {s}. Map String (Map String Value -> Flow s NamedType)
decoders of
    Maybe (Map String Value -> Flow s NamedType)
Nothing -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"Avro type" String
typ
    Just Map String Value -> Flow s NamedType
d -> Map String Value -> Flow s NamedType
d Map String Value
m
  Maybe [String]
aliases <- forall s. Map String Value -> Flow s (Maybe [String])
decodeAliases Map String Value
m
  Maybe String
doc <- forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
avro_doc Map String Value
m
  let anns :: Map String Value
anns = Map String Value -> Map String Value
getAnnotations Map String Value
m
  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
$ String
-> Maybe String
-> Maybe [String]
-> Maybe String
-> NamedType
-> Map String Value
-> Named
Avro.Named String
name Maybe String
ns Maybe [String]
aliases Maybe String
doc NamedType
nt Map String Value
anns
  where
    decoders :: Map String (Map String Value -> Flow s NamedType)
decoders = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
      (String
avro_enum, forall s. Map String Value -> Flow s NamedType
decodeEnum),
      (String
avro_fixed, forall s. Map String Value -> Flow s NamedType
decodeFixed),
      (String
avro_record, forall s. Map String Value -> Flow s NamedType
decodeRecord)]

decodeOrder :: String -> Flow s Avro.Order
decodeOrder :: forall s. String -> Flow s Order
decodeOrder String
o = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
o Map String Order
orderMap of
    Maybe Order
Nothing -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"ordering" String
o
    Just Order
order -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Order
order
  where
    orderMap :: Map String Order
orderMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
      (String
avro_ascending, Order
Avro.OrderAscending),
      (String
avro_descending, Order
Avro.OrderDescending),
      (String
avro_ignore, Order
Avro.OrderIgnore)]

decodeRecord :: M.Map String Json.Value -> Flow s Avro.NamedType
decodeRecord :: forall s. Map String Value -> Flow s NamedType
decodeRecord Map String Value
m = do
  [Field]
fields <- forall s. String -> Map String Value -> Flow s [Value]
requireArray String
avro_fields Map String Value
m 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 s. Value -> Flow s (Map String Value)
expectObject 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 s. Map String Value -> Flow s Field
decodeField
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Record -> NamedType
Avro.NamedTypeRecord forall a b. (a -> b) -> a -> b
$ [Field] -> Record
Avro.Record [Field]
fields

decodeSchema :: Json.Value -> Flow s Avro.Schema
decodeSchema :: forall s. Value -> Flow s Schema
decodeSchema Value
v = case Value
v of
  Json.ValueArray [Value]
els -> 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 forall s. Value -> Flow s Schema
decodeSchema [Value]
els))
  Json.ValueObject Map String Value
m -> do
      String
typ <- forall s. String -> Map String Value -> Flow s String
requireString String
avro_type Map String Value
m
      case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
typ forall {s}. Map String (Map String Value -> Flow s Schema)
decoders of
        Maybe (Map String Value -> Flow s Schema)
Nothing -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"\"array\" or \"map\"" String
typ
        Just Map String Value -> Flow s Schema
d -> Map String Value -> Flow s Schema
d Map String Value
m
    where
      decoders :: Map String (Map String Value -> Flow s Schema)
decoders = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
        (String
avro_array, \Map String Value
m -> do
          Schema
items <- forall s. String -> Map String Value -> Flow s Value
require String
avro_items Map String Value
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Value -> Flow s Schema
decodeSchema
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array -> Schema
Avro.SchemaArray forall a b. (a -> b) -> a -> b
$ Schema -> Array
Avro.Array Schema
items),
        (String
avro_enum, \Map String Value
m -> forall s. Value -> Flow s Schema
decodeNamedSchema forall a b. (a -> b) -> a -> b
$ Map String Value -> Value
Json.ValueObject Map String Value
m),
        (String
avro_fixed, \Map String Value
m -> forall s. Value -> Flow s Schema
decodeNamedSchema forall a b. (a -> b) -> a -> b
$ Map String Value -> Value
Json.ValueObject Map String Value
m),
        (String
avro_map, \Map String Value
m -> do
          Schema
values <- forall s. String -> Map String Value -> Flow s Value
require String
avro_values Map String Value
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Value -> Flow s Schema
decodeSchema
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map_ -> Schema
Avro.SchemaMap forall a b. (a -> b) -> a -> b
$ Schema -> Map_
Avro.Map_ Schema
values),
        (String
avro_record, \Map String Value
m -> forall s. Value -> Flow s Schema
decodeNamedSchema forall a b. (a -> b) -> a -> b
$ Map String Value -> Value
Json.ValueObject Map String Value
m)]
  Json.ValueString String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
s Map String Primitive
schemas of
      Just Primitive
prim -> Primitive -> Schema
Avro.SchemaPrimitive Primitive
prim
      Maybe Primitive
Nothing -> String -> Schema
Avro.SchemaReference String
s
    where
      schemas :: Map String Primitive
schemas = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [
        (String
avro_boolean, Primitive
Avro.PrimitiveBoolean),
        (String
avro_bytes, Primitive
Avro.PrimitiveBytes),
        (String
avro_double, Primitive
Avro.PrimitiveDouble),
        (String
avro_float, Primitive
Avro.PrimitiveFloat),
        (String
avro_int, Primitive
Avro.PrimitiveInt),
        (String
avro_long, Primitive
Avro.PrimitiveLong),
        (String
avro_null, Primitive
Avro.PrimitiveNull),
        (String
avro_string, Primitive
Avro.PrimitiveString)]
  Value
Json.ValueNull -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Primitive -> Schema
Avro.SchemaPrimitive forall a b. (a -> b) -> a -> b
$ Primitive
Avro.PrimitiveNull
  Value
_ -> forall (m :: * -> *) a1 a2.
(MonadFail m, Show a1) =>
String -> a1 -> m a2
unexpected String
"JSON array, object, or string" Value
v

getAnnotations :: M.Map String Json.Value -> M.Map String Json.Value
getAnnotations :: Map String Value -> Map String Value
getAnnotations = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
L.filter forall {b}. (String, b) -> Bool
isAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
  where
    isAnnotation :: (String, b) -> Bool
isAnnotation (String
k, b
_) = forall a. Int -> [a] -> [a]
L.take Int
1 String
k forall a. Eq a => a -> a -> Bool
== String
"@"