SchemaJson.hs

-- Note: this is an automatically generated file. Do not edit.

-- | JSON serialization and deserialization for Avro schemas

module Hydra.Avro.SchemaJson where

import qualified Hydra.Ast as Ast
import qualified Hydra.Avro.Schema as Schema
import qualified Hydra.Coders as Coders
import qualified Hydra.Core as Core
import qualified Hydra.Docs as Docs
import qualified Hydra.Error.Checking as Checking
import qualified Hydra.Error.Core as ErrorCore
import qualified Hydra.Error.File as ErrorFile
import qualified Hydra.Error.Packaging as ErrorPackaging
import qualified Hydra.Error.System as ErrorSystem
import qualified Hydra.Errors as Errors
import qualified Hydra.File as File
import qualified Hydra.Graph as Graph
import qualified Hydra.Json.Model as Model
import qualified Hydra.Json.Parser as Parser
import qualified Hydra.Json.Writer as Writer
import qualified Hydra.Overlay.Haskell.Lib.Eithers as Eithers
import qualified Hydra.Overlay.Haskell.Lib.Equality as Equality
import qualified Hydra.Overlay.Haskell.Lib.Lists as Lists
import qualified Hydra.Overlay.Haskell.Lib.Literals as Literals
import qualified Hydra.Overlay.Haskell.Lib.Logic as Logic
import qualified Hydra.Overlay.Haskell.Lib.Maps as Maps
import qualified Hydra.Overlay.Haskell.Lib.Optionals as Optionals
import qualified Hydra.Overlay.Haskell.Lib.Pairs as Pairs
import qualified Hydra.Overlay.Haskell.Lib.Strings as Strings
import qualified Hydra.Packaging as Packaging
import qualified Hydra.Parsing as Parsing
import qualified Hydra.Paths as Paths
import qualified Hydra.Query as Query
import qualified Hydra.Regex as Regex
import qualified Hydra.Relational as Relational
import qualified Hydra.System as System
import qualified Hydra.Tabular as Tabular
import qualified Hydra.Testing as Testing
import qualified Hydra.Time as Time
import qualified Hydra.Topology as Topology
import qualified Hydra.Typed as Typed
import qualified Hydra.Typing as Typing
import qualified Hydra.Util as Util
import qualified Hydra.Validation as Validation
import qualified Hydra.Variants as Variants
import Prelude hiding  (Enum, Ordering, decodeFloat, encodeFloat, fail, map, pure, sum)
import qualified Data.Scientific as Sci
import qualified Data.Map as M

-- | The JSON attribute name for the list of alternate names of a named type or field
avroAliases :: String
avroAliases = "aliases"

-- | The JSON type-name value identifying an Avro array schema
avroArray :: String
avroArray = "array"

-- | The JSON value identifying ascending field order
avroAscending :: String
avroAscending = "ascending"

-- | The JSON type-name value identifying the Avro boolean primitive
avroBoolean :: String
avroBoolean = "boolean"

-- | The JSON type-name value identifying the Avro bytes primitive
avroBytes :: String
avroBytes = "bytes"

-- | The JSON attribute name for a field's or enum's default value
avroDefault :: String
avroDefault = "default"

-- | The JSON value identifying descending field order
avroDescending :: String
avroDescending = "descending"

-- | The JSON attribute name for a named type's or field's documentation string
avroDoc :: String
avroDoc = "doc"

-- | The JSON type-name value identifying the Avro double primitive
avroDouble :: String
avroDouble = "double"

-- | The JSON type-name value identifying an Avro enum schema
avroEnum :: String
avroEnum = "enum"

-- | The JSON attribute name for a record's list of fields
avroFields :: String
avroFields = "fields"

-- | The JSON type-name value identifying an Avro fixed schema
avroFixed :: String
avroFixed = "fixed"

-- | The JSON type-name value identifying the Avro float primitive
avroFloat :: String
avroFloat = "float"

-- | The JSON value identifying ignored field order
avroIgnore :: String
avroIgnore = "ignore"

