-- | A model for PDL (Pegasus Data Language) schemas. Based on the specification at:
-- |   https://linkedin.github.io/rest.li/pdl_schema

module Hydra.Ext.Pegasus.Pdl where

import qualified Hydra.Core as Core
import qualified Hydra.Ext.Json.Model as Model
import Data.List
import Data.Map
import Data.Set

-- | Annotations which can be applied to record fields, aliased union members, enum symbols, or named schemas
data Annotations = 
  Annotations {
    Annotations -> Maybe String
annotationsDoc :: (Maybe String),
    Annotations -> Bool
annotationsDeprecated :: Bool}
  deriving (Annotations -> Annotations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotations -> Annotations -> Bool
$c/= :: Annotations -> Annotations -> Bool
== :: Annotations -> Annotations -> Bool
$c== :: Annotations -> Annotations -> Bool
Eq, Eq Annotations
Annotations -> Annotations -> Bool
Annotations -> Annotations -> Ordering
Annotations -> Annotations -> Annotations
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 :: Annotations -> Annotations -> Annotations
$cmin :: Annotations -> Annotations -> Annotations
max :: Annotations -> Annotations -> Annotations
$cmax :: Annotations -> Annotations -> Annotations
>= :: Annotations -> Annotations -> Bool
$c>= :: Annotations -> Annotations -> Bool
> :: Annotations -> Annotations -> Bool
$c> :: Annotations -> Annotations -> Bool
<= :: Annotations -> Annotations -> Bool
$c<= :: Annotations -> Annotations -> Bool
< :: Annotations -> Annotations -> Bool
$c< :: Annotations -> Annotations -> Bool
compare :: Annotations -> Annotations -> Ordering
$ccompare :: Annotations -> Annotations -> Ordering
Ord, ReadPrec [Annotations]
ReadPrec Annotations
Int -> ReadS Annotations
ReadS [Annotations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Annotations]
$creadListPrec :: ReadPrec [Annotations]
readPrec :: ReadPrec Annotations
$creadPrec :: ReadPrec Annotations
readList :: ReadS [Annotations]
$creadList :: ReadS [Annotations]
readsPrec :: Int -> ReadS Annotations
$creadsPrec :: Int -> ReadS Annotations
Read, Int -> Annotations -> ShowS
[Annotations] -> ShowS
Annotations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotations] -> ShowS
$cshowList :: [Annotations] -> ShowS
show :: Annotations -> String
$cshow :: Annotations -> String
showsPrec :: Int -> Annotations -> ShowS
$cshowsPrec :: Int -> Annotations -> ShowS
Show)

_Annotations :: Name
_Annotations = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Annotations")

_Annotations_doc :: FieldName
_Annotations_doc = (String -> FieldName
Core.FieldName String
"doc")

_Annotations_deprecated :: FieldName
_Annotations_deprecated = (String -> FieldName
Core.FieldName String
"deprecated")

data EnumField = 
  EnumField {
    EnumField -> EnumFieldName
enumFieldName :: EnumFieldName,
    EnumField -> Annotations
enumFieldAnnotations :: Annotations}
  deriving (EnumField -> EnumField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumField -> EnumField -> Bool
$c/= :: EnumField -> EnumField -> Bool
== :: EnumField -> EnumField -> Bool
$c== :: EnumField -> EnumField -> Bool
Eq, Eq EnumField
EnumField -> EnumField -> Bool
EnumField -> EnumField -> Ordering
EnumField -> EnumField -> EnumField
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 :: EnumField -> EnumField -> EnumField
$cmin :: EnumField -> EnumField -> EnumField
max :: EnumField -> EnumField -> EnumField
$cmax :: EnumField -> EnumField -> EnumField
>= :: EnumField -> EnumField -> Bool
$c>= :: EnumField -> EnumField -> Bool
> :: EnumField -> EnumField -> Bool
$c> :: EnumField -> EnumField -> Bool
<= :: EnumField -> EnumField -> Bool
$c<= :: EnumField -> EnumField -> Bool
< :: EnumField -> EnumField -> Bool
$c< :: EnumField -> EnumField -> Bool
compare :: EnumField -> EnumField -> Ordering
$ccompare :: EnumField -> EnumField -> Ordering
Ord, ReadPrec [EnumField]
ReadPrec EnumField
Int -> ReadS EnumField
ReadS [EnumField]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnumField]
$creadListPrec :: ReadPrec [EnumField]
readPrec :: ReadPrec EnumField
$creadPrec :: ReadPrec EnumField
readList :: ReadS [EnumField]
$creadList :: ReadS [EnumField]
readsPrec :: Int -> ReadS EnumField
$creadsPrec :: Int -> ReadS EnumField
Read, Int -> EnumField -> ShowS
[EnumField] -> ShowS
EnumField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumField] -> ShowS
$cshowList :: [EnumField] -> ShowS
show :: EnumField -> String
$cshow :: EnumField -> String
showsPrec :: Int -> EnumField -> ShowS
$cshowsPrec :: Int -> EnumField -> ShowS
Show)

_EnumField :: Name
_EnumField = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.EnumField")

_EnumField_name :: FieldName
_EnumField_name = (String -> FieldName
Core.FieldName String
"name")

_EnumField_annotations :: FieldName
_EnumField_annotations = (String -> FieldName
Core.FieldName String
"annotations")

