module Hydra.Sources.Tier4.Langs.Pegasus.Pdl where

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


pegasusPdlModule :: Module
pegasusPdlModule :: Module
pegasusPdlModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
jsonModelModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"A model for PDL (Pegasus Data Language) schemas. Based on the specification at:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"  https://linkedin.github.io/rest.li/pdl_schema")
  where
    ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/pegasus/pdl"
    def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
    pdl :: String -> Type
pdl = Namespace -> String -> Type
typeref Namespace
ns
    json :: String -> Type
json = Namespace -> String -> Type
typeref (Namespace -> String -> Type) -> Namespace -> String -> Type
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
jsonModelModule

    elements :: [Element]
elements = [

      String -> Type -> Element
def String
"Annotations" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        String -> Type -> Type
doc String
"Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas" (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"doc"String -> Type -> FieldType
>: Type -> Type
optional Type
string,
          String
"deprecated"String -> Type -> FieldType
>: Type
boolean],

      String -> Type -> Element
def String
"EnumField" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
pdl String
"EnumFieldName",
          String
"annotations"String -> Type -> FieldType
>: String -> Type
pdl String
"Annotations"],

      String -> Type -> Element
def String
"EnumFieldName"
        Type
string,

      String -> Type -> Element
def String
"EnumSchema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"fields"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"EnumField"],

      String -> Type -> Element
def String
"FieldName"
        Type
string,

      String -> Type -> Element
def String
"NamedSchema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"qualifiedName"String -> Type -> FieldType
>: String -> Type
pdl String
"QualifiedName",
          String
"type"String -> Type -> FieldType
>: String -> Type
pdl String
"NamedSchema.Type",
          String
"annotations"String -> Type -> FieldType
>: String -> Type
pdl String
"Annotations"],

      String -> Type -> Element
def String
"NamedSchema.Type" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"record"String -> Type -> FieldType
>: String -> Type
pdl String
"RecordSchema",
          String
"enum"String -> Type -> FieldType
>: String -> Type
pdl String
"EnumSchema",
          String
"typeref"String -> Type -> FieldType
>: String -> Type
pdl String
"Schema"],

      String -> Type -> Element
def String
"Name"
        Type
string,

      String -> Type -> Element
def String
"Namespace"
        Type
string,

      String -> Type -> Element
def String
"Package"
        Type
string,

      String -> Type -> Element
def String
"PrimitiveType" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [String] -> Type
enum [
          String
"boolean",
          String
"bytes",
          String
"double",
          String
"float",
          String
"int",
          String
"long",
          String
"string"],

      String -> Type -> Element
def String
"PropertyKey"
        Type
string,

      String -> Type -> Element
def String
"Property" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"key"String -> Type -> FieldType
>: String -> Type
pdl String
"PropertyKey",
          String
"value"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
json String
"Value"],

      String -> Type -> Element
def String
"QualifiedName" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
pdl String
"Name",
          String
"namespace"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"Namespace"],

      String -> Type -> Element
def String
"RecordField" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"name"String -> Type -> FieldType
>: String -> Type
pdl String
"FieldName",
          String
"value"String -> Type -> FieldType
>: String -> Type
pdl String
"Schema",
          String
"optional"String -> Type -> FieldType
>: Type
boolean,
          -- Note: the default value for an enum-valued must be one of the enumerated string symbols
          String
"default"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
json String
"Value",
          String
"annotations"String -> Type -> FieldType
>: String -> Type
pdl String
"Annotations"],

      String -> Type -> Element
def String
"RecordSchema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"fields"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"RecordField",
          -- Note: all included schemas must be record schemas
          String
"includes"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"NamedSchema"],

      String -> Type -> Element
def String
"Schema" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
union [
          String
"array"String -> Type -> FieldType
>: String -> Type
pdl String
"Schema",
          String
"fixed"String -> Type -> FieldType
>: Type
int32,
          String
"inline"String -> Type -> FieldType
>: String -> Type
pdl String
"NamedSchema",
          String
"map"String -> Type -> FieldType
>: String -> Type
pdl String
"Schema",
          String
"named"String -> Type -> FieldType
>: String -> Type
pdl String
"QualifiedName",
          String
"null"String -> Type -> FieldType
>: Type
unit,
          String
"primitive"String -> Type -> FieldType
>: String -> Type
pdl String
"PrimitiveType",
          String
"union"String -> Type -> FieldType
>: String -> Type
pdl String
"UnionSchema"],

      String -> Type -> Element
def String
"SchemaFile" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"namespace"String -> Type -> FieldType
>: String -> Type
pdl String
"Namespace",
          String
"package"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"Package",
          String
"imports"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"QualifiedName",
          String
"schemas"String -> Type -> FieldType
>: Type -> Type
list (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"NamedSchema"],

      String -> Type -> Element
def String
"UnionMember" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
        [FieldType] -> Type
record [
          String
"alias"String -> Type -> FieldType
>: Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
pdl String
"FieldName",
          String
"value"String -> Type -> FieldType
>: String -> Type
pdl String
"Schema",
          -- Note: annotations are only available for aliased members
          String
"annotations"String -> Type -> FieldType
>: String -> Type
pdl String
"Annotations"],

      -- Note: unions are not allowed as member types of other unions
      String -> Type -> Element
def String
"UnionSchema" (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
$ String -> Type
pdl String
"UnionMember"]