-- | The JSON type-name value identifying the Avro int primitive
avroInt :: String
avroInt = "int"

-- | The JSON attribute name for an array schema's item type
avroItems :: String
avroItems = "items"

-- | The JSON type-name value identifying the Avro long primitive
avroLong :: String
avroLong = "long"

-- | The JSON type-name value identifying an Avro map schema
avroMap :: String
avroMap = "map"

-- | The JSON attribute name for a named type's or field's name
avroName :: String
avroName = "name"

-- | The JSON attribute name for a named type's namespace
avroNamespace :: String
avroNamespace = "namespace"

-- | The JSON type-name value identifying the Avro null primitive
avroNull :: String
avroNull = "null"

-- | The JSON attribute name for a field's sort order
avroOrder :: String
avroOrder = "order"

-- | The JSON type-name value identifying an Avro record schema
avroRecord :: String
avroRecord = "record"

-- | Create a coder between Avro schemas and JSON values
avroSchemaJsonCoder :: t0 -> Coders.Coder Schema.Schema Model.Value Errors.Error
avroSchemaJsonCoder cx =
    Coders.Coder {
      Coders.coderEncode = (\schema -> Right (encodeSchema schema)),
      Coders.coderDecode = (\json -> decodeSchema cx json)}

-- | Create a coder between Avro schemas and JSON strings
avroSchemaStringCoder :: t0 -> Coders.Coder Schema.Schema String Errors.Error
avroSchemaStringCoder cx =
    Coders.Coder {
      Coders.coderEncode = (\schema -> Right (showJsonValue (encodeSchema schema))),
      Coders.coderDecode = (\s -> Eithers.bind (Eithers.either (\e -> err cx e) (\v -> Right v) (stringToJsonValue s)) (\json -> decodeSchema cx json))}

-- | The JSON attribute name for a fixed schema's byte size
avroSize :: String
avroSize = "size"

-- | The JSON type-name value identifying the Avro string primitive
avroString :: String
avroString = "string"

-- | The JSON attribute name for an enum schema's list of symbols
avroSymbols :: String
avroSymbols = "symbols"

-- | The JSON attribute name for a schema's type name
avroType :: String
avroType = "type"

-- | The JSON attribute name for a map schema's value type
avroValues :: String
avroValues = "values"

-- | Decode aliases from a JSON object map
decodeAliases :: t0 -> M.Map String Model.Value -> Either t1 (Maybe [String])
decodeAliases cx m =
    Eithers.bind (optArrayE cx avroAliases m) (\mArr -> Optionals.cases mArr (Right Nothing) (\arr -> Eithers.map (\strs -> Optionals.pure strs) (Eithers.mapList (expectStringE cx) arr)))

-- | Decode an Avro array schema from a JSON object map
decodeArraySchema :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.Schema
decodeArraySchema cx m =
    Eithers.bind (requireE cx avroItems m) (\items -> Eithers.map (\s -> Schema.SchemaArray (Schema.Array {
      Schema.arrayItems = s})) (decodeSchema cx items))

-- | Decode an Avro enum type from a JSON object map
decodeEnum :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.NamedType
decodeEnum cx m =
    Eithers.bind (requireArrayE cx avroSymbols m) (\syms -> Eithers.bind (Eithers.mapList (expectStringE cx) syms) (\symbols -> Eithers.bind (optStringE cx avroDefault m) (\defVal -> Right (Schema.NamedTypeEnum (Schema.Enum {
      Schema.enumSymbols = symbols,
      Schema.enumDefault = defVal})))))