newtype EnumFieldName = 
  EnumFieldName {
    EnumFieldName -> String
unEnumFieldName :: String}
  deriving (EnumFieldName -> EnumFieldName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumFieldName -> EnumFieldName -> Bool
$c/= :: EnumFieldName -> EnumFieldName -> Bool
== :: EnumFieldName -> EnumFieldName -> Bool
$c== :: EnumFieldName -> EnumFieldName -> Bool
Eq, Eq EnumFieldName
EnumFieldName -> EnumFieldName -> Bool
EnumFieldName -> EnumFieldName -> Ordering
EnumFieldName -> EnumFieldName -> EnumFieldName
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 :: EnumFieldName -> EnumFieldName -> EnumFieldName
$cmin :: EnumFieldName -> EnumFieldName -> EnumFieldName
max :: EnumFieldName -> EnumFieldName -> EnumFieldName
$cmax :: EnumFieldName -> EnumFieldName -> EnumFieldName
>= :: EnumFieldName -> EnumFieldName -> Bool
$c>= :: EnumFieldName -> EnumFieldName -> Bool
> :: EnumFieldName -> EnumFieldName -> Bool
$c> :: EnumFieldName -> EnumFieldName -> Bool
<= :: EnumFieldName -> EnumFieldName -> Bool
$c<= :: EnumFieldName -> EnumFieldName -> Bool
< :: EnumFieldName -> EnumFieldName -> Bool
$c< :: EnumFieldName -> EnumFieldName -> Bool
compare :: EnumFieldName -> EnumFieldName -> Ordering
$ccompare :: EnumFieldName -> EnumFieldName -> Ordering
Ord, ReadPrec [EnumFieldName]
ReadPrec EnumFieldName
Int -> ReadS EnumFieldName
ReadS [EnumFieldName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnumFieldName]
$creadListPrec :: ReadPrec [EnumFieldName]
readPrec :: ReadPrec EnumFieldName
$creadPrec :: ReadPrec EnumFieldName
readList :: ReadS [EnumFieldName]
$creadList :: ReadS [EnumFieldName]
readsPrec :: Int -> ReadS EnumFieldName
$creadsPrec :: Int -> ReadS EnumFieldName
Read, Int -> EnumFieldName -> ShowS
[EnumFieldName] -> ShowS
EnumFieldName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumFieldName] -> ShowS
$cshowList :: [EnumFieldName] -> ShowS
show :: EnumFieldName -> String
$cshow :: EnumFieldName -> String
showsPrec :: Int -> EnumFieldName -> ShowS
$cshowsPrec :: Int -> EnumFieldName -> ShowS
Show)

_EnumFieldName :: Name
_EnumFieldName = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.EnumFieldName")

data EnumSchema = 
  EnumSchema {
    EnumSchema -> [EnumField]
enumSchemaFields :: [EnumField]}
  deriving (EnumSchema -> EnumSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumSchema -> EnumSchema -> Bool
$c/= :: EnumSchema -> EnumSchema -> Bool
== :: EnumSchema -> EnumSchema -> Bool
$c== :: EnumSchema -> EnumSchema -> Bool
Eq, Eq EnumSchema
EnumSchema -> EnumSchema -> Bool
EnumSchema -> EnumSchema -> Ordering
EnumSchema -> EnumSchema -> EnumSchema
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 :: EnumSchema -> EnumSchema -> EnumSchema
$cmin :: EnumSchema -> EnumSchema -> EnumSchema
max :: EnumSchema -> EnumSchema -> EnumSchema
$cmax :: EnumSchema -> EnumSchema -> EnumSchema
>= :: EnumSchema -> EnumSchema -> Bool
$c>= :: EnumSchema -> EnumSchema -> Bool
> :: EnumSchema -> EnumSchema -> Bool
$c> :: EnumSchema -> EnumSchema -> Bool
<= :: EnumSchema -> EnumSchema -> Bool
$c<= :: EnumSchema -> EnumSchema -> Bool
< :: EnumSchema -> EnumSchema -> Bool
$c< :: EnumSchema -> EnumSchema -> Bool
compare :: EnumSchema -> EnumSchema -> Ordering
$ccompare :: EnumSchema -> EnumSchema -> Ordering
Ord, ReadPrec [EnumSchema]
ReadPrec EnumSchema
Int -> ReadS EnumSchema
ReadS [EnumSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnumSchema]
$creadListPrec :: ReadPrec [EnumSchema]
readPrec :: ReadPrec EnumSchema
$creadPrec :: ReadPrec EnumSchema
readList :: ReadS [EnumSchema]
$creadList :: ReadS [EnumSchema]
readsPrec :: Int -> ReadS EnumSchema
$creadsPrec :: Int -> ReadS EnumSchema
Read, Int -> EnumSchema -> ShowS
[EnumSchema] -> ShowS
EnumSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumSchema] -> ShowS
$cshowList :: [EnumSchema] -> ShowS
show :: EnumSchema -> String
$cshow :: EnumSchema -> String
showsPrec :: Int -> EnumSchema -> ShowS
$cshowsPrec :: Int -> EnumSchema -> ShowS
Show)

_EnumSchema :: Name
_EnumSchema = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.EnumSchema")

_EnumSchema_fields :: FieldName
_EnumSchema_fields = (String -> FieldName
Core.FieldName String
"fields")

newtype FieldName = 
  FieldName {
    FieldName -> String
unFieldName :: String}
  deriving (FieldName -> FieldName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, Eq FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
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 :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmax :: FieldName -> FieldName -> FieldName
>= :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c< :: FieldName -> FieldName -> Bool
compare :: FieldName -> FieldName -> Ordering
$ccompare :: FieldName -> FieldName -> Ordering
Ord, ReadPrec [FieldName]
ReadPrec FieldName
Int -> ReadS FieldName
ReadS [FieldName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldName]
$creadListPrec :: ReadPrec [FieldName]
readPrec :: ReadPrec FieldName
$creadPrec :: ReadPrec FieldName
readList :: ReadS [FieldName]
$creadList :: ReadS [FieldName]
readsPrec :: Int -> ReadS FieldName
$creadsPrec :: Int -> ReadS FieldName
Read, Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show)

_FieldName :: Name
_FieldName = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.FieldName")

