{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier4.Langs.Avro.Schema where

import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Dsl.Types as Types


avroSchemaModule :: Module
avroSchemaModule :: Module
avroSchemaModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe [Char] -> Module
Module Namespace
ns [Element]
elements [Module
jsonModelModule] [Module]
tier0Modules (Maybe [Char] -> Module) -> Maybe [Char] -> Module
forall a b. (a -> b) -> a -> b
$
    [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
"A model for Avro schemas. Based on the Avro 1.11.1 specification:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
      [Char]
"  https://avro.apache.org/docs/1.11.1/specification")
  where
    ns :: Namespace
ns = [Char] -> Namespace
Namespace [Char]
"hydra/langs/avro/schema"
    def :: [Char] -> Type -> Element
def = Namespace -> [Char] -> Type -> Element
datatype Namespace
ns
    avro :: [Char] -> Type
avro = Namespace -> [Char] -> Type
typeref Namespace
ns
    json :: [Char] -> Type
json = Namespace -> [Char] -> Type
typeref (Namespace -> [Char] -> Type) -> Namespace -> [Char] -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
jsonModelModule

    elements :: [Element]
elements = [
      [Char] -> Type -> Element
def [Char]
"Array" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"items"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Schema"],

      [Char] -> Type -> Element
def [Char]
"Enum" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"symbols"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc ([Char]
"a JSON array, listing symbols, as JSON strings. All symbols in an enum must be unique; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"duplicates are prohibited. Every symbol must match the regular expression [A-Za-z_][A-Za-z0-9_]* " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"(the same requirement as for names)") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list Type
string,
          [Char]
"default"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc ([Char]
"A default value for this enumeration, used during resolution when the reader encounters " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"a symbol from the writer that isn’t defined in the reader’s schema. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
              [Char]
"The value provided here must be a JSON string that’s a member of the symbols array") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string],

      [Char] -> Type -> Element
def [Char]
"Field" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON string providing the name of the field"
            Type
string,
          [Char]
"doc"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON string describing this field for users" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string,
          [Char]
"type"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a schema" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            [Char] -> Type
avro [Char]
"Schema",
          [Char]
"default"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"default value for this field, only used when reading instances that lack the field for schema evolution purposes" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
json [Char]
"Value",
          [Char]
"order"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"specifies how this field impacts sort ordering of this record" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
avro [Char]
"Order",
          [Char]
"aliases"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON array of strings, providing alternate names for this field" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
list Type
string,
          [Char]
"annotations"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Any additional key/value pairs attached to the field" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map Type
string (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
json [Char]
"Value"],

      [Char] -> Type -> Element
def [Char]
"Fixed" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"size"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"an integer, specifying the number of bytes per value"
            Type
int32],

      [Char] -> Type -> Element
def [Char]
"Map" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"values"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Schema"],

      [Char] -> Type -> Element
def [Char]
"Named" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"name"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a string naming this schema"
            Type
string,
          [Char]
"namespace"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a string that qualifies the name" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string,
          [Char]
"aliases"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON array of strings, providing alternate names for this schema" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
list Type
string,
          [Char]
"doc"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON string providing documentation to the user of this schema" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
optional Type
string,
          [Char]
"type"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"NamedType",
          [Char]
"annotations"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"Any additional key/value pairs attached to the type" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type -> Type
Types.map Type
string (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
json [Char]
"Value"],

      [Char] -> Type -> Element
def [Char]
"NamedType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"enum"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Enum",
          [Char]
"fixed"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Fixed",
          [Char]
"record"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Record"],

      [Char] -> Type -> Element
def [Char]
"Order" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> Type
enum [[Char]
"ascending", [Char]
"descending", [Char]
"ignore"],

      [Char] -> Type -> Element
def [Char]
"Primitive" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"null"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"no value" Type
unit,
          [Char]
"boolean"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"A binary value" Type
unit,
          [Char]
"int"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"32-bit signed integer" Type
unit,
          [Char]
"long"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"64-bit signed integer" Type
unit,
          [Char]
"float"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"single precision (32-bit) IEEE 754 floating-point number" Type
unit,
          [Char]
"double"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"double precision (64-bit) IEEE 754 floating-point number" Type
unit,
          [Char]
"bytes"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"sequence of 8-bit unsigned bytes" Type
unit,
          [Char]
"string"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"unicode character sequence" Type
unit],

      [Char] -> Type -> Element
def [Char]
"Record" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          [Char]
"fields"[Char] -> Type -> FieldType
>:
            [Char] -> Type -> Type
doc [Char]
"a JSON array, listing fields" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
            Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
avro [Char]
"Field"],

      [Char] -> Type -> Element
def [Char]
"Schema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          [Char]
"array"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Array",
          [Char]
"map"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Map",
          [Char]
"named"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Named",
          [Char]
"primitive"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Primitive",
          [Char]
"reference"[Char] -> Type -> FieldType
>: -- Note: "reference" is not described in the Avro specification; this has been added
            [Char] -> Type -> Type
doc [Char]
"A reference by name to a previously defined type" Type
string,
          [Char]
"union"[Char] -> Type -> FieldType
>: [Char] -> Type
avro [Char]
"Union"
        ],

      [Char] -> Type -> Element
def [Char]
"Union" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Type
avro [Char]
"Schema"]