-- | Decode an Avro field from a JSON object map
decodeField :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.Field
decodeField cx m =
    Eithers.bind (requireStringE cx avroName m) (\name -> Eithers.bind (optStringE cx avroDoc m) (\fdoc -> Eithers.bind (requireE cx avroType m) (\typeJson -> Eithers.bind (decodeSchema cx typeJson) (\fieldType -> Eithers.bind (Eithers.bind (optStringE cx avroOrder m) (\mOrd -> Eithers.mapOptional (decodeOrder cx) mOrd)) (\order -> Eithers.bind (decodeAliases cx m) (\aliases -> Right (Schema.Field {
      Schema.fieldName = name,
      Schema.fieldDoc = fdoc,
      Schema.fieldType = fieldType,
      Schema.fieldDefault = (optE avroDefault m),
      Schema.fieldOrder = order,
      Schema.fieldAliases = aliases,
      Schema.fieldAnnotations = (getAnnotations m)})))))))

-- | Decode an Avro fixed type from a JSON object map
decodeFixed :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.NamedType
decodeFixed cx m =
    Eithers.bind (requireNumberE cx avroSize m) (\n ->
      let size = Literals.bigintToInt32 (Literals.decimalToBigint n)
      in (Right (Schema.NamedTypeFixed (Schema.Fixed {
        Schema.fixedSize = size}))))

-- | Decode an Avro map schema from a JSON object map
decodeMapSchema :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.Schema
decodeMapSchema cx m =
    Eithers.bind (requireE cx avroValues m) (\values -> Eithers.map (\s -> Schema.SchemaMap (Schema.Map {
      Schema.mapValues = s})) (decodeSchema cx values))

-- | Decode a named Avro schema from a JSON object map and a decoded named type result
decodeNamedSchema :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.NamedType -> Either Errors.Error Schema.Schema
decodeNamedSchema cx m namedTypeResult =
    Eithers.bind (requireStringE cx avroName m) (\name -> Eithers.bind (optStringE cx avroNamespace m) (\ns -> Eithers.bind (optStringE cx avroDoc m) (\sdoc -> Eithers.bind (decodeAliases cx m) (\aliases -> Eithers.bind namedTypeResult (\namedType -> Right (Schema.SchemaNamed (Schema.Named {
      Schema.namedName = name,
      Schema.namedNamespace = ns,
      Schema.namedAliases = aliases,
      Schema.namedDoc = sdoc,
      Schema.namedType = namedType,
      Schema.namedAnnotations = (getAnnotations m)})))))))

-- | Decode an Avro schema from a JSON object given the type name
decodeObjectSchema :: t0 -> M.Map String Model.Value -> String -> Either Errors.Error Schema.Schema
decodeObjectSchema cx m typeName =
    Logic.ifElse (Equality.equal typeName "array") (decodeArraySchema cx m) (Logic.ifElse (Equality.equal typeName "map") (decodeMapSchema cx m) (Logic.ifElse (Equality.equal typeName "record") (decodeNamedSchema cx m (decodeRecord cx m)) (Logic.ifElse (Equality.equal typeName "enum") (decodeNamedSchema cx m (decodeEnum cx m)) (Logic.ifElse (Equality.equal typeName "fixed") (decodeNamedSchema cx m (decodeFixed cx m)) (Optionals.cases (decodePrimitiveName typeName) (err cx (Strings.concat [
      "unknown type: ",
      typeName])) (\p -> Right (Schema.SchemaPrimitive p)))))))

-- | Decode an Avro field ordering from a string
decodeOrder :: t0 -> String -> Either Errors.Error Schema.Order
decodeOrder cx o =
    Logic.ifElse (Equality.equal o "ascending") (Right Schema.OrderAscending) (Logic.ifElse (Equality.equal o "descending") (Right Schema.OrderDescending) (Logic.ifElse (Equality.equal o "ignore") (Right Schema.OrderIgnore) (err cx (Strings.concat [
      "unknown order: ",
      o]))))

-- | Decode a primitive type name string to a Primitive, or Nothing if not a primitive
decodePrimitiveName :: String -> Maybe Schema.Primitive
decodePrimitiveName s =
    Logic.ifElse (Equality.equal s "null") (Just Schema.PrimitiveNull) (Logic.ifElse (Equality.equal s "boolean") (Just Schema.PrimitiveBoolean) (Logic.ifElse (Equality.equal s "int") (Just Schema.PrimitiveInt) (Logic.ifElse (Equality.equal s "long") (Just Schema.PrimitiveLong) (Logic.ifElse (Equality.equal s "float") (Just Schema.PrimitiveFloat) (Logic.ifElse (Equality.equal s "double") (Just Schema.PrimitiveDouble) (Logic.ifElse (Equality.equal s "bytes") (Just Schema.PrimitiveBytes) (Logic.ifElse (Equality.equal s "string") (Just Schema.PrimitiveString) Nothing)))))))