data NamedSchema = 
  NamedSchema {
    NamedSchema -> QualifiedName
namedSchemaQualifiedName :: QualifiedName,
    NamedSchema -> NamedSchema_Type
namedSchemaType :: NamedSchema_Type,
    NamedSchema -> Annotations
namedSchemaAnnotations :: Annotations}
  deriving (NamedSchema -> NamedSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NamedSchema -> NamedSchema -> Bool
$c/= :: NamedSchema -> NamedSchema -> Bool
== :: NamedSchema -> NamedSchema -> Bool
$c== :: NamedSchema -> NamedSchema -> Bool
Eq, Eq NamedSchema
NamedSchema -> NamedSchema -> Bool
NamedSchema -> NamedSchema -> Ordering
NamedSchema -> NamedSchema -> NamedSchema
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 :: NamedSchema -> NamedSchema -> NamedSchema
$cmin :: NamedSchema -> NamedSchema -> NamedSchema
max :: NamedSchema -> NamedSchema -> NamedSchema
$cmax :: NamedSchema -> NamedSchema -> NamedSchema
>= :: NamedSchema -> NamedSchema -> Bool
$c>= :: NamedSchema -> NamedSchema -> Bool
> :: NamedSchema -> NamedSchema -> Bool
$c> :: NamedSchema -> NamedSchema -> Bool
<= :: NamedSchema -> NamedSchema -> Bool
$c<= :: NamedSchema -> NamedSchema -> Bool
< :: NamedSchema -> NamedSchema -> Bool
$c< :: NamedSchema -> NamedSchema -> Bool
compare :: NamedSchema -> NamedSchema -> Ordering
$ccompare :: NamedSchema -> NamedSchema -> Ordering
Ord, ReadPrec [NamedSchema]
ReadPrec NamedSchema
Int -> ReadS NamedSchema
ReadS [NamedSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NamedSchema]
$creadListPrec :: ReadPrec [NamedSchema]
readPrec :: ReadPrec NamedSchema
$creadPrec :: ReadPrec NamedSchema
readList :: ReadS [NamedSchema]
$creadList :: ReadS [NamedSchema]
readsPrec :: Int -> ReadS NamedSchema
$creadsPrec :: Int -> ReadS NamedSchema
Read, Int -> NamedSchema -> ShowS
[NamedSchema] -> ShowS
NamedSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamedSchema] -> ShowS
$cshowList :: [NamedSchema] -> ShowS
show :: NamedSchema -> String
$cshow :: NamedSchema -> String
showsPrec :: Int -> NamedSchema -> ShowS
$cshowsPrec :: Int -> NamedSchema -> ShowS
Show)

_NamedSchema :: Name
_NamedSchema = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.NamedSchema")

_NamedSchema_qualifiedName :: FieldName
_NamedSchema_qualifiedName = (String -> FieldName
Core.FieldName String
"qualifiedName")

_NamedSchema_type :: FieldName
_NamedSchema_type = (String -> FieldName
Core.FieldName String
"type")

_NamedSchema_annotations :: FieldName
_NamedSchema_annotations = (String -> FieldName
Core.FieldName String
"annotations")

data NamedSchema_Type = 
  NamedSchema_TypeRecord RecordSchema |
  NamedSchema_TypeEnum EnumSchema |
  NamedSchema_TypeTyperef Schema
  deriving (NamedSchema_Type -> NamedSchema_Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c/= :: NamedSchema_Type -> NamedSchema_Type -> Bool
== :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c== :: NamedSchema_Type -> NamedSchema_Type -> Bool
Eq, Eq NamedSchema_Type
NamedSchema_Type -> NamedSchema_Type -> Bool
NamedSchema_Type -> NamedSchema_Type -> Ordering
NamedSchema_Type -> NamedSchema_Type -> NamedSchema_Type
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 :: NamedSchema_Type -> NamedSchema_Type -> NamedSchema_Type
$cmin :: NamedSchema_Type -> NamedSchema_Type -> NamedSchema_Type
max :: NamedSchema_Type -> NamedSchema_Type -> NamedSchema_Type
$cmax :: NamedSchema_Type -> NamedSchema_Type -> NamedSchema_Type
>= :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c>= :: NamedSchema_Type -> NamedSchema_Type -> Bool
> :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c> :: NamedSchema_Type -> NamedSchema_Type -> Bool
<= :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c<= :: NamedSchema_Type -> NamedSchema_Type -> Bool
< :: NamedSchema_Type -> NamedSchema_Type -> Bool
$c< :: NamedSchema_Type -> NamedSchema_Type -> Bool
compare :: NamedSchema_Type -> NamedSchema_Type -> Ordering
$ccompare :: NamedSchema_Type -> NamedSchema_Type -> Ordering
Ord, ReadPrec [NamedSchema_Type]
ReadPrec NamedSchema_Type
Int -> ReadS NamedSchema_Type
ReadS [NamedSchema_Type]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NamedSchema_Type]
$creadListPrec :: ReadPrec [NamedSchema_Type]
readPrec :: ReadPrec NamedSchema_Type
$creadPrec :: ReadPrec NamedSchema_Type
readList :: ReadS [NamedSchema_Type]
$creadList :: ReadS [NamedSchema_Type]
readsPrec :: Int -> ReadS NamedSchema_Type
$creadsPrec :: Int -> ReadS NamedSchema_Type
Read, Int -> NamedSchema_Type -> ShowS
[NamedSchema_Type] -> ShowS
NamedSchema_Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NamedSchema_Type] -> ShowS
$cshowList :: [NamedSchema_Type] -> ShowS
show :: NamedSchema_Type -> String
$cshow :: NamedSchema_Type -> String
showsPrec :: Int -> NamedSchema_Type -> ShowS
$cshowsPrec :: Int -> NamedSchema_Type -> ShowS
Show)

_NamedSchema_Type :: Name
_NamedSchema_Type = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.NamedSchema.Type")

_NamedSchema_Type_record :: FieldName
_NamedSchema_Type_record = (String -> FieldName
Core.FieldName String
"record")

_NamedSchema_Type_enum :: FieldName
_NamedSchema_Type_enum = (String -> FieldName
Core.FieldName String
"enum")

_NamedSchema_Type_typeref :: FieldName
_NamedSchema_Type_typeref = (String -> FieldName
Core.FieldName String
"typeref")

newtype Name = 
  Name {
    Name -> String
unName :: String}
  deriving (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, ReadPrec [Name]
ReadPrec Name
Int -> ReadS Name
ReadS [Name]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Name]
$creadListPrec :: ReadPrec [Name]
readPrec :: ReadPrec Name
$creadPrec :: ReadPrec Name
readList :: ReadS [Name]
$creadList :: ReadS [Name]
readsPrec :: Int -> ReadS Name
$creadsPrec :: Int -> ReadS Name
Read, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)

_Name :: Name
_Name = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Name")

newtype Namespace = 
  Namespace {
    Namespace -> String
unNamespace :: String}
  deriving (Namespace -> Namespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
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 :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, ReadPrec [Namespace]
ReadPrec Namespace
Int -> ReadS Namespace
ReadS [Namespace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Namespace]
$creadListPrec :: ReadPrec [Namespace]
readPrec :: ReadPrec Namespace
$creadPrec :: ReadPrec Namespace
readList :: ReadS [Namespace]
$creadList :: ReadS [Namespace]
readsPrec :: Int -> ReadS Namespace
$creadsPrec :: Int -> ReadS Namespace
Read, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show)

_Namespace :: Name
_Namespace = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Namespace")

newtype Package = 
  Package {
    Package -> String
unPackage :: String}
  deriving (Package -> Package -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, Eq Package
Package -> Package -> Bool
Package -> Package -> Ordering
Package -> Package -> Package
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 :: Package -> Package -> Package
$cmin :: Package -> Package -> Package
max :: Package -> Package -> Package
$cmax :: Package -> Package -> Package
>= :: Package -> Package -> Bool
$c>= :: Package -> Package -> Bool
> :: Package -> Package -> Bool
$c> :: Package -> Package -> Bool
<= :: Package -> Package -> Bool
$c<= :: Package -> Package -> Bool
< :: Package -> Package -> Bool
$c< :: Package -> Package -> Bool
compare :: Package -> Package -> Ordering
$ccompare :: Package -> Package -> Ordering
Ord, ReadPrec [Package]
ReadPrec Package
Int -> ReadS Package
ReadS [Package]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Package]
$creadListPrec :: ReadPrec [Package]
readPrec :: ReadPrec Package
$creadPrec :: ReadPrec Package
readList :: ReadS [Package]
$creadList :: ReadS [Package]
readsPrec :: Int -> ReadS Package
$creadsPrec :: Int -> ReadS Package
Read, Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> Package -> ShowS
Show)

_Package :: Name
_Package = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Package")

data PrimitiveType = 
  PrimitiveTypeBoolean  |
  PrimitiveTypeBytes  |
  PrimitiveTypeDouble  |
  PrimitiveTypeFloat  |
  PrimitiveTypeInt  |
  PrimitiveTypeLong  |
  PrimitiveTypeString 
  deriving (PrimitiveType -> PrimitiveType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveType -> PrimitiveType -> Bool
$c/= :: PrimitiveType -> PrimitiveType -> Bool
== :: PrimitiveType -> PrimitiveType -> Bool
$c== :: PrimitiveType -> PrimitiveType -> Bool
Eq, Eq PrimitiveType
PrimitiveType -> PrimitiveType -> Bool
PrimitiveType -> PrimitiveType -> Ordering
PrimitiveType -> PrimitiveType -> PrimitiveType
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 :: PrimitiveType -> PrimitiveType -> PrimitiveType
$cmin :: PrimitiveType -> PrimitiveType -> PrimitiveType
max :: PrimitiveType -> PrimitiveType -> PrimitiveType
$cmax :: PrimitiveType -> PrimitiveType -> PrimitiveType
>= :: PrimitiveType -> PrimitiveType -> Bool
$c>= :: PrimitiveType -> PrimitiveType -> Bool
> :: PrimitiveType -> PrimitiveType -> Bool
$c> :: PrimitiveType -> PrimitiveType -> Bool
<= :: PrimitiveType -> PrimitiveType -> Bool
$c<= :: PrimitiveType -> PrimitiveType -> Bool
< :: PrimitiveType -> PrimitiveType -> Bool
$c< :: PrimitiveType -> PrimitiveType -> Bool
compare :: PrimitiveType -> PrimitiveType -> Ordering
$ccompare :: PrimitiveType -> PrimitiveType -> Ordering
Ord, ReadPrec [PrimitiveType]
ReadPrec PrimitiveType
Int -> ReadS PrimitiveType
ReadS [PrimitiveType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrimitiveType]
$creadListPrec :: ReadPrec [PrimitiveType]
readPrec :: ReadPrec PrimitiveType
$creadPrec :: ReadPrec PrimitiveType
readList :: ReadS [PrimitiveType]
$creadList :: ReadS [PrimitiveType]
readsPrec :: Int -> ReadS PrimitiveType
$creadsPrec :: Int -> ReadS PrimitiveType
Read, Int -> PrimitiveType -> ShowS
[PrimitiveType] -> ShowS
PrimitiveType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimitiveType] -> ShowS
$cshowList :: [PrimitiveType] -> ShowS
show :: PrimitiveType -> String
$cshow :: PrimitiveType -> String
showsPrec :: Int -> PrimitiveType -> ShowS
$cshowsPrec :: Int -> PrimitiveType -> ShowS
Show)

_PrimitiveType :: Name
_PrimitiveType = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.PrimitiveType")

_PrimitiveType_boolean :: FieldName
_PrimitiveType_boolean = (String -> FieldName
Core.FieldName String
"boolean")

_PrimitiveType_bytes :: FieldName
_PrimitiveType_bytes = (String -> FieldName
Core.FieldName String
"bytes")

_PrimitiveType_double :: FieldName
_PrimitiveType_double = (String -> FieldName
Core.FieldName String
"double")

_PrimitiveType_float :: FieldName
_PrimitiveType_float = (String -> FieldName
Core.FieldName String
"float")

_PrimitiveType_int :: FieldName
_PrimitiveType_int = (String -> FieldName
Core.FieldName String
"int")

_PrimitiveType_long :: FieldName
_PrimitiveType_long = (String -> FieldName
Core.FieldName String
"long")

_PrimitiveType_string :: FieldName
_PrimitiveType_string = (String -> FieldName
Core.FieldName String
"string")