-- | Decode an Avro record type from a JSON object map
decodeRecord :: t0 -> M.Map String Model.Value -> Either Errors.Error Schema.NamedType
decodeRecord cx m =
    Eithers.bind (requireArrayE cx avroFields m) (\fieldJsons -> Eithers.bind (Eithers.mapList (\fj -> Eithers.bind (expectObjectE cx fj) (\fm -> decodeField cx fm)) fieldJsons) (\fields -> Right (Schema.NamedTypeRecord (Schema.Record {
      Schema.recordFields = fields}))))

-- | Decode an Avro schema from a JSON value
decodeSchema :: t0 -> Model.Value -> Either Errors.Error Schema.Schema
decodeSchema cx v =
    case v of
      Model.ValueString v0 -> Optionals.cases (decodePrimitiveName v0) (Right (Schema.SchemaReference v0)) (\p -> Right (Schema.SchemaPrimitive p))
      Model.ValueArray v0 -> Eithers.map (\decoded -> Schema.SchemaUnion (Schema.Union decoded)) (Eithers.mapList (decodeSchema cx) v0)
      Model.ValueObject v0 ->
        let m = Maps.fromList v0
        in (Eithers.bind (requireStringE cx avroType m) (\typeName -> decodeObjectSchema cx m typeName))
      _ -> err cx (Strings.concat [
        "unexpected JSON value for schema: ",
        (showJsonValue v)])

-- | Encode annotations as key-value pairs with @ prefix on keys
encodeAnnotations :: M.Map String t0 -> [(String, t0)]
encodeAnnotations m = Lists.map (\entry -> (Strings.concat2 "@" (Pairs.first entry), (Pairs.second entry))) (Maps.toList m)

-- | Encode an Avro array schema to a JSON object
encodeArray :: Schema.Array -> Model.Value
encodeArray arr =
    Model.ValueObject [
      ("type", (Model.ValueString "array")),
      ("items", (encodeSchema (Schema.arrayItems arr)))]

-- | Encode an Avro enum type as key-value pairs
encodeEnum :: Schema.Enum -> [(String, Model.Value)]
encodeEnum e =
    Lists.concat [
      [
        ("type", (Model.ValueString "enum"))],
      [
        ("symbols", (Model.ValueArray (Lists.map (\s -> Model.ValueString s) (Schema.enumSymbols e))))],
      (Optionals.cases (Schema.enumDefault e) [] (\d -> [
        ("default", (Model.ValueString d))]))]

-- | Encode an Avro field to a JSON object
encodeField :: Schema.Field -> Model.Value
encodeField f =
    Model.ValueObject (Lists.concat [
      [
        ("name", (Model.ValueString (Schema.fieldName f)))],
      [
        ("type", (encodeSchema (Schema.fieldType f)))],
      (Optionals.cases (Schema.fieldDoc f) [] (\d -> [
        ("doc", (Model.ValueString d))])),
      (Optionals.cases (Schema.fieldDefault f) [] (\d -> [
        ("default", d)])),
      (Optionals.cases (Schema.fieldOrder f) [] (\o -> [
        encodeOrder o])),
      (Optionals.cases (Schema.fieldAliases f) [] (\als -> [
        ("aliases", (Model.ValueArray (Lists.map (\a -> Model.ValueString a) als)))])),
      (encodeAnnotations (Schema.fieldAnnotations f))])