newtype PropertyKey = 
  PropertyKey {
    PropertyKey -> String
unPropertyKey :: String}
  deriving (PropertyKey -> PropertyKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyKey -> PropertyKey -> Bool
$c/= :: PropertyKey -> PropertyKey -> Bool
== :: PropertyKey -> PropertyKey -> Bool
$c== :: PropertyKey -> PropertyKey -> Bool
Eq, Eq PropertyKey
PropertyKey -> PropertyKey -> Bool
PropertyKey -> PropertyKey -> Ordering
PropertyKey -> PropertyKey -> PropertyKey
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 :: PropertyKey -> PropertyKey -> PropertyKey
$cmin :: PropertyKey -> PropertyKey -> PropertyKey
max :: PropertyKey -> PropertyKey -> PropertyKey
$cmax :: PropertyKey -> PropertyKey -> PropertyKey
>= :: PropertyKey -> PropertyKey -> Bool
$c>= :: PropertyKey -> PropertyKey -> Bool
> :: PropertyKey -> PropertyKey -> Bool
$c> :: PropertyKey -> PropertyKey -> Bool
<= :: PropertyKey -> PropertyKey -> Bool
$c<= :: PropertyKey -> PropertyKey -> Bool
< :: PropertyKey -> PropertyKey -> Bool
$c< :: PropertyKey -> PropertyKey -> Bool
compare :: PropertyKey -> PropertyKey -> Ordering
$ccompare :: PropertyKey -> PropertyKey -> Ordering
Ord, ReadPrec [PropertyKey]
ReadPrec PropertyKey
Int -> ReadS PropertyKey
ReadS [PropertyKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PropertyKey]
$creadListPrec :: ReadPrec [PropertyKey]
readPrec :: ReadPrec PropertyKey
$creadPrec :: ReadPrec PropertyKey
readList :: ReadS [PropertyKey]
$creadList :: ReadS [PropertyKey]
readsPrec :: Int -> ReadS PropertyKey
$creadsPrec :: Int -> ReadS PropertyKey
Read, Int -> PropertyKey -> ShowS
[PropertyKey] -> ShowS
PropertyKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyKey] -> ShowS
$cshowList :: [PropertyKey] -> ShowS
show :: PropertyKey -> String
$cshow :: PropertyKey -> String
showsPrec :: Int -> PropertyKey -> ShowS
$cshowsPrec :: Int -> PropertyKey -> ShowS
Show)

_PropertyKey :: Name
_PropertyKey = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.PropertyKey")

data Property = 
  Property {
    Property -> PropertyKey
propertyKey :: PropertyKey,
    Property -> Maybe Value
propertyValue :: (Maybe Model.Value)}
  deriving (Property -> Property -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq, Eq Property
Property -> Property -> Bool
Property -> Property -> Ordering
Property -> Property -> Property
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 :: Property -> Property -> Property
$cmin :: Property -> Property -> Property
max :: Property -> Property -> Property
$cmax :: Property -> Property -> Property
>= :: Property -> Property -> Bool
$c>= :: Property -> Property -> Bool
> :: Property -> Property -> Bool
$c> :: Property -> Property -> Bool
<= :: Property -> Property -> Bool
$c<= :: Property -> Property -> Bool
< :: Property -> Property -> Bool
$c< :: Property -> Property -> Bool
compare :: Property -> Property -> Ordering
$ccompare :: Property -> Property -> Ordering
Ord, ReadPrec [Property]
ReadPrec Property
Int -> ReadS Property
ReadS [Property]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Property]
$creadListPrec :: ReadPrec [Property]
readPrec :: ReadPrec Property
$creadPrec :: ReadPrec Property
readList :: ReadS [Property]
$creadList :: ReadS [Property]
readsPrec :: Int -> ReadS Property
$creadsPrec :: Int -> ReadS Property
Read, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)

_Property :: Name
_Property = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Property")

_Property_key :: FieldName
_Property_key = (String -> FieldName
Core.FieldName String
"key")

_Property_value :: FieldName
_Property_value = (String -> FieldName
Core.FieldName String
"value")

data QualifiedName = 
  QualifiedName {
    QualifiedName -> Name
qualifiedNameName :: Name,
    QualifiedName -> Maybe Namespace
qualifiedNameNamespace :: (Maybe Namespace)}
  deriving (QualifiedName -> QualifiedName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedName -> QualifiedName -> Bool
$c/= :: QualifiedName -> QualifiedName -> Bool
== :: QualifiedName -> QualifiedName -> Bool
$c== :: QualifiedName -> QualifiedName -> Bool
Eq, Eq QualifiedName
QualifiedName -> QualifiedName -> Bool
QualifiedName -> QualifiedName -> Ordering
QualifiedName -> QualifiedName -> QualifiedName
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 :: QualifiedName -> QualifiedName -> QualifiedName
$cmin :: QualifiedName -> QualifiedName -> QualifiedName
max :: QualifiedName -> QualifiedName -> QualifiedName
$cmax :: QualifiedName -> QualifiedName -> QualifiedName
>= :: QualifiedName -> QualifiedName -> Bool
$c>= :: QualifiedName -> QualifiedName -> Bool
> :: QualifiedName -> QualifiedName -> Bool
$c> :: QualifiedName -> QualifiedName -> Bool
<= :: QualifiedName -> QualifiedName -> Bool
$c<= :: QualifiedName -> QualifiedName -> Bool
< :: QualifiedName -> QualifiedName -> Bool
$c< :: QualifiedName -> QualifiedName -> Bool
compare :: QualifiedName -> QualifiedName -> Ordering
$ccompare :: QualifiedName -> QualifiedName -> Ordering
Ord, ReadPrec [QualifiedName]
ReadPrec QualifiedName
Int -> ReadS QualifiedName
ReadS [QualifiedName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QualifiedName]
$creadListPrec :: ReadPrec [QualifiedName]
readPrec :: ReadPrec QualifiedName
$creadPrec :: ReadPrec QualifiedName
readList :: ReadS [QualifiedName]
$creadList :: ReadS [QualifiedName]
readsPrec :: Int -> ReadS QualifiedName
$creadsPrec :: Int -> ReadS QualifiedName
Read, Int -> QualifiedName -> ShowS
[QualifiedName] -> ShowS
QualifiedName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedName] -> ShowS
$cshowList :: [QualifiedName] -> ShowS
show :: QualifiedName -> String
$cshow :: QualifiedName -> String
showsPrec :: Int -> QualifiedName -> ShowS
$cshowsPrec :: Int -> QualifiedName -> ShowS
Show)

_QualifiedName :: Name
_QualifiedName = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.QualifiedName")

_QualifiedName_name :: FieldName
_QualifiedName_name = (String -> FieldName
Core.FieldName String
"name")

_QualifiedName_namespace :: FieldName
_QualifiedName_namespace = (String -> FieldName
Core.FieldName String
"namespace")

data RecordField = 
  RecordField {
    RecordField -> FieldName
recordFieldName :: FieldName,
    RecordField -> Schema
recordFieldValue :: Schema,
    RecordField -> Bool
recordFieldOptional :: Bool,
    RecordField -> Maybe Value
recordFieldDefault :: (Maybe Model.Value),
    RecordField -> Annotations
recordFieldAnnotations :: Annotations}
  deriving (RecordField -> RecordField -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordField -> RecordField -> Bool
$c/= :: RecordField -> RecordField -> Bool
== :: RecordField -> RecordField -> Bool
$c== :: RecordField -> RecordField -> Bool
Eq, Eq RecordField
RecordField -> RecordField -> Bool
RecordField -> RecordField -> Ordering
RecordField -> RecordField -> RecordField
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 :: RecordField -> RecordField -> RecordField
$cmin :: RecordField -> RecordField -> RecordField
max :: RecordField -> RecordField -> RecordField
$cmax :: RecordField -> RecordField -> RecordField
>= :: RecordField -> RecordField -> Bool
$c>= :: RecordField -> RecordField -> Bool
> :: RecordField -> RecordField -> Bool
$c> :: RecordField -> RecordField -> Bool
<= :: RecordField -> RecordField -> Bool
$c<= :: RecordField -> RecordField -> Bool
< :: RecordField -> RecordField -> Bool
$c< :: RecordField -> RecordField -> Bool
compare :: RecordField -> RecordField -> Ordering
$ccompare :: RecordField -> RecordField -> Ordering
Ord, ReadPrec [RecordField]
ReadPrec RecordField
Int -> ReadS RecordField
ReadS [RecordField]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecordField]
$creadListPrec :: ReadPrec [RecordField]
readPrec :: ReadPrec RecordField
$creadPrec :: ReadPrec RecordField
readList :: ReadS [RecordField]
$creadList :: ReadS [RecordField]
readsPrec :: Int -> ReadS RecordField
$creadsPrec :: Int -> ReadS RecordField
Read, Int -> RecordField -> ShowS
[RecordField] -> ShowS
RecordField -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordField] -> ShowS
$cshowList :: [RecordField] -> ShowS
show :: RecordField -> String
$cshow :: RecordField -> String
showsPrec :: Int -> RecordField -> ShowS
$cshowsPrec :: Int -> RecordField -> ShowS
Show)

_RecordField :: Name
_RecordField = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.RecordField")

_RecordField_name :: FieldName
_RecordField_name = (String -> FieldName
Core.FieldName String
"name")

_RecordField_value :: FieldName
_RecordField_value = (String -> FieldName
Core.FieldName String
"value")

_RecordField_optional :: FieldName
_RecordField_optional = (String -> FieldName
Core.FieldName String
"optional")

_RecordField_default :: FieldName
_RecordField_default = (String -> FieldName
Core.FieldName String
"default")

_RecordField_annotations :: FieldName
_RecordField_annotations = (String -> FieldName
Core.FieldName String
"annotations")

data RecordSchema = 
  RecordSchema {
    RecordSchema -> [RecordField]
recordSchemaFields :: [RecordField],
    RecordSchema -> [NamedSchema]
recordSchemaIncludes :: [NamedSchema]}
  deriving (RecordSchema -> RecordSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordSchema -> RecordSchema -> Bool
$c/= :: RecordSchema -> RecordSchema -> Bool
== :: RecordSchema -> RecordSchema -> Bool
$c== :: RecordSchema -> RecordSchema -> Bool
Eq, Eq RecordSchema
RecordSchema -> RecordSchema -> Bool
RecordSchema -> RecordSchema -> Ordering
RecordSchema -> RecordSchema -> RecordSchema
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 :: RecordSchema -> RecordSchema -> RecordSchema
$cmin :: RecordSchema -> RecordSchema -> RecordSchema
max :: RecordSchema -> RecordSchema -> RecordSchema
$cmax :: RecordSchema -> RecordSchema -> RecordSchema
>= :: RecordSchema -> RecordSchema -> Bool
$c>= :: RecordSchema -> RecordSchema -> Bool
> :: RecordSchema -> RecordSchema -> Bool
$c> :: RecordSchema -> RecordSchema -> Bool
<= :: RecordSchema -> RecordSchema -> Bool
$c<= :: RecordSchema -> RecordSchema -> Bool
< :: RecordSchema -> RecordSchema -> Bool
$c< :: RecordSchema -> RecordSchema -> Bool
compare :: RecordSchema -> RecordSchema -> Ordering
$ccompare :: RecordSchema -> RecordSchema -> Ordering
Ord, ReadPrec [RecordSchema]
ReadPrec RecordSchema
Int -> ReadS RecordSchema
ReadS [RecordSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecordSchema]
$creadListPrec :: ReadPrec [RecordSchema]
readPrec :: ReadPrec RecordSchema
$creadPrec :: ReadPrec RecordSchema
readList :: ReadS [RecordSchema]
$creadList :: ReadS [RecordSchema]
readsPrec :: Int -> ReadS RecordSchema
$creadsPrec :: Int -> ReadS RecordSchema
Read, Int -> RecordSchema -> ShowS
[RecordSchema] -> ShowS
RecordSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordSchema] -> ShowS
$cshowList :: [RecordSchema] -> ShowS
show :: RecordSchema -> String
$cshow :: RecordSchema -> String
showsPrec :: Int -> RecordSchema -> ShowS
$cshowsPrec :: Int -> RecordSchema -> ShowS
Show)