-- | Encode an Avro fixed type as key-value pairs
encodeFixed :: Schema.Fixed -> [(String, Model.Value)]
encodeFixed f =
    [
      ("type", (Model.ValueString "fixed")),
      ("size", (Model.ValueNumber (Literals.bigintToDecimal (Literals.int32ToBigint (Schema.fixedSize f)))))]

-- | Encode an Avro map schema to a JSON object
encodeMap :: Schema.Map -> Model.Value
encodeMap mp =
    Model.ValueObject [
      ("type", (Model.ValueString "map")),
      ("values", (encodeSchema (Schema.mapValues mp)))]

-- | Encode an Avro named type to a JSON object
encodeNamed :: Schema.Named -> Model.Value
encodeNamed n =
    Model.ValueObject (Lists.concat [
      [
        ("name", (Model.ValueString (Schema.namedName n)))],
      (Optionals.cases (Schema.namedNamespace n) [] (\ns -> [
        ("namespace", (Model.ValueString ns))])),
      (Optionals.cases (Schema.namedDoc n) [] (\d -> [
        ("doc", (Model.ValueString d))])),
      (Optionals.cases (Schema.namedAliases n) [] (\als -> [
        ("aliases", (Model.ValueArray (Lists.map (\a -> Model.ValueString a) als)))])),
      (encodeNamedType (Schema.namedType n)),
      (encodeAnnotations (Schema.namedAnnotations n))])

-- | Encode the specific variant of a named Avro type
encodeNamedType :: Schema.NamedType -> [(String, Model.Value)]
encodeNamedType nt =
    case nt of
      Schema.NamedTypeEnum v0 -> encodeEnum v0
      Schema.NamedTypeFixed v0 -> encodeFixed v0
      Schema.NamedTypeRecord v0 -> encodeRecord v0

-- | Encode an Avro field ordering as a key-value pair
encodeOrder :: Schema.Order -> (String, Model.Value)
encodeOrder o =
    (
      "order",
      (Model.ValueString (case o of
        Schema.OrderAscending -> "ascending"
        Schema.OrderDescending -> "descending"
        Schema.OrderIgnore -> "ignore")))

-- | Encode an Avro primitive type as a JSON string
encodePrimitive :: Schema.Primitive -> Model.Value
encodePrimitive p =
    Model.ValueString (case p of
      Schema.PrimitiveNull -> "null"
      Schema.PrimitiveBoolean -> "boolean"
      Schema.PrimitiveInt -> "int"
      Schema.PrimitiveLong -> "long"
      Schema.PrimitiveFloat -> "float"
      Schema.PrimitiveDouble -> "double"
      Schema.PrimitiveBytes -> "bytes"
      Schema.PrimitiveString -> "string")

-- | Encode an Avro record type as key-value pairs
encodeRecord :: Schema.Record -> [(String, Model.Value)]
encodeRecord r =
    [
      ("type", (Model.ValueString "record")),
      ("fields", (Model.ValueArray (Lists.map encodeField (Schema.recordFields r))))]

-- | Encode an Avro schema to a JSON value
encodeSchema :: Schema.Schema -> Model.Value
encodeSchema schema =
    case schema of
      Schema.SchemaPrimitive v0 -> encodePrimitive v0
      Schema.SchemaArray v0 -> encodeArray v0
      Schema.SchemaMap v0 -> encodeMap v0
      Schema.SchemaNamed v0 -> encodeNamed v0
      Schema.SchemaReference v0 -> Model.ValueString v0
      Schema.SchemaUnion v0 -> encodeUnion v0

-- | Encode an Avro union as a JSON array of schemas
encodeUnion :: Schema.Union -> Model.Value
encodeUnion u = Model.ValueArray (Lists.map encodeSchema (Schema.unUnion u))

-- | Construct an error result with a message in context
err :: t0 -> String -> Either Errors.Error t1
err cx msg = Left (Errors.ErrorOther (Errors.OtherError msg))

-- | Extract a JSON array or return an error
expectArrayE :: t0 -> Model.Value -> Either t1 [Model.Value]
expectArrayE cx value =
    case value of
      Model.ValueArray v0 -> Right v0