_RecordSchema :: Name
_RecordSchema = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.RecordSchema")

_RecordSchema_fields :: FieldName
_RecordSchema_fields = (String -> FieldName
Core.FieldName String
"fields")

_RecordSchema_includes :: FieldName
_RecordSchema_includes = (String -> FieldName
Core.FieldName String
"includes")

data Schema = 
  SchemaArray Schema |
  SchemaFixed Int |
  SchemaInline NamedSchema |
  SchemaMap Schema |
  SchemaNamed QualifiedName |
  SchemaNull  |
  SchemaPrimitive PrimitiveType |
  SchemaUnion UnionSchema
  deriving (Schema -> Schema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c== :: Schema -> Schema -> Bool
Eq, Eq Schema
Schema -> Schema -> Bool
Schema -> Schema -> Ordering
Schema -> Schema -> Schema
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 :: Schema -> Schema -> Schema
$cmin :: Schema -> Schema -> Schema
max :: Schema -> Schema -> Schema
$cmax :: Schema -> Schema -> Schema
>= :: Schema -> Schema -> Bool
$c>= :: Schema -> Schema -> Bool
> :: Schema -> Schema -> Bool
$c> :: Schema -> Schema -> Bool
<= :: Schema -> Schema -> Bool
$c<= :: Schema -> Schema -> Bool
< :: Schema -> Schema -> Bool
$c< :: Schema -> Schema -> Bool
compare :: Schema -> Schema -> Ordering
$ccompare :: Schema -> Schema -> Ordering
Ord, ReadPrec [Schema]
ReadPrec Schema
Int -> ReadS Schema
ReadS [Schema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Schema]
$creadListPrec :: ReadPrec [Schema]
readPrec :: ReadPrec Schema
$creadPrec :: ReadPrec Schema
readList :: ReadS [Schema]
$creadList :: ReadS [Schema]
readsPrec :: Int -> ReadS Schema
$creadsPrec :: Int -> ReadS Schema
Read, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show)

_Schema :: Name
_Schema = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.Schema")

_Schema_array :: FieldName
_Schema_array = (String -> FieldName
Core.FieldName String
"array")

_Schema_fixed :: FieldName
_Schema_fixed = (String -> FieldName
Core.FieldName String
"fixed")

_Schema_inline :: FieldName
_Schema_inline = (String -> FieldName
Core.FieldName String
"inline")

_Schema_map :: FieldName
_Schema_map = (String -> FieldName
Core.FieldName String
"map")

_Schema_named :: FieldName
_Schema_named = (String -> FieldName
Core.FieldName String
"named")

_Schema_null :: FieldName
_Schema_null = (String -> FieldName
Core.FieldName String
"null")

_Schema_primitive :: FieldName
_Schema_primitive = (String -> FieldName
Core.FieldName String
"primitive")

_Schema_union :: FieldName
_Schema_union = (String -> FieldName
Core.FieldName String
"union")

data SchemaFile = 
  SchemaFile {
    SchemaFile -> Namespace
schemaFileNamespace :: Namespace,
    SchemaFile -> Maybe Package
schemaFilePackage :: (Maybe Package),
    SchemaFile -> [QualifiedName]
schemaFileImports :: [QualifiedName],
    SchemaFile -> [NamedSchema]
schemaFileSchemas :: [NamedSchema]}
  deriving (SchemaFile -> SchemaFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaFile -> SchemaFile -> Bool
$c/= :: SchemaFile -> SchemaFile -> Bool
== :: SchemaFile -> SchemaFile -> Bool
$c== :: SchemaFile -> SchemaFile -> Bool
Eq, Eq SchemaFile
SchemaFile -> SchemaFile -> Bool
SchemaFile -> SchemaFile -> Ordering
SchemaFile -> SchemaFile -> SchemaFile
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 :: SchemaFile -> SchemaFile -> SchemaFile
$cmin :: SchemaFile -> SchemaFile -> SchemaFile
max :: SchemaFile -> SchemaFile -> SchemaFile
$cmax :: SchemaFile -> SchemaFile -> SchemaFile
>= :: SchemaFile -> SchemaFile -> Bool
$c>= :: SchemaFile -> SchemaFile -> Bool
> :: SchemaFile -> SchemaFile -> Bool
$c> :: SchemaFile -> SchemaFile -> Bool
<= :: SchemaFile -> SchemaFile -> Bool
$c<= :: SchemaFile -> SchemaFile -> Bool
< :: SchemaFile -> SchemaFile -> Bool
$c< :: SchemaFile -> SchemaFile -> Bool
compare :: SchemaFile -> SchemaFile -> Ordering
$ccompare :: SchemaFile -> SchemaFile -> Ordering
Ord, ReadPrec [SchemaFile]
ReadPrec SchemaFile
Int -> ReadS SchemaFile
ReadS [SchemaFile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SchemaFile]
$creadListPrec :: ReadPrec [SchemaFile]
readPrec :: ReadPrec SchemaFile
$creadPrec :: ReadPrec SchemaFile
readList :: ReadS [SchemaFile]
$creadList :: ReadS [SchemaFile]
readsPrec :: Int -> ReadS SchemaFile
$creadsPrec :: Int -> ReadS SchemaFile
Read, Int -> SchemaFile -> ShowS
[SchemaFile] -> ShowS
SchemaFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SchemaFile] -> ShowS
$cshowList :: [SchemaFile] -> ShowS
show :: SchemaFile -> String
$cshow :: SchemaFile -> String
showsPrec :: Int -> SchemaFile -> ShowS
$cshowsPrec :: Int -> SchemaFile -> ShowS
Show)

_SchemaFile :: Name
_SchemaFile = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.SchemaFile")

_SchemaFile_namespace :: FieldName
_SchemaFile_namespace = (String -> FieldName
Core.FieldName String
"namespace")

_SchemaFile_package :: FieldName
_SchemaFile_package = (String -> FieldName
Core.FieldName String
"package")

_SchemaFile_imports :: FieldName
_SchemaFile_imports = (String -> FieldName
Core.FieldName String
"imports")

_SchemaFile_schemas :: FieldName
_SchemaFile_schemas = (String -> FieldName
Core.FieldName String
"schemas")

data UnionMember = 
  UnionMember {
    UnionMember -> Maybe FieldName
unionMemberAlias :: (Maybe FieldName),
    UnionMember -> Schema
unionMemberValue :: Schema,
    UnionMember -> Annotations
unionMemberAnnotations :: Annotations}
  deriving (UnionMember -> UnionMember -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionMember -> UnionMember -> Bool
$c/= :: UnionMember -> UnionMember -> Bool
== :: UnionMember -> UnionMember -> Bool
$c== :: UnionMember -> UnionMember -> Bool
Eq, Eq UnionMember
UnionMember -> UnionMember -> Bool
UnionMember -> UnionMember -> Ordering
UnionMember -> UnionMember -> UnionMember
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 :: UnionMember -> UnionMember -> UnionMember
$cmin :: UnionMember -> UnionMember -> UnionMember
max :: UnionMember -> UnionMember -> UnionMember
$cmax :: UnionMember -> UnionMember -> UnionMember
>= :: UnionMember -> UnionMember -> Bool
$c>= :: UnionMember -> UnionMember -> Bool
> :: UnionMember -> UnionMember -> Bool
$c> :: UnionMember -> UnionMember -> Bool
<= :: UnionMember -> UnionMember -> Bool
$c<= :: UnionMember -> UnionMember -> Bool
< :: UnionMember -> UnionMember -> Bool
$c< :: UnionMember -> UnionMember -> Bool
compare :: UnionMember -> UnionMember -> Ordering
$ccompare :: UnionMember -> UnionMember -> Ordering
Ord, ReadPrec [UnionMember]
ReadPrec UnionMember
Int -> ReadS UnionMember
ReadS [UnionMember]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnionMember]
$creadListPrec :: ReadPrec [UnionMember]
readPrec :: ReadPrec UnionMember
$creadPrec :: ReadPrec UnionMember
readList :: ReadS [UnionMember]
$creadList :: ReadS [UnionMember]
readsPrec :: Int -> ReadS UnionMember
$creadsPrec :: Int -> ReadS UnionMember
Read, Int -> UnionMember -> ShowS
[UnionMember] -> ShowS
UnionMember -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnionMember] -> ShowS
$cshowList :: [UnionMember] -> ShowS
show :: UnionMember -> String
$cshow :: UnionMember -> String
showsPrec :: Int -> UnionMember -> ShowS
$cshowsPrec :: Int -> UnionMember -> ShowS
Show)

_UnionMember :: Name
_UnionMember = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.UnionMember")

_UnionMember_alias :: FieldName
_UnionMember_alias = (String -> FieldName
Core.FieldName String
"alias")

_UnionMember_value :: FieldName
_UnionMember_value = (String -> FieldName
Core.FieldName String
"value")

_UnionMember_annotations :: FieldName
_UnionMember_annotations = (String -> FieldName
Core.FieldName String
"annotations")

newtype UnionSchema = 
  UnionSchema {
    UnionSchema -> [UnionMember]
unUnionSchema :: [UnionMember]}
  deriving (UnionSchema -> UnionSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionSchema -> UnionSchema -> Bool
$c/= :: UnionSchema -> UnionSchema -> Bool
== :: UnionSchema -> UnionSchema -> Bool
$c== :: UnionSchema -> UnionSchema -> Bool
Eq, Eq UnionSchema
UnionSchema -> UnionSchema -> Bool
UnionSchema -> UnionSchema -> Ordering
UnionSchema -> UnionSchema -> UnionSchema
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 :: UnionSchema -> UnionSchema -> UnionSchema
$cmin :: UnionSchema -> UnionSchema -> UnionSchema
max :: UnionSchema -> UnionSchema -> UnionSchema
$cmax :: UnionSchema -> UnionSchema -> UnionSchema
>= :: UnionSchema -> UnionSchema -> Bool
$c>= :: UnionSchema -> UnionSchema -> Bool
> :: UnionSchema -> UnionSchema -> Bool
$c> :: UnionSchema -> UnionSchema -> Bool
<= :: UnionSchema -> UnionSchema -> Bool
$c<= :: UnionSchema -> UnionSchema -> Bool
< :: UnionSchema -> UnionSchema -> Bool
$c< :: UnionSchema -> UnionSchema -> Bool
compare :: UnionSchema -> UnionSchema -> Ordering
$ccompare :: UnionSchema -> UnionSchema -> Ordering
Ord, ReadPrec [UnionSchema]
ReadPrec UnionSchema
Int -> ReadS UnionSchema
ReadS [UnionSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnionSchema]
$creadListPrec :: ReadPrec [UnionSchema]
readPrec :: ReadPrec UnionSchema
$creadPrec :: ReadPrec UnionSchema
readList :: ReadS [UnionSchema]
$creadList :: ReadS [UnionSchema]
readsPrec :: Int -> ReadS UnionSchema
$creadsPrec :: Int -> ReadS UnionSchema
Read, Int -> UnionSchema -> ShowS
[UnionSchema] -> ShowS
UnionSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnionSchema] -> ShowS
$cshowList :: [UnionSchema] -> ShowS
show :: UnionSchema -> String
$cshow :: UnionSchema -> String
showsPrec :: Int -> UnionSchema -> ShowS
$cshowsPrec :: Int -> UnionSchema -> ShowS
Show)

_UnionSchema :: Name
_UnionSchema = (String -> Name
Core.Name String
"hydra/ext/pegasus/pdl.UnionSchema")