-- | Extract a JSON number or return an error
expectNumberE :: t0 -> Model.Value -> Either t1 Sci.Scientific
expectNumberE cx value =
    case value of
      Model.ValueNumber v0 -> Right v0

-- | Extract a JSON object as a name-keyed map or return an error (field order is dropped)
expectObjectE :: t0 -> Model.Value -> Either t1 (M.Map String Model.Value)
expectObjectE cx value =
    case value of
      Model.ValueObject v0 -> Right (Maps.fromList v0)

-- | Extract a JSON string or return an error
expectStringE :: t0 -> Model.Value -> Either t1 String
expectStringE cx value =
    case value of
      Model.ValueString v0 -> Right v0

-- | Extract annotation entries (keys starting with @) from a JSON object map
getAnnotations :: M.Map String t0 -> M.Map String t0
getAnnotations m =
    Maps.fromList (Optionals.givens (Lists.map (\entry ->
      let k = Pairs.first entry
          v = Pairs.second entry
      in (Logic.ifElse (Equality.equal (Optionals.withDefault 0 (Strings.charAt 0 k)) 64) (Optionals.pure (Strings.fromList (Lists.drop 1 (Strings.toList k)), v)) Nothing)) (Maps.toList m)))

-- | Look up an optional array attribute in a JSON object map
optArrayE :: Ord t1 => (t0 -> t1 -> M.Map t1 Model.Value -> Either t2 (Maybe [Model.Value]))
optArrayE cx fname m =
    Optionals.cases (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\a -> Optionals.pure a) (expectArrayE cx v))

-- | Look up an optional attribute in a JSON object map
optE :: Ord t0 => (t0 -> M.Map t0 t1 -> Maybe t1)
optE k m = Maps.lookup k m

-- | Look up an optional string attribute in a JSON object map
optStringE :: Ord t1 => (t0 -> t1 -> M.Map t1 Model.Value -> Either t2 (Maybe String))
optStringE cx fname m =
    Optionals.cases (Maps.lookup fname m) (Right Nothing) (\v -> Eithers.map (\s -> Optionals.pure s) (expectStringE cx v))

-- | Look up a required array attribute in a JSON object map
requireArrayE :: t0 -> String -> M.Map String Model.Value -> Either Errors.Error [Model.Value]
requireArrayE cx fname m = Eithers.bind (requireE cx fname m) (\v -> expectArrayE cx v)

-- | Look up a required attribute in a JSON object map
requireE :: t0 -> String -> M.Map String t1 -> Either Errors.Error t1
requireE cx fname m =
    Optionals.cases (Maps.lookup fname m) (err cx (Strings.concat [
      "required attribute ",
      (Literals.printString fname),
      " not found"])) (\v -> Right v)

-- | Look up a required number attribute in a JSON object map
requireNumberE :: t0 -> String -> M.Map String Model.Value -> Either Errors.Error Sci.Scientific
requireNumberE cx fname m = Eithers.bind (requireE cx fname m) (\v -> expectNumberE cx v)

-- | Look up a required string attribute in a JSON object map
requireStringE :: t0 -> String -> M.Map String Model.Value -> Either Errors.Error String
requireStringE cx fname m = Eithers.bind (requireE cx fname m) (\v -> expectStringE cx v)

-- | Convert a JSON value to its string representation
showJsonValue :: Model.Value -> String
showJsonValue v = Writer.printJson v

-- | Parse a JSON string, returning Either for compatibility
stringToJsonValue :: String -> Either String Model.Value
stringToJsonValue s =
    (\x -> case x of
      Parsing.ParseResultSuccess v0 -> Right (Parsing.parseSuccessValue v0)
      Parsing.ParseResultFailure v0 -> Left (Parsing.parseErrorMessage v0)) (Parser.parseJson s)

-- | Construct an error for unexpected values
unexpectedE :: t0 -> String -> String -> Either Errors.Error t1
unexpectedE cx expected found =
    err cx (Strings.concat [
      "Expected ",
      expected,
      ", found: ",
      found])