module Miso.GraphQL.AST where

import Data.List.NonEmpty (NonEmpty)
import Data.String (IsString)
import GHC.Generics (Generic)
import Miso.Prelude
import Miso.String (FromMisoString, ToMisoString)

-- | https://spec.graphql.org/draft/#ExecutableDirectiveLocation
data ExecutableDirectiveLocation
    = QUERY
    | MUTATION
    | SUBSCRIPTION
    | FIELD
    | FRAGMENT_DEFINITION
    | FRAGMENT_SPREAD
    | INLINE_FRAGMENT
    | VARIABLE_DEFINITION
    deriving stock (Int -> ExecutableDirectiveLocation -> ShowS
[ExecutableDirectiveLocation] -> ShowS
ExecutableDirectiveLocation -> String
(Int -> ExecutableDirectiveLocation -> ShowS)
-> (ExecutableDirectiveLocation -> String)
-> ([ExecutableDirectiveLocation] -> ShowS)
-> Show ExecutableDirectiveLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutableDirectiveLocation -> ShowS
showsPrec :: Int -> ExecutableDirectiveLocation -> ShowS
$cshow :: ExecutableDirectiveLocation -> String
show :: ExecutableDirectiveLocation -> String
$cshowList :: [ExecutableDirectiveLocation] -> ShowS
showList :: [ExecutableDirectiveLocation] -> ShowS
Show, ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
(ExecutableDirectiveLocation
 -> ExecutableDirectiveLocation -> Bool)
-> (ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation -> Bool)
-> Eq ExecutableDirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
== :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
$c/= :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
/= :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
Eq, (forall x.
 ExecutableDirectiveLocation -> Rep ExecutableDirectiveLocation x)
-> (forall x.
    Rep ExecutableDirectiveLocation x -> ExecutableDirectiveLocation)
-> Generic ExecutableDirectiveLocation
forall x.
Rep ExecutableDirectiveLocation x -> ExecutableDirectiveLocation
forall x.
ExecutableDirectiveLocation -> Rep ExecutableDirectiveLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ExecutableDirectiveLocation -> Rep ExecutableDirectiveLocation x
from :: forall x.
ExecutableDirectiveLocation -> Rep ExecutableDirectiveLocation x
$cto :: forall x.
Rep ExecutableDirectiveLocation x -> ExecutableDirectiveLocation
to :: forall x.
Rep ExecutableDirectiveLocation x -> ExecutableDirectiveLocation
Generic, ExecutableDirectiveLocation
ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> Bounded ExecutableDirectiveLocation
forall a. a -> a -> Bounded a
$cminBound :: ExecutableDirectiveLocation
minBound :: ExecutableDirectiveLocation
$cmaxBound :: ExecutableDirectiveLocation
maxBound :: ExecutableDirectiveLocation
Bounded, Int -> ExecutableDirectiveLocation
ExecutableDirectiveLocation -> Int
ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
ExecutableDirectiveLocation -> ExecutableDirectiveLocation
ExecutableDirectiveLocation
-> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> [ExecutableDirectiveLocation]
(ExecutableDirectiveLocation -> ExecutableDirectiveLocation)
-> (ExecutableDirectiveLocation -> ExecutableDirectiveLocation)
-> (Int -> ExecutableDirectiveLocation)
-> (ExecutableDirectiveLocation -> Int)
-> (ExecutableDirectiveLocation -> [ExecutableDirectiveLocation])
-> (ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation])
-> (ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation])
-> (ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation
    -> [ExecutableDirectiveLocation])
-> Enum ExecutableDirectiveLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation
succ :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation
$cpred :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation
pred :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation
$ctoEnum :: Int -> ExecutableDirectiveLocation
toEnum :: Int -> ExecutableDirectiveLocation
$cfromEnum :: ExecutableDirectiveLocation -> Int
fromEnum :: ExecutableDirectiveLocation -> Int
$cenumFrom :: ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
enumFrom :: ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
$cenumFromThen :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
enumFromThen :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
$cenumFromTo :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
enumFromTo :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation -> [ExecutableDirectiveLocation]
$cenumFromThenTo :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> [ExecutableDirectiveLocation]
enumFromThenTo :: ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> ExecutableDirectiveLocation
-> [ExecutableDirectiveLocation]
Enum)

-- | https://spec.graphql.org/draft/#TypeSystemDirectiveLocation
data TypeSystemDirectiveLocation
    = SCHEMA
    | SCALAR
    | OBJECT
    | FIELD_DEFINITION
    | ARGUMENT_DEFINITION
    | INTERFACE
    | UNION
    | ENUM
    | ENUM_VALUE
    | INPUT_OBJECT
    | INPUT_FIELD_DEFINITION
    deriving stock (Int -> TypeSystemDirectiveLocation -> ShowS
[TypeSystemDirectiveLocation] -> ShowS
TypeSystemDirectiveLocation -> String
(Int -> TypeSystemDirectiveLocation -> ShowS)
-> (TypeSystemDirectiveLocation -> String)
-> ([TypeSystemDirectiveLocation] -> ShowS)
-> Show TypeSystemDirectiveLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeSystemDirectiveLocation -> ShowS
showsPrec :: Int -> TypeSystemDirectiveLocation -> ShowS
$cshow :: TypeSystemDirectiveLocation -> String
show :: TypeSystemDirectiveLocation -> String
$cshowList :: [TypeSystemDirectiveLocation] -> ShowS
showList :: [TypeSystemDirectiveLocation] -> ShowS
Show, TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
(TypeSystemDirectiveLocation
 -> TypeSystemDirectiveLocation -> Bool)
-> (TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation -> Bool)
-> Eq TypeSystemDirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
== :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
$c/= :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
/= :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
Eq, (forall x.
 TypeSystemDirectiveLocation -> Rep TypeSystemDirectiveLocation x)
-> (forall x.
    Rep TypeSystemDirectiveLocation x -> TypeSystemDirectiveLocation)
-> Generic TypeSystemDirectiveLocation
forall x.
Rep TypeSystemDirectiveLocation x -> TypeSystemDirectiveLocation
forall x.
TypeSystemDirectiveLocation -> Rep TypeSystemDirectiveLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TypeSystemDirectiveLocation -> Rep TypeSystemDirectiveLocation x
from :: forall x.
TypeSystemDirectiveLocation -> Rep TypeSystemDirectiveLocation x
$cto :: forall x.
Rep TypeSystemDirectiveLocation x -> TypeSystemDirectiveLocation
to :: forall x.
Rep TypeSystemDirectiveLocation x -> TypeSystemDirectiveLocation
Generic, TypeSystemDirectiveLocation
TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> Bounded TypeSystemDirectiveLocation
forall a. a -> a -> Bounded a
$cminBound :: TypeSystemDirectiveLocation
minBound :: TypeSystemDirectiveLocation
$cmaxBound :: TypeSystemDirectiveLocation
maxBound :: TypeSystemDirectiveLocation
Bounded, Int -> TypeSystemDirectiveLocation
TypeSystemDirectiveLocation -> Int
TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation
TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> [TypeSystemDirectiveLocation]
(TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation)
-> (TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation)
-> (Int -> TypeSystemDirectiveLocation)
-> (TypeSystemDirectiveLocation -> Int)
-> (TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation])
-> (TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation])
-> (TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation])
-> (TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation
    -> [TypeSystemDirectiveLocation])
-> Enum TypeSystemDirectiveLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation
succ :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation
$cpred :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation
pred :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation
$ctoEnum :: Int -> TypeSystemDirectiveLocation
toEnum :: Int -> TypeSystemDirectiveLocation
$cfromEnum :: TypeSystemDirectiveLocation -> Int
fromEnum :: TypeSystemDirectiveLocation -> Int
$cenumFrom :: TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
enumFrom :: TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
$cenumFromThen :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
enumFromThen :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
$cenumFromTo :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
enumFromTo :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation -> [TypeSystemDirectiveLocation]
$cenumFromThenTo :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> [TypeSystemDirectiveLocation]
enumFromThenTo :: TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> TypeSystemDirectiveLocation
-> [TypeSystemDirectiveLocation]
Enum)

-- | https://spec.graphql.org/draft/#StringValue
data StringValue
    = SingleLineString MisoString
    | BlockString MisoString
    deriving stock (Int -> StringValue -> ShowS
[StringValue] -> ShowS
StringValue -> String
(Int -> StringValue -> ShowS)
-> (StringValue -> String)
-> ([StringValue] -> ShowS)
-> Show StringValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StringValue -> ShowS
showsPrec :: Int -> StringValue -> ShowS
$cshow :: StringValue -> String
show :: StringValue -> String
$cshowList :: [StringValue] -> ShowS
showList :: [StringValue] -> ShowS
Show, StringValue -> StringValue -> Bool
(StringValue -> StringValue -> Bool)
-> (StringValue -> StringValue -> Bool) -> Eq StringValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StringValue -> StringValue -> Bool
== :: StringValue -> StringValue -> Bool
$c/= :: StringValue -> StringValue -> Bool
/= :: StringValue -> StringValue -> Bool
Eq, (forall x. StringValue -> Rep StringValue x)
-> (forall x. Rep StringValue x -> StringValue)
-> Generic StringValue
forall x. Rep StringValue x -> StringValue
forall x. StringValue -> Rep StringValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StringValue -> Rep StringValue x
from :: forall x. StringValue -> Rep StringValue x
$cto :: forall x. Rep StringValue x -> StringValue
to :: forall x. Rep StringValue x -> StringValue
Generic)

-- | A GraphQL 'Document'
-- https://spec.graphql.org/draft/#Document
newtype Document = Document (NonEmpty Definition)
    deriving stock (Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
(Int -> Document -> ShowS)
-> (Document -> String) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Document -> ShowS
showsPrec :: Int -> Document -> ShowS
$cshow :: Document -> String
show :: Document -> String
$cshowList :: [Document] -> ShowS
showList :: [Document] -> ShowS
Show, Document -> Document -> Bool
(Document -> Document -> Bool)
-> (Document -> Document -> Bool) -> Eq Document
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
/= :: Document -> Document -> Bool
Eq, (forall x. Document -> Rep Document x)
-> (forall x. Rep Document x -> Document) -> Generic Document
forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Document -> Rep Document x
from :: forall x. Document -> Rep Document x
$cto :: forall x. Rep Document x -> Document
to :: forall x. Rep Document x -> Document
Generic)

-- | A GraphQL 'Definition'
-- https://spec.graphql.org/draft/#Definition
data Definition
    = DefinitionExecutable ExecutableDefinition
    | DefinitionTypeSystem TypeSystemDefinition
    | ExtensionTypeSystem TypeSystemExtension
    deriving stock (Int -> Definition -> ShowS
[Definition] -> ShowS
Definition -> String
(Int -> Definition -> ShowS)
-> (Definition -> String)
-> ([Definition] -> ShowS)
-> Show Definition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Definition -> ShowS
showsPrec :: Int -> Definition -> ShowS
$cshow :: Definition -> String
show :: Definition -> String
$cshowList :: [Definition] -> ShowS
showList :: [Definition] -> ShowS
Show, Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
/= :: Definition -> Definition -> Bool
Eq, (forall x. Definition -> Rep Definition x)
-> (forall x. Rep Definition x -> Definition) -> Generic Definition
forall x. Rep Definition x -> Definition
forall x. Definition -> Rep Definition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Definition -> Rep Definition x
from :: forall x. Definition -> Rep Definition x
$cto :: forall x. Rep Definition x -> Definition
to :: forall x. Rep Definition x -> Definition
Generic)

-- | A GraphQL 'ExecutableDefinition'
-- https://spec.graphql.org/draft/#ExecutableDefinition
data ExecutableDefinition
    = DefinitionOperation OperationDefinition
    | DefinitionFragment FragmentDefinition
    deriving stock (Int -> ExecutableDefinition -> ShowS
[ExecutableDefinition] -> ShowS
ExecutableDefinition -> String
(Int -> ExecutableDefinition -> ShowS)
-> (ExecutableDefinition -> String)
-> ([ExecutableDefinition] -> ShowS)
-> Show ExecutableDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutableDefinition -> ShowS
showsPrec :: Int -> ExecutableDefinition -> ShowS
$cshow :: ExecutableDefinition -> String
show :: ExecutableDefinition -> String
$cshowList :: [ExecutableDefinition] -> ShowS
showList :: [ExecutableDefinition] -> ShowS
Show, ExecutableDefinition -> ExecutableDefinition -> Bool
(ExecutableDefinition -> ExecutableDefinition -> Bool)
-> (ExecutableDefinition -> ExecutableDefinition -> Bool)
-> Eq ExecutableDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutableDefinition -> ExecutableDefinition -> Bool
== :: ExecutableDefinition -> ExecutableDefinition -> Bool
$c/= :: ExecutableDefinition -> ExecutableDefinition -> Bool
/= :: ExecutableDefinition -> ExecutableDefinition -> Bool
Eq, (forall x. ExecutableDefinition -> Rep ExecutableDefinition x)
-> (forall x. Rep ExecutableDefinition x -> ExecutableDefinition)
-> Generic ExecutableDefinition
forall x. Rep ExecutableDefinition x -> ExecutableDefinition
forall x. ExecutableDefinition -> Rep ExecutableDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutableDefinition -> Rep ExecutableDefinition x
from :: forall x. ExecutableDefinition -> Rep ExecutableDefinition x
$cto :: forall x. Rep ExecutableDefinition x -> ExecutableDefinition
to :: forall x. Rep ExecutableDefinition x -> ExecutableDefinition
Generic)

-- | A GraphQL 'OperationDefinition'
-- https://spec.graphql.org/draft/#OperationDefinition
data OperationDefinition
    = AnonymousQuery SelectionSet
    | OperationDefinition
        (Maybe Description)
        OperationType
        (Maybe Name)
        (Maybe VariablesDefinition)
        (Maybe Directives)
        SelectionSet
    deriving stock (Int -> OperationDefinition -> ShowS
[OperationDefinition] -> ShowS
OperationDefinition -> String
(Int -> OperationDefinition -> ShowS)
-> (OperationDefinition -> String)
-> ([OperationDefinition] -> ShowS)
-> Show OperationDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationDefinition -> ShowS
showsPrec :: Int -> OperationDefinition -> ShowS
$cshow :: OperationDefinition -> String
show :: OperationDefinition -> String
$cshowList :: [OperationDefinition] -> ShowS
showList :: [OperationDefinition] -> ShowS
Show, OperationDefinition -> OperationDefinition -> Bool
(OperationDefinition -> OperationDefinition -> Bool)
-> (OperationDefinition -> OperationDefinition -> Bool)
-> Eq OperationDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationDefinition -> OperationDefinition -> Bool
== :: OperationDefinition -> OperationDefinition -> Bool
$c/= :: OperationDefinition -> OperationDefinition -> Bool
/= :: OperationDefinition -> OperationDefinition -> Bool
Eq, (forall x. OperationDefinition -> Rep OperationDefinition x)
-> (forall x. Rep OperationDefinition x -> OperationDefinition)
-> Generic OperationDefinition
forall x. Rep OperationDefinition x -> OperationDefinition
forall x. OperationDefinition -> Rep OperationDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OperationDefinition -> Rep OperationDefinition x
from :: forall x. OperationDefinition -> Rep OperationDefinition x
$cto :: forall x. Rep OperationDefinition x -> OperationDefinition
to :: forall x. Rep OperationDefinition x -> OperationDefinition
Generic)

operationSelectionSet :: OperationDefinition -> SelectionSet
operationSelectionSet :: OperationDefinition -> SelectionSet
operationSelectionSet (AnonymousQuery SelectionSet
selectionSet) = SelectionSet
selectionSet
operationSelectionSet (OperationDefinition Maybe Description
_ OperationType
_ Maybe Name
_ Maybe VariablesDefinition
_ Maybe Directives
_ SelectionSet
selectionSet) = SelectionSet
selectionSet

-- | A GraphQL 'Operation' type
-- https://spec.graphql.org/draft/#OperationType
data OperationType
    = Query
    | Mutation
    | Subscription
    deriving stock (Int -> OperationType -> ShowS
[OperationType] -> ShowS
OperationType -> String
(Int -> OperationType -> ShowS)
-> (OperationType -> String)
-> ([OperationType] -> ShowS)
-> Show OperationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationType -> ShowS
showsPrec :: Int -> OperationType -> ShowS
$cshow :: OperationType -> String
show :: OperationType -> String
$cshowList :: [OperationType] -> ShowS
showList :: [OperationType] -> ShowS
Show, OperationType -> OperationType -> Bool
(OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool) -> Eq OperationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationType -> OperationType -> Bool
== :: OperationType -> OperationType -> Bool
$c/= :: OperationType -> OperationType -> Bool
/= :: OperationType -> OperationType -> Bool
Eq, Eq OperationType
Eq OperationType =>
(OperationType -> OperationType -> Ordering)
-> (OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> OperationType)
-> (OperationType -> OperationType -> OperationType)
-> Ord OperationType
OperationType -> OperationType -> Bool
OperationType -> OperationType -> Ordering
OperationType -> OperationType -> OperationType
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
$ccompare :: OperationType -> OperationType -> Ordering
compare :: OperationType -> OperationType -> Ordering
$c< :: OperationType -> OperationType -> Bool
< :: OperationType -> OperationType -> Bool
$c<= :: OperationType -> OperationType -> Bool
<= :: OperationType -> OperationType -> Bool
$c> :: OperationType -> OperationType -> Bool
> :: OperationType -> OperationType -> Bool
$c>= :: OperationType -> OperationType -> Bool
>= :: OperationType -> OperationType -> Bool
$cmax :: OperationType -> OperationType -> OperationType
max :: OperationType -> OperationType -> OperationType
$cmin :: OperationType -> OperationType -> OperationType
min :: OperationType -> OperationType -> OperationType
Ord, (forall x. OperationType -> Rep OperationType x)
-> (forall x. Rep OperationType x -> OperationType)
-> Generic OperationType
forall x. Rep OperationType x -> OperationType
forall x. OperationType -> Rep OperationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OperationType -> Rep OperationType x
from :: forall x. OperationType -> Rep OperationType x
$cto :: forall x. Rep OperationType x -> OperationType
to :: forall x. Rep OperationType x -> OperationType
Generic, OperationType
OperationType -> OperationType -> Bounded OperationType
forall a. a -> a -> Bounded a
$cminBound :: OperationType
minBound :: OperationType
$cmaxBound :: OperationType
maxBound :: OperationType
Bounded, Int -> OperationType
OperationType -> Int
OperationType -> [OperationType]
OperationType -> OperationType
OperationType -> OperationType -> [OperationType]
OperationType -> OperationType -> OperationType -> [OperationType]
(OperationType -> OperationType)
-> (OperationType -> OperationType)
-> (Int -> OperationType)
-> (OperationType -> Int)
-> (OperationType -> [OperationType])
-> (OperationType -> OperationType -> [OperationType])
-> (OperationType -> OperationType -> [OperationType])
-> (OperationType
    -> OperationType -> OperationType -> [OperationType])
-> Enum OperationType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OperationType -> OperationType
succ :: OperationType -> OperationType
$cpred :: OperationType -> OperationType
pred :: OperationType -> OperationType
$ctoEnum :: Int -> OperationType
toEnum :: Int -> OperationType
$cfromEnum :: OperationType -> Int
fromEnum :: OperationType -> Int
$cenumFrom :: OperationType -> [OperationType]
enumFrom :: OperationType -> [OperationType]
$cenumFromThen :: OperationType -> OperationType -> [OperationType]
enumFromThen :: OperationType -> OperationType -> [OperationType]
$cenumFromTo :: OperationType -> OperationType -> [OperationType]
enumFromTo :: OperationType -> OperationType -> [OperationType]
$cenumFromThenTo :: OperationType -> OperationType -> OperationType -> [OperationType]
enumFromThenTo :: OperationType -> OperationType -> OperationType -> [OperationType]
Enum)

-- | A GraphQL 'SelectionSet'
-- https://spec.graphql.org/draft/#SelectionSet
type SelectionSet = NonEmpty Selection

-- | A GraphQL 'Selection' type
-- https://spec.graphql.org/draft/#Selection
data Selection
    = SelectionField Field
    | SelectionFragmentSpread FragmentSpread
    | SelectionInlineFragment InlineFragment
    deriving stock (Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
(Int -> Selection -> ShowS)
-> (Selection -> String)
-> ([Selection] -> ShowS)
-> Show Selection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Selection -> ShowS
showsPrec :: Int -> Selection -> ShowS
$cshow :: Selection -> String
show :: Selection -> String
$cshowList :: [Selection] -> ShowS
showList :: [Selection] -> ShowS
Show, Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
/= :: Selection -> Selection -> Bool
Eq, (forall x. Selection -> Rep Selection x)
-> (forall x. Rep Selection x -> Selection) -> Generic Selection
forall x. Rep Selection x -> Selection
forall x. Selection -> Rep Selection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Selection -> Rep Selection x
from :: forall x. Selection -> Rep Selection x
$cto :: forall x. Rep Selection x -> Selection
to :: forall x. Rep Selection x -> Selection
Generic)

-- | A GraphQL 'Field' type
-- https://spec.graphql.org/draft/#Field
data Field
    = Field
        (Maybe Alias)
        Name
        (Maybe Arguments)
        (Maybe Directives)
        (Maybe SelectionSet)
    deriving stock (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
Show, Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: Field -> Field -> Bool
Eq, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Field -> Rep Field x
from :: forall x. Field -> Rep Field x
$cto :: forall x. Rep Field x -> Field
to :: forall x. Rep Field x -> Field
Generic)

-- | A GraphQL 'Alias'
-- https://spec.graphql.org/draft/#Alias
newtype Alias = Alias Name
    deriving stock (Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
(Int -> Alias -> ShowS)
-> (Alias -> String) -> ([Alias] -> ShowS) -> Show Alias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alias -> ShowS
showsPrec :: Int -> Alias -> ShowS
$cshow :: Alias -> String
show :: Alias -> String
$cshowList :: [Alias] -> ShowS
showList :: [Alias] -> ShowS
Show, Alias -> Alias -> Bool
(Alias -> Alias -> Bool) -> (Alias -> Alias -> Bool) -> Eq Alias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alias -> Alias -> Bool
== :: Alias -> Alias -> Bool
$c/= :: Alias -> Alias -> Bool
/= :: Alias -> Alias -> Bool
Eq, Eq Alias
Eq Alias =>
(Alias -> Alias -> Ordering)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Bool)
-> (Alias -> Alias -> Alias)
-> (Alias -> Alias -> Alias)
-> Ord Alias
Alias -> Alias -> Bool
Alias -> Alias -> Ordering
Alias -> Alias -> Alias
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
$ccompare :: Alias -> Alias -> Ordering
compare :: Alias -> Alias -> Ordering
$c< :: Alias -> Alias -> Bool
< :: Alias -> Alias -> Bool
$c<= :: Alias -> Alias -> Bool
<= :: Alias -> Alias -> Bool
$c> :: Alias -> Alias -> Bool
> :: Alias -> Alias -> Bool
$c>= :: Alias -> Alias -> Bool
>= :: Alias -> Alias -> Bool
$cmax :: Alias -> Alias -> Alias
max :: Alias -> Alias -> Alias
$cmin :: Alias -> Alias -> Alias
min :: Alias -> Alias -> Alias
Ord, (forall x. Alias -> Rep Alias x)
-> (forall x. Rep Alias x -> Alias) -> Generic Alias
forall x. Rep Alias x -> Alias
forall x. Alias -> Rep Alias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Alias -> Rep Alias x
from :: forall x. Alias -> Rep Alias x
$cto :: forall x. Rep Alias x -> Alias
to :: forall x. Rep Alias x -> Alias
Generic)

-- | GraphQL 'Arguments'
-- https://spec.graphql.org/draft/#Arguments
type Arguments = NonEmpty Argument

-- | A GraphQL 'Argument'
-- https://spec.graphql.org/draft/#Arguments
data Argument = Argument Name Value
    deriving stock (Int -> Argument -> ShowS
[Argument] -> ShowS
Argument -> String
(Int -> Argument -> ShowS)
-> (Argument -> String) -> ([Argument] -> ShowS) -> Show Argument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Argument -> ShowS
showsPrec :: Int -> Argument -> ShowS
$cshow :: Argument -> String
show :: Argument -> String
$cshowList :: [Argument] -> ShowS
showList :: [Argument] -> ShowS
Show, Argument -> Argument -> Bool
(Argument -> Argument -> Bool)
-> (Argument -> Argument -> Bool) -> Eq Argument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Argument -> Argument -> Bool
== :: Argument -> Argument -> Bool
$c/= :: Argument -> Argument -> Bool
/= :: Argument -> Argument -> Bool
Eq, (forall x. Argument -> Rep Argument x)
-> (forall x. Rep Argument x -> Argument) -> Generic Argument
forall x. Rep Argument x -> Argument
forall x. Argument -> Rep Argument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Argument -> Rep Argument x
from :: forall x. Argument -> Rep Argument x
$cto :: forall x. Rep Argument x -> Argument
to :: forall x. Rep Argument x -> Argument
Generic)

argumentName :: Argument -> Name
argumentName :: Argument -> Name
argumentName (Argument Name
name Value
_) = Name
name

-- | GraphQL 'FragmentSpread' type
-- https://spec.graphql.org/draft/#FragmentSpread
data FragmentSpread = FragmentSpread FragmentName (Maybe Directives)
    deriving stock (Int -> FragmentSpread -> ShowS
[FragmentSpread] -> ShowS
FragmentSpread -> String
(Int -> FragmentSpread -> ShowS)
-> (FragmentSpread -> String)
-> ([FragmentSpread] -> ShowS)
-> Show FragmentSpread
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FragmentSpread -> ShowS
showsPrec :: Int -> FragmentSpread -> ShowS
$cshow :: FragmentSpread -> String
show :: FragmentSpread -> String
$cshowList :: [FragmentSpread] -> ShowS
showList :: [FragmentSpread] -> ShowS
Show, FragmentSpread -> FragmentSpread -> Bool
(FragmentSpread -> FragmentSpread -> Bool)
-> (FragmentSpread -> FragmentSpread -> Bool) -> Eq FragmentSpread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FragmentSpread -> FragmentSpread -> Bool
== :: FragmentSpread -> FragmentSpread -> Bool
$c/= :: FragmentSpread -> FragmentSpread -> Bool
/= :: FragmentSpread -> FragmentSpread -> Bool
Eq, (forall x. FragmentSpread -> Rep FragmentSpread x)
-> (forall x. Rep FragmentSpread x -> FragmentSpread)
-> Generic FragmentSpread
forall x. Rep FragmentSpread x -> FragmentSpread
forall x. FragmentSpread -> Rep FragmentSpread x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FragmentSpread -> Rep FragmentSpread x
from :: forall x. FragmentSpread -> Rep FragmentSpread x
$cto :: forall x. Rep FragmentSpread x -> FragmentSpread
to :: forall x. Rep FragmentSpread x -> FragmentSpread
Generic)

-- | GraphQL 'InlineFragment' type
-- https://spec.graphql.org/draft/#InlineFragment
data InlineFragment
    = InlineFragment (Maybe TypeCondition) (Maybe Directives) SelectionSet
    deriving stock (Int -> InlineFragment -> ShowS
[InlineFragment] -> ShowS
InlineFragment -> String
(Int -> InlineFragment -> ShowS)
-> (InlineFragment -> String)
-> ([InlineFragment] -> ShowS)
-> Show InlineFragment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InlineFragment -> ShowS
showsPrec :: Int -> InlineFragment -> ShowS
$cshow :: InlineFragment -> String
show :: InlineFragment -> String
$cshowList :: [InlineFragment] -> ShowS
showList :: [InlineFragment] -> ShowS
Show, InlineFragment -> InlineFragment -> Bool
(InlineFragment -> InlineFragment -> Bool)
-> (InlineFragment -> InlineFragment -> Bool) -> Eq InlineFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InlineFragment -> InlineFragment -> Bool
== :: InlineFragment -> InlineFragment -> Bool
$c/= :: InlineFragment -> InlineFragment -> Bool
/= :: InlineFragment -> InlineFragment -> Bool
Eq, (forall x. InlineFragment -> Rep InlineFragment x)
-> (forall x. Rep InlineFragment x -> InlineFragment)
-> Generic InlineFragment
forall x. Rep InlineFragment x -> InlineFragment
forall x. InlineFragment -> Rep InlineFragment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InlineFragment -> Rep InlineFragment x
from :: forall x. InlineFragment -> Rep InlineFragment x
$cto :: forall x. Rep InlineFragment x -> InlineFragment
to :: forall x. Rep InlineFragment x -> InlineFragment
Generic)

-- | A GraphQL 'FragmentDefinition'
-- https://spec.graphql.org/draft/#FragmentDefinition
data FragmentDefinition
    = FragmentDefinition
        (Maybe Description)
        FragmentName
        TypeCondition
        (Maybe Directives)
        SelectionSet
    deriving stock (Int -> FragmentDefinition -> ShowS
[FragmentDefinition] -> ShowS
FragmentDefinition -> String
(Int -> FragmentDefinition -> ShowS)
-> (FragmentDefinition -> String)
-> ([FragmentDefinition] -> ShowS)
-> Show FragmentDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FragmentDefinition -> ShowS
showsPrec :: Int -> FragmentDefinition -> ShowS
$cshow :: FragmentDefinition -> String
show :: FragmentDefinition -> String
$cshowList :: [FragmentDefinition] -> ShowS
showList :: [FragmentDefinition] -> ShowS
Show, FragmentDefinition -> FragmentDefinition -> Bool
(FragmentDefinition -> FragmentDefinition -> Bool)
-> (FragmentDefinition -> FragmentDefinition -> Bool)
-> Eq FragmentDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FragmentDefinition -> FragmentDefinition -> Bool
== :: FragmentDefinition -> FragmentDefinition -> Bool
$c/= :: FragmentDefinition -> FragmentDefinition -> Bool
/= :: FragmentDefinition -> FragmentDefinition -> Bool
Eq, (forall x. FragmentDefinition -> Rep FragmentDefinition x)
-> (forall x. Rep FragmentDefinition x -> FragmentDefinition)
-> Generic FragmentDefinition
forall x. Rep FragmentDefinition x -> FragmentDefinition
forall x. FragmentDefinition -> Rep FragmentDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FragmentDefinition -> Rep FragmentDefinition x
from :: forall x. FragmentDefinition -> Rep FragmentDefinition x
$cto :: forall x. Rep FragmentDefinition x -> FragmentDefinition
to :: forall x. Rep FragmentDefinition x -> FragmentDefinition
Generic)

-- | A GraphQL 'FragmentName'
-- https://spec.graphql.org/draft/#FragmentName
newtype FragmentName = FragmentName Name
    deriving stock ((forall x. FragmentName -> Rep FragmentName x)
-> (forall x. Rep FragmentName x -> FragmentName)
-> Generic FragmentName
forall x. Rep FragmentName x -> FragmentName
forall x. FragmentName -> Rep FragmentName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FragmentName -> Rep FragmentName x
from :: forall x. FragmentName -> Rep FragmentName x
$cto :: forall x. Rep FragmentName x -> FragmentName
to :: forall x. Rep FragmentName x -> FragmentName
Generic)
    deriving newtype (Int -> FragmentName -> ShowS
[FragmentName] -> ShowS
FragmentName -> String
(Int -> FragmentName -> ShowS)
-> (FragmentName -> String)
-> ([FragmentName] -> ShowS)
-> Show FragmentName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FragmentName -> ShowS
showsPrec :: Int -> FragmentName -> ShowS
$cshow :: FragmentName -> String
show :: FragmentName -> String
$cshowList :: [FragmentName] -> ShowS
showList :: [FragmentName] -> ShowS
Show, FragmentName -> FragmentName -> Bool
(FragmentName -> FragmentName -> Bool)
-> (FragmentName -> FragmentName -> Bool) -> Eq FragmentName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FragmentName -> FragmentName -> Bool
== :: FragmentName -> FragmentName -> Bool
$c/= :: FragmentName -> FragmentName -> Bool
/= :: FragmentName -> FragmentName -> Bool
Eq, Eq FragmentName
Eq FragmentName =>
(FragmentName -> FragmentName -> Ordering)
-> (FragmentName -> FragmentName -> Bool)
-> (FragmentName -> FragmentName -> Bool)
-> (FragmentName -> FragmentName -> Bool)
-> (FragmentName -> FragmentName -> Bool)
-> (FragmentName -> FragmentName -> FragmentName)
-> (FragmentName -> FragmentName -> FragmentName)
-> Ord FragmentName
FragmentName -> FragmentName -> Bool
FragmentName -> FragmentName -> Ordering
FragmentName -> FragmentName -> FragmentName
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
$ccompare :: FragmentName -> FragmentName -> Ordering
compare :: FragmentName -> FragmentName -> Ordering
$c< :: FragmentName -> FragmentName -> Bool
< :: FragmentName -> FragmentName -> Bool
$c<= :: FragmentName -> FragmentName -> Bool
<= :: FragmentName -> FragmentName -> Bool
$c> :: FragmentName -> FragmentName -> Bool
> :: FragmentName -> FragmentName -> Bool
$c>= :: FragmentName -> FragmentName -> Bool
>= :: FragmentName -> FragmentName -> Bool
$cmax :: FragmentName -> FragmentName -> FragmentName
max :: FragmentName -> FragmentName -> FragmentName
$cmin :: FragmentName -> FragmentName -> FragmentName
min :: FragmentName -> FragmentName -> FragmentName
Ord, Semigroup FragmentName
FragmentName
Semigroup FragmentName =>
FragmentName
-> (FragmentName -> FragmentName -> FragmentName)
-> ([FragmentName] -> FragmentName)
-> Monoid FragmentName
[FragmentName] -> FragmentName
FragmentName -> FragmentName -> FragmentName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: FragmentName
mempty :: FragmentName
$cmappend :: FragmentName -> FragmentName -> FragmentName
mappend :: FragmentName -> FragmentName -> FragmentName
$cmconcat :: [FragmentName] -> FragmentName
mconcat :: [FragmentName] -> FragmentName
Monoid, NonEmpty FragmentName -> FragmentName
FragmentName -> FragmentName -> FragmentName
(FragmentName -> FragmentName -> FragmentName)
-> (NonEmpty FragmentName -> FragmentName)
-> (forall b. Integral b => b -> FragmentName -> FragmentName)
-> Semigroup FragmentName
forall b. Integral b => b -> FragmentName -> FragmentName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: FragmentName -> FragmentName -> FragmentName
<> :: FragmentName -> FragmentName -> FragmentName
$csconcat :: NonEmpty FragmentName -> FragmentName
sconcat :: NonEmpty FragmentName -> FragmentName
$cstimes :: forall b. Integral b => b -> FragmentName -> FragmentName
stimes :: forall b. Integral b => b -> FragmentName -> FragmentName
Semigroup)

-- | A GraphQL 'TypeCondition'
-- https://spec.graphql.org/draft/#TypeCondition
newtype TypeCondition = TypeCondition NamedType
    deriving stock ((forall x. TypeCondition -> Rep TypeCondition x)
-> (forall x. Rep TypeCondition x -> TypeCondition)
-> Generic TypeCondition
forall x. Rep TypeCondition x -> TypeCondition
forall x. TypeCondition -> Rep TypeCondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeCondition -> Rep TypeCondition x
from :: forall x. TypeCondition -> Rep TypeCondition x
$cto :: forall x. Rep TypeCondition x -> TypeCondition
to :: forall x. Rep TypeCondition x -> TypeCondition
Generic)
    deriving newtype (Int -> TypeCondition -> ShowS
[TypeCondition] -> ShowS
TypeCondition -> String
(Int -> TypeCondition -> ShowS)
-> (TypeCondition -> String)
-> ([TypeCondition] -> ShowS)
-> Show TypeCondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeCondition -> ShowS
showsPrec :: Int -> TypeCondition -> ShowS
$cshow :: TypeCondition -> String
show :: TypeCondition -> String
$cshowList :: [TypeCondition] -> ShowS
showList :: [TypeCondition] -> ShowS
Show, TypeCondition -> TypeCondition -> Bool
(TypeCondition -> TypeCondition -> Bool)
-> (TypeCondition -> TypeCondition -> Bool) -> Eq TypeCondition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeCondition -> TypeCondition -> Bool
== :: TypeCondition -> TypeCondition -> Bool
$c/= :: TypeCondition -> TypeCondition -> Bool
/= :: TypeCondition -> TypeCondition -> Bool
Eq, Semigroup TypeCondition
TypeCondition
Semigroup TypeCondition =>
TypeCondition
-> (TypeCondition -> TypeCondition -> TypeCondition)
-> ([TypeCondition] -> TypeCondition)
-> Monoid TypeCondition
[TypeCondition] -> TypeCondition
TypeCondition -> TypeCondition -> TypeCondition
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: TypeCondition
mempty :: TypeCondition
$cmappend :: TypeCondition -> TypeCondition -> TypeCondition
mappend :: TypeCondition -> TypeCondition -> TypeCondition
$cmconcat :: [TypeCondition] -> TypeCondition
mconcat :: [TypeCondition] -> TypeCondition
Monoid, NonEmpty TypeCondition -> TypeCondition
TypeCondition -> TypeCondition -> TypeCondition
(TypeCondition -> TypeCondition -> TypeCondition)
-> (NonEmpty TypeCondition -> TypeCondition)
-> (forall b. Integral b => b -> TypeCondition -> TypeCondition)
-> Semigroup TypeCondition
forall b. Integral b => b -> TypeCondition -> TypeCondition
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TypeCondition -> TypeCondition -> TypeCondition
<> :: TypeCondition -> TypeCondition -> TypeCondition
$csconcat :: NonEmpty TypeCondition -> TypeCondition
sconcat :: NonEmpty TypeCondition -> TypeCondition
$cstimes :: forall b. Integral b => b -> TypeCondition -> TypeCondition
stimes :: forall b. Integral b => b -> TypeCondition -> TypeCondition
Semigroup)

-- | A GraphQL 'Value'
-- https://spec.graphql.org/draft/#Value
data Value
    = ValueVariable Variable
    | ValueInt Int
    | ValueFloat Double
    | ValueString StringValue
    | ValueBoolean Bool
    | ValueNull
    | ValueEnum EnumValue
    | ValueList [Value]
    | ValueObject [ObjectField]
    deriving stock (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic)

-- | A GraphQL 'EnumValue'
-- https://spec.graphql.org/draft/#EnumValue
newtype EnumValue = EnumValue Name
    deriving stock ((forall x. EnumValue -> Rep EnumValue x)
-> (forall x. Rep EnumValue x -> EnumValue) -> Generic EnumValue
forall x. Rep EnumValue x -> EnumValue
forall x. EnumValue -> Rep EnumValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValue -> Rep EnumValue x
from :: forall x. EnumValue -> Rep EnumValue x
$cto :: forall x. Rep EnumValue x -> EnumValue
to :: forall x. Rep EnumValue x -> EnumValue
Generic)
    deriving newtype (Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> String
(Int -> EnumValue -> ShowS)
-> (EnumValue -> String)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValue -> ShowS
showsPrec :: Int -> EnumValue -> ShowS
$cshow :: EnumValue -> String
show :: EnumValue -> String
$cshowList :: [EnumValue] -> ShowS
showList :: [EnumValue] -> ShowS
Show, EnumValue -> EnumValue -> Bool
(EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool) -> Eq EnumValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValue -> EnumValue -> Bool
== :: EnumValue -> EnumValue -> Bool
$c/= :: EnumValue -> EnumValue -> Bool
/= :: EnumValue -> EnumValue -> Bool
Eq, Eq EnumValue
Eq EnumValue =>
(EnumValue -> EnumValue -> Ordering)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> EnumValue)
-> (EnumValue -> EnumValue -> EnumValue)
-> Ord EnumValue
EnumValue -> EnumValue -> Bool
EnumValue -> EnumValue -> Ordering
EnumValue -> EnumValue -> EnumValue
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
$ccompare :: EnumValue -> EnumValue -> Ordering
compare :: EnumValue -> EnumValue -> Ordering
$c< :: EnumValue -> EnumValue -> Bool
< :: EnumValue -> EnumValue -> Bool
$c<= :: EnumValue -> EnumValue -> Bool
<= :: EnumValue -> EnumValue -> Bool
$c> :: EnumValue -> EnumValue -> Bool
> :: EnumValue -> EnumValue -> Bool
$c>= :: EnumValue -> EnumValue -> Bool
>= :: EnumValue -> EnumValue -> Bool
$cmax :: EnumValue -> EnumValue -> EnumValue
max :: EnumValue -> EnumValue -> EnumValue
$cmin :: EnumValue -> EnumValue -> EnumValue
min :: EnumValue -> EnumValue -> EnumValue
Ord, Semigroup EnumValue
EnumValue
Semigroup EnumValue =>
EnumValue
-> (EnumValue -> EnumValue -> EnumValue)
-> ([EnumValue] -> EnumValue)
-> Monoid EnumValue
[EnumValue] -> EnumValue
EnumValue -> EnumValue -> EnumValue
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: EnumValue
mempty :: EnumValue
$cmappend :: EnumValue -> EnumValue -> EnumValue
mappend :: EnumValue -> EnumValue -> EnumValue
$cmconcat :: [EnumValue] -> EnumValue
mconcat :: [EnumValue] -> EnumValue
Monoid, NonEmpty EnumValue -> EnumValue
EnumValue -> EnumValue -> EnumValue
(EnumValue -> EnumValue -> EnumValue)
-> (NonEmpty EnumValue -> EnumValue)
-> (forall b. Integral b => b -> EnumValue -> EnumValue)
-> Semigroup EnumValue
forall b. Integral b => b -> EnumValue -> EnumValue
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: EnumValue -> EnumValue -> EnumValue
<> :: EnumValue -> EnumValue -> EnumValue
$csconcat :: NonEmpty EnumValue -> EnumValue
sconcat :: NonEmpty EnumValue -> EnumValue
$cstimes :: forall b. Integral b => b -> EnumValue -> EnumValue
stimes :: forall b. Integral b => b -> EnumValue -> EnumValue
Semigroup)

enumValueName :: EnumValue -> Name
enumValueName :: EnumValue -> Name
enumValueName (EnumValue Name
name) = Name
name

-- | A GraphQL 'ObjectField'
-- https://spec.graphql.org/draft/#ObjectField
data ObjectField = ObjectField Name Value
    deriving stock (Int -> ObjectField -> ShowS
[ObjectField] -> ShowS
ObjectField -> String
(Int -> ObjectField -> ShowS)
-> (ObjectField -> String)
-> ([ObjectField] -> ShowS)
-> Show ObjectField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectField -> ShowS
showsPrec :: Int -> ObjectField -> ShowS
$cshow :: ObjectField -> String
show :: ObjectField -> String
$cshowList :: [ObjectField] -> ShowS
showList :: [ObjectField] -> ShowS
Show, ObjectField -> ObjectField -> Bool
(ObjectField -> ObjectField -> Bool)
-> (ObjectField -> ObjectField -> Bool) -> Eq ObjectField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectField -> ObjectField -> Bool
== :: ObjectField -> ObjectField -> Bool
$c/= :: ObjectField -> ObjectField -> Bool
/= :: ObjectField -> ObjectField -> Bool
Eq, (forall x. ObjectField -> Rep ObjectField x)
-> (forall x. Rep ObjectField x -> ObjectField)
-> Generic ObjectField
forall x. Rep ObjectField x -> ObjectField
forall x. ObjectField -> Rep ObjectField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectField -> Rep ObjectField x
from :: forall x. ObjectField -> Rep ObjectField x
$cto :: forall x. Rep ObjectField x -> ObjectField
to :: forall x. Rep ObjectField x -> ObjectField
Generic)

objectFieldName :: ObjectField -> Name
objectFieldName :: ObjectField -> Name
objectFieldName (ObjectField Name
name Value
_) = Name
name

-- | GraphQL 'VariablesDefinition'
-- https://spec.graphql.org/draft/#VariablesDefinition
type VariablesDefinition = NonEmpty VariableDefinition

-- | A GraphQL 'VariableDefinition'
-- https://spec.graphql.org/draft/#VariableDefinition
data VariableDefinition
    = VariableDefinition
        (Maybe Description)
        Variable
        Type
        (Maybe DefaultValue)
        (Maybe Directives)
    deriving stock (Int -> VariableDefinition -> ShowS
[VariableDefinition] -> ShowS
VariableDefinition -> String
(Int -> VariableDefinition -> ShowS)
-> (VariableDefinition -> String)
-> ([VariableDefinition] -> ShowS)
-> Show VariableDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VariableDefinition -> ShowS
showsPrec :: Int -> VariableDefinition -> ShowS
$cshow :: VariableDefinition -> String
show :: VariableDefinition -> String
$cshowList :: [VariableDefinition] -> ShowS
showList :: [VariableDefinition] -> ShowS
Show, VariableDefinition -> VariableDefinition -> Bool
(VariableDefinition -> VariableDefinition -> Bool)
-> (VariableDefinition -> VariableDefinition -> Bool)
-> Eq VariableDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariableDefinition -> VariableDefinition -> Bool
== :: VariableDefinition -> VariableDefinition -> Bool
$c/= :: VariableDefinition -> VariableDefinition -> Bool
/= :: VariableDefinition -> VariableDefinition -> Bool
Eq, (forall x. VariableDefinition -> Rep VariableDefinition x)
-> (forall x. Rep VariableDefinition x -> VariableDefinition)
-> Generic VariableDefinition
forall x. Rep VariableDefinition x -> VariableDefinition
forall x. VariableDefinition -> Rep VariableDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VariableDefinition -> Rep VariableDefinition x
from :: forall x. VariableDefinition -> Rep VariableDefinition x
$cto :: forall x. Rep VariableDefinition x -> VariableDefinition
to :: forall x. Rep VariableDefinition x -> VariableDefinition
Generic)

variableDefinitionName :: VariableDefinition -> Name
variableDefinitionName :: VariableDefinition -> Name
variableDefinitionName (VariableDefinition Maybe Description
_ Variable
var Type
_ Maybe DefaultValue
_ Maybe Directives
_) = Variable -> Name
variableName Variable
var

-- | A GraphQL 'Variable'
-- https://spec.graphql.org/draft/#Variable
newtype Variable = Variable Name
    deriving stock ((forall x. Variable -> Rep Variable x)
-> (forall x. Rep Variable x -> Variable) -> Generic Variable
forall x. Rep Variable x -> Variable
forall x. Variable -> Rep Variable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Variable -> Rep Variable x
from :: forall x. Variable -> Rep Variable x
$cto :: forall x. Rep Variable x -> Variable
to :: forall x. Rep Variable x -> Variable
Generic)
    deriving newtype (Int -> Variable -> ShowS
[Variable] -> ShowS
Variable -> String
(Int -> Variable -> ShowS)
-> (Variable -> String) -> ([Variable] -> ShowS) -> Show Variable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Variable -> ShowS
showsPrec :: Int -> Variable -> ShowS
$cshow :: Variable -> String
show :: Variable -> String
$cshowList :: [Variable] -> ShowS
showList :: [Variable] -> ShowS
Show, Variable -> Variable -> Bool
(Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool) -> Eq Variable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variable -> Variable -> Bool
== :: Variable -> Variable -> Bool
$c/= :: Variable -> Variable -> Bool
/= :: Variable -> Variable -> Bool
Eq, Eq Variable
Eq Variable =>
(Variable -> Variable -> Ordering)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Bool)
-> (Variable -> Variable -> Variable)
-> (Variable -> Variable -> Variable)
-> Ord Variable
Variable -> Variable -> Bool
Variable -> Variable -> Ordering
Variable -> Variable -> Variable
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
$ccompare :: Variable -> Variable -> Ordering
compare :: Variable -> Variable -> Ordering
$c< :: Variable -> Variable -> Bool
< :: Variable -> Variable -> Bool
$c<= :: Variable -> Variable -> Bool
<= :: Variable -> Variable -> Bool
$c> :: Variable -> Variable -> Bool
> :: Variable -> Variable -> Bool
$c>= :: Variable -> Variable -> Bool
>= :: Variable -> Variable -> Bool
$cmax :: Variable -> Variable -> Variable
max :: Variable -> Variable -> Variable
$cmin :: Variable -> Variable -> Variable
min :: Variable -> Variable -> Variable
Ord, Semigroup Variable
Variable
Semigroup Variable =>
Variable
-> (Variable -> Variable -> Variable)
-> ([Variable] -> Variable)
-> Monoid Variable
[Variable] -> Variable
Variable -> Variable -> Variable
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Variable
mempty :: Variable
$cmappend :: Variable -> Variable -> Variable
mappend :: Variable -> Variable -> Variable
$cmconcat :: [Variable] -> Variable
mconcat :: [Variable] -> Variable
Monoid, NonEmpty Variable -> Variable
Variable -> Variable -> Variable
(Variable -> Variable -> Variable)
-> (NonEmpty Variable -> Variable)
-> (forall b. Integral b => b -> Variable -> Variable)
-> Semigroup Variable
forall b. Integral b => b -> Variable -> Variable
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Variable -> Variable -> Variable
<> :: Variable -> Variable -> Variable
$csconcat :: NonEmpty Variable -> Variable
sconcat :: NonEmpty Variable -> Variable
$cstimes :: forall b. Integral b => b -> Variable -> Variable
stimes :: forall b. Integral b => b -> Variable -> Variable
Semigroup)

variableName :: Variable -> Name
variableName :: Variable -> Name
variableName (Variable Name
name) = Name
name

-- | A GraphQL 'DefaultValue'
-- https://spec.graphql.org/draft/#DefaultValue
newtype DefaultValue = DefaultValue Value
    deriving stock (Int -> DefaultValue -> ShowS
[DefaultValue] -> ShowS
DefaultValue -> String
(Int -> DefaultValue -> ShowS)
-> (DefaultValue -> String)
-> ([DefaultValue] -> ShowS)
-> Show DefaultValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultValue -> ShowS
showsPrec :: Int -> DefaultValue -> ShowS
$cshow :: DefaultValue -> String
show :: DefaultValue -> String
$cshowList :: [DefaultValue] -> ShowS
showList :: [DefaultValue] -> ShowS
Show, DefaultValue -> DefaultValue -> Bool
(DefaultValue -> DefaultValue -> Bool)
-> (DefaultValue -> DefaultValue -> Bool) -> Eq DefaultValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultValue -> DefaultValue -> Bool
== :: DefaultValue -> DefaultValue -> Bool
$c/= :: DefaultValue -> DefaultValue -> Bool
/= :: DefaultValue -> DefaultValue -> Bool
Eq, (forall x. DefaultValue -> Rep DefaultValue x)
-> (forall x. Rep DefaultValue x -> DefaultValue)
-> Generic DefaultValue
forall x. Rep DefaultValue x -> DefaultValue
forall x. DefaultValue -> Rep DefaultValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefaultValue -> Rep DefaultValue x
from :: forall x. DefaultValue -> Rep DefaultValue x
$cto :: forall x. Rep DefaultValue x -> DefaultValue
to :: forall x. Rep DefaultValue x -> DefaultValue
Generic)

-- | A GraphQL 'Type'
-- https://spec.graphql.org/draft/#Type
data Type
    = TypeNamed NamedType
    | TypeList ListType
    | TypeNonNull NonNullType
    deriving stock (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Type -> Rep Type x
from :: forall x. Type -> Rep Type x
$cto :: forall x. Rep Type x -> Type
to :: forall x. Rep Type x -> Type
Generic)

typeName :: Type -> Name
typeName :: Type -> Name
typeName (TypeNamed NamedType
nt) = NamedType -> Name
namedTypeName NamedType
nt
typeName (TypeList (ListType Type
t)) = Type -> Name
typeName Type
t
typeName (TypeNonNull (NonNullTypeNamed NamedType
nt)) = NamedType -> Name
namedTypeName NamedType
nt
typeName (TypeNonNull (NonNullTypeList (ListType Type
t))) = Type -> Name
typeName Type
t

-- | A GraphQL 'NamedType'
-- https://spec.graphql.org/draft/#NamedType
newtype NamedType = NamedType Name
    deriving stock ((forall x. NamedType -> Rep NamedType x)
-> (forall x. Rep NamedType x -> NamedType) -> Generic NamedType
forall x. Rep NamedType x -> NamedType
forall x. NamedType -> Rep NamedType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedType -> Rep NamedType x
from :: forall x. NamedType -> Rep NamedType x
$cto :: forall x. Rep NamedType x -> NamedType
to :: forall x. Rep NamedType x -> NamedType
Generic)
    deriving newtype (Int -> NamedType -> ShowS
[NamedType] -> ShowS
NamedType -> String
(Int -> NamedType -> ShowS)
-> (NamedType -> String)
-> ([NamedType] -> ShowS)
-> Show NamedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedType -> ShowS
showsPrec :: Int -> NamedType -> ShowS
$cshow :: NamedType -> String
show :: NamedType -> String
$cshowList :: [NamedType] -> ShowS
showList :: [NamedType] -> ShowS
Show, NamedType -> NamedType -> Bool
(NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> Bool) -> Eq NamedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedType -> NamedType -> Bool
== :: NamedType -> NamedType -> Bool
$c/= :: NamedType -> NamedType -> Bool
/= :: NamedType -> NamedType -> Bool
Eq, Eq NamedType
Eq NamedType =>
(NamedType -> NamedType -> Ordering)
-> (NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> NamedType)
-> (NamedType -> NamedType -> NamedType)
-> Ord NamedType
NamedType -> NamedType -> Bool
NamedType -> NamedType -> Ordering
NamedType -> NamedType -> NamedType
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
$ccompare :: NamedType -> NamedType -> Ordering
compare :: NamedType -> NamedType -> Ordering
$c< :: NamedType -> NamedType -> Bool
< :: NamedType -> NamedType -> Bool
$c<= :: NamedType -> NamedType -> Bool
<= :: NamedType -> NamedType -> Bool
$c> :: NamedType -> NamedType -> Bool
> :: NamedType -> NamedType -> Bool
$c>= :: NamedType -> NamedType -> Bool
>= :: NamedType -> NamedType -> Bool
$cmax :: NamedType -> NamedType -> NamedType
max :: NamedType -> NamedType -> NamedType
$cmin :: NamedType -> NamedType -> NamedType
min :: NamedType -> NamedType -> NamedType
Ord, Semigroup NamedType
NamedType
Semigroup NamedType =>
NamedType
-> (NamedType -> NamedType -> NamedType)
-> ([NamedType] -> NamedType)
-> Monoid NamedType
[NamedType] -> NamedType
NamedType -> NamedType -> NamedType
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: NamedType
mempty :: NamedType
$cmappend :: NamedType -> NamedType -> NamedType
mappend :: NamedType -> NamedType -> NamedType
$cmconcat :: [NamedType] -> NamedType
mconcat :: [NamedType] -> NamedType
Monoid, NonEmpty NamedType -> NamedType
NamedType -> NamedType -> NamedType
(NamedType -> NamedType -> NamedType)
-> (NonEmpty NamedType -> NamedType)
-> (forall b. Integral b => b -> NamedType -> NamedType)
-> Semigroup NamedType
forall b. Integral b => b -> NamedType -> NamedType
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: NamedType -> NamedType -> NamedType
<> :: NamedType -> NamedType -> NamedType
$csconcat :: NonEmpty NamedType -> NamedType
sconcat :: NonEmpty NamedType -> NamedType
$cstimes :: forall b. Integral b => b -> NamedType -> NamedType
stimes :: forall b. Integral b => b -> NamedType -> NamedType
Semigroup)

namedTypeName :: NamedType -> Name
namedTypeName :: NamedType -> Name
namedTypeName (NamedType Name
name) = Name
name

-- | A GraphQL 'ListType'
-- https://spec.graphql.org/draft/#ListType
newtype ListType = ListType Type
    deriving stock (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
(Int -> ListType -> ShowS)
-> (ListType -> String) -> ([ListType] -> ShowS) -> Show ListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListType -> ShowS
showsPrec :: Int -> ListType -> ShowS
$cshow :: ListType -> String
show :: ListType -> String
$cshowList :: [ListType] -> ShowS
showList :: [ListType] -> ShowS
Show, ListType -> ListType -> Bool
(ListType -> ListType -> Bool)
-> (ListType -> ListType -> Bool) -> Eq ListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
/= :: ListType -> ListType -> Bool
Eq, (forall x. ListType -> Rep ListType x)
-> (forall x. Rep ListType x -> ListType) -> Generic ListType
forall x. Rep ListType x -> ListType
forall x. ListType -> Rep ListType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ListType -> Rep ListType x
from :: forall x. ListType -> Rep ListType x
$cto :: forall x. Rep ListType x -> ListType
to :: forall x. Rep ListType x -> ListType
Generic)

-- | A GraphQL 'NonNullType'
-- https://spec.graphql.org/draft/#NonNullType
data NonNullType
    = NonNullTypeNamed NamedType
    | NonNullTypeList ListType
    deriving stock (Int -> NonNullType -> ShowS
[NonNullType] -> ShowS
NonNullType -> String
(Int -> NonNullType -> ShowS)
-> (NonNullType -> String)
-> ([NonNullType] -> ShowS)
-> Show NonNullType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonNullType -> ShowS
showsPrec :: Int -> NonNullType -> ShowS
$cshow :: NonNullType -> String
show :: NonNullType -> String
$cshowList :: [NonNullType] -> ShowS
showList :: [NonNullType] -> ShowS
Show, NonNullType -> NonNullType -> Bool
(NonNullType -> NonNullType -> Bool)
-> (NonNullType -> NonNullType -> Bool) -> Eq NonNullType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonNullType -> NonNullType -> Bool
== :: NonNullType -> NonNullType -> Bool
$c/= :: NonNullType -> NonNullType -> Bool
/= :: NonNullType -> NonNullType -> Bool
Eq, (forall x. NonNullType -> Rep NonNullType x)
-> (forall x. Rep NonNullType x -> NonNullType)
-> Generic NonNullType
forall x. Rep NonNullType x -> NonNullType
forall x. NonNullType -> Rep NonNullType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NonNullType -> Rep NonNullType x
from :: forall x. NonNullType -> Rep NonNullType x
$cto :: forall x. Rep NonNullType x -> NonNullType
to :: forall x. Rep NonNullType x -> NonNullType
Generic)

-- | The GraphQL 'Directives' type
-- https://spec.graphql.org/draft/#Directives
type Directives = NonEmpty Directive

-- | A GraphQL 'Directive'
-- https://spec.graphql.org/draft/#Directive
data Directive = Directive Name (Maybe Arguments)
    deriving stock (Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
(Int -> Directive -> ShowS)
-> (Directive -> String)
-> ([Directive] -> ShowS)
-> Show Directive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Directive -> ShowS
showsPrec :: Int -> Directive -> ShowS
$cshow :: Directive -> String
show :: Directive -> String
$cshowList :: [Directive] -> ShowS
showList :: [Directive] -> ShowS
Show, Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
/= :: Directive -> Directive -> Bool
Eq, (forall x. Directive -> Rep Directive x)
-> (forall x. Rep Directive x -> Directive) -> Generic Directive
forall x. Rep Directive x -> Directive
forall x. Directive -> Rep Directive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Directive -> Rep Directive x
from :: forall x. Directive -> Rep Directive x
$cto :: forall x. Rep Directive x -> Directive
to :: forall x. Rep Directive x -> Directive
Generic)

-- | A GraphQL 'TypeSystemDefinition'
-- https://spec.graphql.org/draft/#TypeSystemDefinition
data TypeSystemDefinition
    = DefinitionSchema SchemaDefinition
    | DefinitionType TypeDefinition
    | DefinitionDirective DirectiveDefinition
    deriving stock (Int -> TypeSystemDefinition -> ShowS
[TypeSystemDefinition] -> ShowS
TypeSystemDefinition -> String
(Int -> TypeSystemDefinition -> ShowS)
-> (TypeSystemDefinition -> String)
-> ([TypeSystemDefinition] -> ShowS)
-> Show TypeSystemDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeSystemDefinition -> ShowS
showsPrec :: Int -> TypeSystemDefinition -> ShowS
$cshow :: TypeSystemDefinition -> String
show :: TypeSystemDefinition -> String
$cshowList :: [TypeSystemDefinition] -> ShowS
showList :: [TypeSystemDefinition] -> ShowS
Show, TypeSystemDefinition -> TypeSystemDefinition -> Bool
(TypeSystemDefinition -> TypeSystemDefinition -> Bool)
-> (TypeSystemDefinition -> TypeSystemDefinition -> Bool)
-> Eq TypeSystemDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
$c/= :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
/= :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
Eq, (forall x. TypeSystemDefinition -> Rep TypeSystemDefinition x)
-> (forall x. Rep TypeSystemDefinition x -> TypeSystemDefinition)
-> Generic TypeSystemDefinition
forall x. Rep TypeSystemDefinition x -> TypeSystemDefinition
forall x. TypeSystemDefinition -> Rep TypeSystemDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeSystemDefinition -> Rep TypeSystemDefinition x
from :: forall x. TypeSystemDefinition -> Rep TypeSystemDefinition x
$cto :: forall x. Rep TypeSystemDefinition x -> TypeSystemDefinition
to :: forall x. Rep TypeSystemDefinition x -> TypeSystemDefinition
Generic)

-- | A GraphQL 'TypeSystemExtension'
-- https://spec.graphql.org/draft/#TypeSystemExtension
data TypeSystemExtension
    = ExtensionSchema SchemaExtension
    | ExtensionType TypeExtension
    deriving stock (Int -> TypeSystemExtension -> ShowS
[TypeSystemExtension] -> ShowS
TypeSystemExtension -> String
(Int -> TypeSystemExtension -> ShowS)
-> (TypeSystemExtension -> String)
-> ([TypeSystemExtension] -> ShowS)
-> Show TypeSystemExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeSystemExtension -> ShowS
showsPrec :: Int -> TypeSystemExtension -> ShowS
$cshow :: TypeSystemExtension -> String
show :: TypeSystemExtension -> String
$cshowList :: [TypeSystemExtension] -> ShowS
showList :: [TypeSystemExtension] -> ShowS
Show, TypeSystemExtension -> TypeSystemExtension -> Bool
(TypeSystemExtension -> TypeSystemExtension -> Bool)
-> (TypeSystemExtension -> TypeSystemExtension -> Bool)
-> Eq TypeSystemExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeSystemExtension -> TypeSystemExtension -> Bool
== :: TypeSystemExtension -> TypeSystemExtension -> Bool
$c/= :: TypeSystemExtension -> TypeSystemExtension -> Bool
/= :: TypeSystemExtension -> TypeSystemExtension -> Bool
Eq, (forall x. TypeSystemExtension -> Rep TypeSystemExtension x)
-> (forall x. Rep TypeSystemExtension x -> TypeSystemExtension)
-> Generic TypeSystemExtension
forall x. Rep TypeSystemExtension x -> TypeSystemExtension
forall x. TypeSystemExtension -> Rep TypeSystemExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeSystemExtension -> Rep TypeSystemExtension x
from :: forall x. TypeSystemExtension -> Rep TypeSystemExtension x
$cto :: forall x. Rep TypeSystemExtension x -> TypeSystemExtension
to :: forall x. Rep TypeSystemExtension x -> TypeSystemExtension
Generic)

-- | A GraphQL 'SchemaDefinition'
-- https://spec.graphql.org/draft/#SchemaDefinition
data SchemaDefinition
    = SchemaDefinition
        (Maybe Description)
        (Maybe Directives)
        RootOperationTypeDefinitions
    deriving stock (Int -> SchemaDefinition -> ShowS
[SchemaDefinition] -> ShowS
SchemaDefinition -> String
(Int -> SchemaDefinition -> ShowS)
-> (SchemaDefinition -> String)
-> ([SchemaDefinition] -> ShowS)
-> Show SchemaDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaDefinition -> ShowS
showsPrec :: Int -> SchemaDefinition -> ShowS
$cshow :: SchemaDefinition -> String
show :: SchemaDefinition -> String
$cshowList :: [SchemaDefinition] -> ShowS
showList :: [SchemaDefinition] -> ShowS
Show, SchemaDefinition -> SchemaDefinition -> Bool
(SchemaDefinition -> SchemaDefinition -> Bool)
-> (SchemaDefinition -> SchemaDefinition -> Bool)
-> Eq SchemaDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaDefinition -> SchemaDefinition -> Bool
== :: SchemaDefinition -> SchemaDefinition -> Bool
$c/= :: SchemaDefinition -> SchemaDefinition -> Bool
/= :: SchemaDefinition -> SchemaDefinition -> Bool
Eq, (forall x. SchemaDefinition -> Rep SchemaDefinition x)
-> (forall x. Rep SchemaDefinition x -> SchemaDefinition)
-> Generic SchemaDefinition
forall x. Rep SchemaDefinition x -> SchemaDefinition
forall x. SchemaDefinition -> Rep SchemaDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaDefinition -> Rep SchemaDefinition x
from :: forall x. SchemaDefinition -> Rep SchemaDefinition x
$cto :: forall x. Rep SchemaDefinition x -> SchemaDefinition
to :: forall x. Rep SchemaDefinition x -> SchemaDefinition
Generic)

-- | A GraphQL 'SchemaExtension'
-- https://spec.graphql.org/draft/#SchemaExtension
data SchemaExtension
    = SchemaExtension (Maybe Directives) (Maybe RootOperationTypeDefinitions)
    deriving stock (Int -> SchemaExtension -> ShowS
[SchemaExtension] -> ShowS
SchemaExtension -> String
(Int -> SchemaExtension -> ShowS)
-> (SchemaExtension -> String)
-> ([SchemaExtension] -> ShowS)
-> Show SchemaExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaExtension -> ShowS
showsPrec :: Int -> SchemaExtension -> ShowS
$cshow :: SchemaExtension -> String
show :: SchemaExtension -> String
$cshowList :: [SchemaExtension] -> ShowS
showList :: [SchemaExtension] -> ShowS
Show, SchemaExtension -> SchemaExtension -> Bool
(SchemaExtension -> SchemaExtension -> Bool)
-> (SchemaExtension -> SchemaExtension -> Bool)
-> Eq SchemaExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaExtension -> SchemaExtension -> Bool
== :: SchemaExtension -> SchemaExtension -> Bool
$c/= :: SchemaExtension -> SchemaExtension -> Bool
/= :: SchemaExtension -> SchemaExtension -> Bool
Eq, (forall x. SchemaExtension -> Rep SchemaExtension x)
-> (forall x. Rep SchemaExtension x -> SchemaExtension)
-> Generic SchemaExtension
forall x. Rep SchemaExtension x -> SchemaExtension
forall x. SchemaExtension -> Rep SchemaExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaExtension -> Rep SchemaExtension x
from :: forall x. SchemaExtension -> Rep SchemaExtension x
$cto :: forall x. Rep SchemaExtension x -> SchemaExtension
to :: forall x. Rep SchemaExtension x -> SchemaExtension
Generic)

-- | List of 'RootOperationTypeDefinition'
type RootOperationTypeDefinitions = NonEmpty RootOperationTypeDefinition

-- | https://spec.graphql.org/draft/#RootOperationTypeDefinition
data RootOperationTypeDefinition
    = RootOperationTypeDefinition OperationType NamedType
    deriving stock (Int -> RootOperationTypeDefinition -> ShowS
[RootOperationTypeDefinition] -> ShowS
RootOperationTypeDefinition -> String
(Int -> RootOperationTypeDefinition -> ShowS)
-> (RootOperationTypeDefinition -> String)
-> ([RootOperationTypeDefinition] -> ShowS)
-> Show RootOperationTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RootOperationTypeDefinition -> ShowS
showsPrec :: Int -> RootOperationTypeDefinition -> ShowS
$cshow :: RootOperationTypeDefinition -> String
show :: RootOperationTypeDefinition -> String
$cshowList :: [RootOperationTypeDefinition] -> ShowS
showList :: [RootOperationTypeDefinition] -> ShowS
Show, RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
(RootOperationTypeDefinition
 -> RootOperationTypeDefinition -> Bool)
-> (RootOperationTypeDefinition
    -> RootOperationTypeDefinition -> Bool)
-> Eq RootOperationTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
== :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
$c/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
/= :: RootOperationTypeDefinition -> RootOperationTypeDefinition -> Bool
Eq, (forall x.
 RootOperationTypeDefinition -> Rep RootOperationTypeDefinition x)
-> (forall x.
    Rep RootOperationTypeDefinition x -> RootOperationTypeDefinition)
-> Generic RootOperationTypeDefinition
forall x.
Rep RootOperationTypeDefinition x -> RootOperationTypeDefinition
forall x.
RootOperationTypeDefinition -> Rep RootOperationTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RootOperationTypeDefinition -> Rep RootOperationTypeDefinition x
from :: forall x.
RootOperationTypeDefinition -> Rep RootOperationTypeDefinition x
$cto :: forall x.
Rep RootOperationTypeDefinition x -> RootOperationTypeDefinition
to :: forall x.
Rep RootOperationTypeDefinition x -> RootOperationTypeDefinition
Generic)

rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType :: RootOperationTypeDefinition -> OperationType
rootOperationType (RootOperationTypeDefinition OperationType
operationType NamedType
_) = OperationType
operationType

-- | A GraphQL 'Description'
-- https://spec.graphql.org/draft/#Description
newtype Description = Description StringValue
    deriving stock (Int -> Description -> ShowS
[Description] -> ShowS
Description -> String
(Int -> Description -> ShowS)
-> (Description -> String)
-> ([Description] -> ShowS)
-> Show Description
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Description -> ShowS
showsPrec :: Int -> Description -> ShowS
$cshow :: Description -> String
show :: Description -> String
$cshowList :: [Description] -> ShowS
showList :: [Description] -> ShowS
Show, Description -> Description -> Bool
(Description -> Description -> Bool)
-> (Description -> Description -> Bool) -> Eq Description
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
/= :: Description -> Description -> Bool
Eq, (forall x. Description -> Rep Description x)
-> (forall x. Rep Description x -> Description)
-> Generic Description
forall x. Rep Description x -> Description
forall x. Description -> Rep Description x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Description -> Rep Description x
from :: forall x. Description -> Rep Description x
$cto :: forall x. Rep Description x -> Description
to :: forall x. Rep Description x -> Description
Generic)

-- | A GraphQL 'TypeDefinition'
-- https://spec.graphql.org/draft/#TypeDefinition
data TypeDefinition
    = DefinitionScalarType ScalarTypeDefinition
    | DefinitionObjectType ObjectTypeDefinition
    | DefinitionInterfaceType InterfaceTypeDefinition
    | DefinitionUnionType UnionTypeDefinition
    | DefinitionEnumType EnumTypeDefinition
    | DefinitionInputObjectType InputObjectTypeDefinition
    deriving stock (Int -> TypeDefinition -> ShowS
[TypeDefinition] -> ShowS
TypeDefinition -> String
(Int -> TypeDefinition -> ShowS)
-> (TypeDefinition -> String)
-> ([TypeDefinition] -> ShowS)
-> Show TypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDefinition -> ShowS
showsPrec :: Int -> TypeDefinition -> ShowS
$cshow :: TypeDefinition -> String
show :: TypeDefinition -> String
$cshowList :: [TypeDefinition] -> ShowS
showList :: [TypeDefinition] -> ShowS
Show, TypeDefinition -> TypeDefinition -> Bool
(TypeDefinition -> TypeDefinition -> Bool)
-> (TypeDefinition -> TypeDefinition -> Bool) -> Eq TypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
/= :: TypeDefinition -> TypeDefinition -> Bool
Eq, (forall x. TypeDefinition -> Rep TypeDefinition x)
-> (forall x. Rep TypeDefinition x -> TypeDefinition)
-> Generic TypeDefinition
forall x. Rep TypeDefinition x -> TypeDefinition
forall x. TypeDefinition -> Rep TypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeDefinition -> Rep TypeDefinition x
from :: forall x. TypeDefinition -> Rep TypeDefinition x
$cto :: forall x. Rep TypeDefinition x -> TypeDefinition
to :: forall x. Rep TypeDefinition x -> TypeDefinition
Generic)

-- | A GraphQL 'TypeExtension'
-- https://spec.graphql.org/draft/#TypeExtension
data TypeExtension
    = ExtensionScalarType ScalarTypeExtension
    | ExtensionObjectType ObjectTypeExtension
    | ExtensionInterfaceType InterfaceTypeExtension
    | ExtensionUnionType UnionTypeExtension
    | ExtensionEnumType EnumTypeExtension
    | ExtensionInputObjectType InputObjectTypeExtension
    deriving stock (Int -> TypeExtension -> ShowS
[TypeExtension] -> ShowS
TypeExtension -> String
(Int -> TypeExtension -> ShowS)
-> (TypeExtension -> String)
-> ([TypeExtension] -> ShowS)
-> Show TypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeExtension -> ShowS
showsPrec :: Int -> TypeExtension -> ShowS
$cshow :: TypeExtension -> String
show :: TypeExtension -> String
$cshowList :: [TypeExtension] -> ShowS
showList :: [TypeExtension] -> ShowS
Show, TypeExtension -> TypeExtension -> Bool
(TypeExtension -> TypeExtension -> Bool)
-> (TypeExtension -> TypeExtension -> Bool) -> Eq TypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeExtension -> TypeExtension -> Bool
== :: TypeExtension -> TypeExtension -> Bool
$c/= :: TypeExtension -> TypeExtension -> Bool
/= :: TypeExtension -> TypeExtension -> Bool
Eq, (forall x. TypeExtension -> Rep TypeExtension x)
-> (forall x. Rep TypeExtension x -> TypeExtension)
-> Generic TypeExtension
forall x. Rep TypeExtension x -> TypeExtension
forall x. TypeExtension -> Rep TypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeExtension -> Rep TypeExtension x
from :: forall x. TypeExtension -> Rep TypeExtension x
$cto :: forall x. Rep TypeExtension x -> TypeExtension
to :: forall x. Rep TypeExtension x -> TypeExtension
Generic)

-- | A GraphQL 'ScalarTypeDefinition'
-- https://spec.graphql.org/draft/#ScalarTypeDefinition
data ScalarTypeDefinition
    = ScalarTypeDefinition (Maybe Description) Name (Maybe Directives)
    deriving stock (Int -> ScalarTypeDefinition -> ShowS
[ScalarTypeDefinition] -> ShowS
ScalarTypeDefinition -> String
(Int -> ScalarTypeDefinition -> ShowS)
-> (ScalarTypeDefinition -> String)
-> ([ScalarTypeDefinition] -> ShowS)
-> Show ScalarTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarTypeDefinition -> ShowS
showsPrec :: Int -> ScalarTypeDefinition -> ShowS
$cshow :: ScalarTypeDefinition -> String
show :: ScalarTypeDefinition -> String
$cshowList :: [ScalarTypeDefinition] -> ShowS
showList :: [ScalarTypeDefinition] -> ShowS
Show, ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
(ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> Eq ScalarTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
Eq, (forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x)
-> (forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition)
-> Generic ScalarTypeDefinition
forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
from :: forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
$cto :: forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
to :: forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
Generic)

-- | A GraphQL 'ScalarTypeExtension'
-- https://spec.graphql.org/draft/#ScalarTypeExtension
data ScalarTypeExtension = ScalarTypeExtension Name Directives
    deriving stock (Int -> ScalarTypeExtension -> ShowS
[ScalarTypeExtension] -> ShowS
ScalarTypeExtension -> String
(Int -> ScalarTypeExtension -> ShowS)
-> (ScalarTypeExtension -> String)
-> ([ScalarTypeExtension] -> ShowS)
-> Show ScalarTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarTypeExtension -> ShowS
showsPrec :: Int -> ScalarTypeExtension -> ShowS
$cshow :: ScalarTypeExtension -> String
show :: ScalarTypeExtension -> String
$cshowList :: [ScalarTypeExtension] -> ShowS
showList :: [ScalarTypeExtension] -> ShowS
Show, ScalarTypeExtension -> ScalarTypeExtension -> Bool
(ScalarTypeExtension -> ScalarTypeExtension -> Bool)
-> (ScalarTypeExtension -> ScalarTypeExtension -> Bool)
-> Eq ScalarTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarTypeExtension -> ScalarTypeExtension -> Bool
== :: ScalarTypeExtension -> ScalarTypeExtension -> Bool
$c/= :: ScalarTypeExtension -> ScalarTypeExtension -> Bool
/= :: ScalarTypeExtension -> ScalarTypeExtension -> Bool
Eq, (forall x. ScalarTypeExtension -> Rep ScalarTypeExtension x)
-> (forall x. Rep ScalarTypeExtension x -> ScalarTypeExtension)
-> Generic ScalarTypeExtension
forall x. Rep ScalarTypeExtension x -> ScalarTypeExtension
forall x. ScalarTypeExtension -> Rep ScalarTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScalarTypeExtension -> Rep ScalarTypeExtension x
from :: forall x. ScalarTypeExtension -> Rep ScalarTypeExtension x
$cto :: forall x. Rep ScalarTypeExtension x -> ScalarTypeExtension
to :: forall x. Rep ScalarTypeExtension x -> ScalarTypeExtension
Generic)

-- | A GraphQL 'ObjectTypeDefinition'
-- https://spec.graphql.org/draft/#ObjectTypeDefinition
data ObjectTypeDefinition
    = ObjectTypeDefinition
        (Maybe Description)
        Name
        (Maybe ImplementsInterfaces)
        (Maybe Directives)
        (Maybe FieldsDefinition)
    deriving stock (Int -> ObjectTypeDefinition -> ShowS
[ObjectTypeDefinition] -> ShowS
ObjectTypeDefinition -> String
(Int -> ObjectTypeDefinition -> ShowS)
-> (ObjectTypeDefinition -> String)
-> ([ObjectTypeDefinition] -> ShowS)
-> Show ObjectTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectTypeDefinition -> ShowS
showsPrec :: Int -> ObjectTypeDefinition -> ShowS
$cshow :: ObjectTypeDefinition -> String
show :: ObjectTypeDefinition -> String
$cshowList :: [ObjectTypeDefinition] -> ShowS
showList :: [ObjectTypeDefinition] -> ShowS
Show, ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
(ObjectTypeDefinition -> ObjectTypeDefinition -> Bool)
-> (ObjectTypeDefinition -> ObjectTypeDefinition -> Bool)
-> Eq ObjectTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
== :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
$c/= :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
/= :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
Eq, (forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x)
-> (forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition)
-> Generic ObjectTypeDefinition
forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
from :: forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
$cto :: forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
to :: forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
Generic)

-- | A GraphQL 'ObjectTypeExtension'
-- https://spec.graphql.org/draft/#ObjectTypeExtension
data ObjectTypeExtension
    = ObjectTypeExtension
        Name
        (Maybe ImplementsInterfaces)
        (Maybe Directives)
        (Maybe FieldsDefinition)
    deriving stock (Int -> ObjectTypeExtension -> ShowS
[ObjectTypeExtension] -> ShowS
ObjectTypeExtension -> String
(Int -> ObjectTypeExtension -> ShowS)
-> (ObjectTypeExtension -> String)
-> ([ObjectTypeExtension] -> ShowS)
-> Show ObjectTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectTypeExtension -> ShowS
showsPrec :: Int -> ObjectTypeExtension -> ShowS
$cshow :: ObjectTypeExtension -> String
show :: ObjectTypeExtension -> String
$cshowList :: [ObjectTypeExtension] -> ShowS
showList :: [ObjectTypeExtension] -> ShowS
Show, ObjectTypeExtension -> ObjectTypeExtension -> Bool
(ObjectTypeExtension -> ObjectTypeExtension -> Bool)
-> (ObjectTypeExtension -> ObjectTypeExtension -> Bool)
-> Eq ObjectTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectTypeExtension -> ObjectTypeExtension -> Bool
== :: ObjectTypeExtension -> ObjectTypeExtension -> Bool
$c/= :: ObjectTypeExtension -> ObjectTypeExtension -> Bool
/= :: ObjectTypeExtension -> ObjectTypeExtension -> Bool
Eq, (forall x. ObjectTypeExtension -> Rep ObjectTypeExtension x)
-> (forall x. Rep ObjectTypeExtension x -> ObjectTypeExtension)
-> Generic ObjectTypeExtension
forall x. Rep ObjectTypeExtension x -> ObjectTypeExtension
forall x. ObjectTypeExtension -> Rep ObjectTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectTypeExtension -> Rep ObjectTypeExtension x
from :: forall x. ObjectTypeExtension -> Rep ObjectTypeExtension x
$cto :: forall x. Rep ObjectTypeExtension x -> ObjectTypeExtension
to :: forall x. Rep ObjectTypeExtension x -> ObjectTypeExtension
Generic)

-- | A GraphQL 'ImplementsInterfaces'
-- https://spec.graphql.org/draft/#ImplementsInterfaces
newtype ImplementsInterfaces = ImplementsInterfaces (NonEmpty NamedType)
    deriving stock ((forall x. ImplementsInterfaces -> Rep ImplementsInterfaces x)
-> (forall x. Rep ImplementsInterfaces x -> ImplementsInterfaces)
-> Generic ImplementsInterfaces
forall x. Rep ImplementsInterfaces x -> ImplementsInterfaces
forall x. ImplementsInterfaces -> Rep ImplementsInterfaces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ImplementsInterfaces -> Rep ImplementsInterfaces x
from :: forall x. ImplementsInterfaces -> Rep ImplementsInterfaces x
$cto :: forall x. Rep ImplementsInterfaces x -> ImplementsInterfaces
to :: forall x. Rep ImplementsInterfaces x -> ImplementsInterfaces
Generic)
    deriving newtype (Int -> ImplementsInterfaces -> ShowS
[ImplementsInterfaces] -> ShowS
ImplementsInterfaces -> String
(Int -> ImplementsInterfaces -> ShowS)
-> (ImplementsInterfaces -> String)
-> ([ImplementsInterfaces] -> ShowS)
-> Show ImplementsInterfaces
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImplementsInterfaces -> ShowS
showsPrec :: Int -> ImplementsInterfaces -> ShowS
$cshow :: ImplementsInterfaces -> String
show :: ImplementsInterfaces -> String
$cshowList :: [ImplementsInterfaces] -> ShowS
showList :: [ImplementsInterfaces] -> ShowS
Show, ImplementsInterfaces -> ImplementsInterfaces -> Bool
(ImplementsInterfaces -> ImplementsInterfaces -> Bool)
-> (ImplementsInterfaces -> ImplementsInterfaces -> Bool)
-> Eq ImplementsInterfaces
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImplementsInterfaces -> ImplementsInterfaces -> Bool
== :: ImplementsInterfaces -> ImplementsInterfaces -> Bool
$c/= :: ImplementsInterfaces -> ImplementsInterfaces -> Bool
/= :: ImplementsInterfaces -> ImplementsInterfaces -> Bool
Eq, NonEmpty ImplementsInterfaces -> ImplementsInterfaces
ImplementsInterfaces
-> ImplementsInterfaces -> ImplementsInterfaces
(ImplementsInterfaces
 -> ImplementsInterfaces -> ImplementsInterfaces)
-> (NonEmpty ImplementsInterfaces -> ImplementsInterfaces)
-> (forall b.
    Integral b =>
    b -> ImplementsInterfaces -> ImplementsInterfaces)
-> Semigroup ImplementsInterfaces
forall b.
Integral b =>
b -> ImplementsInterfaces -> ImplementsInterfaces
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ImplementsInterfaces
-> ImplementsInterfaces -> ImplementsInterfaces
<> :: ImplementsInterfaces
-> ImplementsInterfaces -> ImplementsInterfaces
$csconcat :: NonEmpty ImplementsInterfaces -> ImplementsInterfaces
sconcat :: NonEmpty ImplementsInterfaces -> ImplementsInterfaces
$cstimes :: forall b.
Integral b =>
b -> ImplementsInterfaces -> ImplementsInterfaces
stimes :: forall b.
Integral b =>
b -> ImplementsInterfaces -> ImplementsInterfaces
Semigroup)

-- | A GraphQL 'FieldsDefinition'
-- https://spec.graphql.org/draft/#FieldsDefinitionn
newtype FieldsDefinition = FieldsDefinition (NonEmpty FieldDefinition)
    deriving stock ((forall x. FieldsDefinition -> Rep FieldsDefinition x)
-> (forall x. Rep FieldsDefinition x -> FieldsDefinition)
-> Generic FieldsDefinition
forall x. Rep FieldsDefinition x -> FieldsDefinition
forall x. FieldsDefinition -> Rep FieldsDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldsDefinition -> Rep FieldsDefinition x
from :: forall x. FieldsDefinition -> Rep FieldsDefinition x
$cto :: forall x. Rep FieldsDefinition x -> FieldsDefinition
to :: forall x. Rep FieldsDefinition x -> FieldsDefinition
Generic)
    deriving newtype (Int -> FieldsDefinition -> ShowS
[FieldsDefinition] -> ShowS
FieldsDefinition -> String
(Int -> FieldsDefinition -> ShowS)
-> (FieldsDefinition -> String)
-> ([FieldsDefinition] -> ShowS)
-> Show FieldsDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldsDefinition -> ShowS
showsPrec :: Int -> FieldsDefinition -> ShowS
$cshow :: FieldsDefinition -> String
show :: FieldsDefinition -> String
$cshowList :: [FieldsDefinition] -> ShowS
showList :: [FieldsDefinition] -> ShowS
Show, FieldsDefinition -> FieldsDefinition -> Bool
(FieldsDefinition -> FieldsDefinition -> Bool)
-> (FieldsDefinition -> FieldsDefinition -> Bool)
-> Eq FieldsDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldsDefinition -> FieldsDefinition -> Bool
== :: FieldsDefinition -> FieldsDefinition -> Bool
$c/= :: FieldsDefinition -> FieldsDefinition -> Bool
/= :: FieldsDefinition -> FieldsDefinition -> Bool
Eq, NonEmpty FieldsDefinition -> FieldsDefinition
FieldsDefinition -> FieldsDefinition -> FieldsDefinition
(FieldsDefinition -> FieldsDefinition -> FieldsDefinition)
-> (NonEmpty FieldsDefinition -> FieldsDefinition)
-> (forall b.
    Integral b =>
    b -> FieldsDefinition -> FieldsDefinition)
-> Semigroup FieldsDefinition
forall b. Integral b => b -> FieldsDefinition -> FieldsDefinition
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: FieldsDefinition -> FieldsDefinition -> FieldsDefinition
<> :: FieldsDefinition -> FieldsDefinition -> FieldsDefinition
$csconcat :: NonEmpty FieldsDefinition -> FieldsDefinition
sconcat :: NonEmpty FieldsDefinition -> FieldsDefinition
$cstimes :: forall b. Integral b => b -> FieldsDefinition -> FieldsDefinition
stimes :: forall b. Integral b => b -> FieldsDefinition -> FieldsDefinition
Semigroup)

-- | A GraphQL 'FieldDefinition'
-- https://spec.graphql.org/draft/#FieldDefinition
data FieldDefinition
    = FieldDefinition
        (Maybe Description)
        Name
        (Maybe ArgumentsDefinition)
        Type
        (Maybe Directives)
    deriving stock (Int -> FieldDefinition -> ShowS
[FieldDefinition] -> ShowS
FieldDefinition -> String
(Int -> FieldDefinition -> ShowS)
-> (FieldDefinition -> String)
-> ([FieldDefinition] -> ShowS)
-> Show FieldDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldDefinition -> ShowS
showsPrec :: Int -> FieldDefinition -> ShowS
$cshow :: FieldDefinition -> String
show :: FieldDefinition -> String
$cshowList :: [FieldDefinition] -> ShowS
showList :: [FieldDefinition] -> ShowS
Show, FieldDefinition -> FieldDefinition -> Bool
(FieldDefinition -> FieldDefinition -> Bool)
-> (FieldDefinition -> FieldDefinition -> Bool)
-> Eq FieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldDefinition -> FieldDefinition -> Bool
== :: FieldDefinition -> FieldDefinition -> Bool
$c/= :: FieldDefinition -> FieldDefinition -> Bool
/= :: FieldDefinition -> FieldDefinition -> Bool
Eq, (forall x. FieldDefinition -> Rep FieldDefinition x)
-> (forall x. Rep FieldDefinition x -> FieldDefinition)
-> Generic FieldDefinition
forall x. Rep FieldDefinition x -> FieldDefinition
forall x. FieldDefinition -> Rep FieldDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldDefinition -> Rep FieldDefinition x
from :: forall x. FieldDefinition -> Rep FieldDefinition x
$cto :: forall x. Rep FieldDefinition x -> FieldDefinition
to :: forall x. Rep FieldDefinition x -> FieldDefinition
Generic)

fieldDefinitionName :: FieldDefinition -> Name
fieldDefinitionName :: FieldDefinition -> Name
fieldDefinitionName (FieldDefinition Maybe Description
_ Name
name Maybe ArgumentsDefinition
_ Type
_ Maybe Directives
_) = Name
name

-- | https://spec.graphql.org/draft/#ArgumentsDefinition
newtype ArgumentsDefinition = ArgumentsDefinition (NonEmpty InputValueDefinition)
    deriving stock ((forall x. ArgumentsDefinition -> Rep ArgumentsDefinition x)
-> (forall x. Rep ArgumentsDefinition x -> ArgumentsDefinition)
-> Generic ArgumentsDefinition
forall x. Rep ArgumentsDefinition x -> ArgumentsDefinition
forall x. ArgumentsDefinition -> Rep ArgumentsDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ArgumentsDefinition -> Rep ArgumentsDefinition x
from :: forall x. ArgumentsDefinition -> Rep ArgumentsDefinition x
$cto :: forall x. Rep ArgumentsDefinition x -> ArgumentsDefinition
to :: forall x. Rep ArgumentsDefinition x -> ArgumentsDefinition
Generic)
    deriving newtype (Int -> ArgumentsDefinition -> ShowS
[ArgumentsDefinition] -> ShowS
ArgumentsDefinition -> String
(Int -> ArgumentsDefinition -> ShowS)
-> (ArgumentsDefinition -> String)
-> ([ArgumentsDefinition] -> ShowS)
-> Show ArgumentsDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArgumentsDefinition -> ShowS
showsPrec :: Int -> ArgumentsDefinition -> ShowS
$cshow :: ArgumentsDefinition -> String
show :: ArgumentsDefinition -> String
$cshowList :: [ArgumentsDefinition] -> ShowS
showList :: [ArgumentsDefinition] -> ShowS
Show, ArgumentsDefinition -> ArgumentsDefinition -> Bool
(ArgumentsDefinition -> ArgumentsDefinition -> Bool)
-> (ArgumentsDefinition -> ArgumentsDefinition -> Bool)
-> Eq ArgumentsDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
$c/= :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
/= :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
Eq, NonEmpty ArgumentsDefinition -> ArgumentsDefinition
ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition
(ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition)
-> (NonEmpty ArgumentsDefinition -> ArgumentsDefinition)
-> (forall b.
    Integral b =>
    b -> ArgumentsDefinition -> ArgumentsDefinition)
-> Semigroup ArgumentsDefinition
forall b.
Integral b =>
b -> ArgumentsDefinition -> ArgumentsDefinition
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition
<> :: ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition
$csconcat :: NonEmpty ArgumentsDefinition -> ArgumentsDefinition
sconcat :: NonEmpty ArgumentsDefinition -> ArgumentsDefinition
$cstimes :: forall b.
Integral b =>
b -> ArgumentsDefinition -> ArgumentsDefinition
stimes :: forall b.
Integral b =>
b -> ArgumentsDefinition -> ArgumentsDefinition
Semigroup)

-- | https://spec.graphql.org/draft/#InputValueDefinition
data InputValueDefinition
    = InputValueDefinition
        (Maybe Description)
        Name
        Type
        (Maybe DefaultValue)
        (Maybe Directives)
    deriving stock (Int -> InputValueDefinition -> ShowS
[InputValueDefinition] -> ShowS
InputValueDefinition -> String
(Int -> InputValueDefinition -> ShowS)
-> (InputValueDefinition -> String)
-> ([InputValueDefinition] -> ShowS)
-> Show InputValueDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputValueDefinition -> ShowS
showsPrec :: Int -> InputValueDefinition -> ShowS
$cshow :: InputValueDefinition -> String
show :: InputValueDefinition -> String
$cshowList :: [InputValueDefinition] -> ShowS
showList :: [InputValueDefinition] -> ShowS
Show, InputValueDefinition -> InputValueDefinition -> Bool
(InputValueDefinition -> InputValueDefinition -> Bool)
-> (InputValueDefinition -> InputValueDefinition -> Bool)
-> Eq InputValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputValueDefinition -> InputValueDefinition -> Bool
== :: InputValueDefinition -> InputValueDefinition -> Bool
$c/= :: InputValueDefinition -> InputValueDefinition -> Bool
/= :: InputValueDefinition -> InputValueDefinition -> Bool
Eq, (forall x. InputValueDefinition -> Rep InputValueDefinition x)
-> (forall x. Rep InputValueDefinition x -> InputValueDefinition)
-> Generic InputValueDefinition
forall x. Rep InputValueDefinition x -> InputValueDefinition
forall x. InputValueDefinition -> Rep InputValueDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputValueDefinition -> Rep InputValueDefinition x
from :: forall x. InputValueDefinition -> Rep InputValueDefinition x
$cto :: forall x. Rep InputValueDefinition x -> InputValueDefinition
to :: forall x. Rep InputValueDefinition x -> InputValueDefinition
Generic)

inputValueDefinitionName :: InputValueDefinition -> Name
inputValueDefinitionName :: InputValueDefinition -> Name
inputValueDefinitionName (InputValueDefinition Maybe Description
_ Name
name Type
_ Maybe DefaultValue
_ Maybe Directives
_) = Name
name

-- | https://spec.graphql.org/draft/#InterfaceTypeDefinition
data InterfaceTypeDefinition
    = InterfaceTypeDefinition
        (Maybe Description)
        Name
        (Maybe ImplementsInterfaces)
        (Maybe Directives)
        (Maybe FieldsDefinition)
    deriving stock (Int -> InterfaceTypeDefinition -> ShowS
[InterfaceTypeDefinition] -> ShowS
InterfaceTypeDefinition -> String
(Int -> InterfaceTypeDefinition -> ShowS)
-> (InterfaceTypeDefinition -> String)
-> ([InterfaceTypeDefinition] -> ShowS)
-> Show InterfaceTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InterfaceTypeDefinition -> ShowS
showsPrec :: Int -> InterfaceTypeDefinition -> ShowS
$cshow :: InterfaceTypeDefinition -> String
show :: InterfaceTypeDefinition -> String
$cshowList :: [InterfaceTypeDefinition] -> ShowS
showList :: [InterfaceTypeDefinition] -> ShowS
Show, InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool
(InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool)
-> (InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool)
-> Eq InterfaceTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool
== :: InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool
$c/= :: InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool
/= :: InterfaceTypeDefinition -> InterfaceTypeDefinition -> Bool
Eq, (forall x.
 InterfaceTypeDefinition -> Rep InterfaceTypeDefinition x)
-> (forall x.
    Rep InterfaceTypeDefinition x -> InterfaceTypeDefinition)
-> Generic InterfaceTypeDefinition
forall x. Rep InterfaceTypeDefinition x -> InterfaceTypeDefinition
forall x. InterfaceTypeDefinition -> Rep InterfaceTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InterfaceTypeDefinition -> Rep InterfaceTypeDefinition x
from :: forall x. InterfaceTypeDefinition -> Rep InterfaceTypeDefinition x
$cto :: forall x. Rep InterfaceTypeDefinition x -> InterfaceTypeDefinition
to :: forall x. Rep InterfaceTypeDefinition x -> InterfaceTypeDefinition
Generic)

-- | https://spec.graphql.org/draft/#InterfaceTypeExtension
data InterfaceTypeExtension
    = InterfaceTypeExtension
        Name
        (Maybe ImplementsInterfaces)
        (Maybe Directives)
        (Maybe FieldsDefinition)
    deriving stock (Int -> InterfaceTypeExtension -> ShowS
[InterfaceTypeExtension] -> ShowS
InterfaceTypeExtension -> String
(Int -> InterfaceTypeExtension -> ShowS)
-> (InterfaceTypeExtension -> String)
-> ([InterfaceTypeExtension] -> ShowS)
-> Show InterfaceTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InterfaceTypeExtension -> ShowS
showsPrec :: Int -> InterfaceTypeExtension -> ShowS
$cshow :: InterfaceTypeExtension -> String
show :: InterfaceTypeExtension -> String
$cshowList :: [InterfaceTypeExtension] -> ShowS
showList :: [InterfaceTypeExtension] -> ShowS
Show, InterfaceTypeExtension -> InterfaceTypeExtension -> Bool
(InterfaceTypeExtension -> InterfaceTypeExtension -> Bool)
-> (InterfaceTypeExtension -> InterfaceTypeExtension -> Bool)
-> Eq InterfaceTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InterfaceTypeExtension -> InterfaceTypeExtension -> Bool
== :: InterfaceTypeExtension -> InterfaceTypeExtension -> Bool
$c/= :: InterfaceTypeExtension -> InterfaceTypeExtension -> Bool
/= :: InterfaceTypeExtension -> InterfaceTypeExtension -> Bool
Eq, (forall x. InterfaceTypeExtension -> Rep InterfaceTypeExtension x)
-> (forall x.
    Rep InterfaceTypeExtension x -> InterfaceTypeExtension)
-> Generic InterfaceTypeExtension
forall x. Rep InterfaceTypeExtension x -> InterfaceTypeExtension
forall x. InterfaceTypeExtension -> Rep InterfaceTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InterfaceTypeExtension -> Rep InterfaceTypeExtension x
from :: forall x. InterfaceTypeExtension -> Rep InterfaceTypeExtension x
$cto :: forall x. Rep InterfaceTypeExtension x -> InterfaceTypeExtension
to :: forall x. Rep InterfaceTypeExtension x -> InterfaceTypeExtension
Generic)

-- | https://spec.graphql.org/draft/#UnionTypeDefinition
data UnionTypeDefinition
    = UnionTypeDefinition
        (Maybe Description)
        Name
        (Maybe Directives)
        (Maybe UnionMemberTypes)
    deriving stock (Int -> UnionTypeDefinition -> ShowS
[UnionTypeDefinition] -> ShowS
UnionTypeDefinition -> String
(Int -> UnionTypeDefinition -> ShowS)
-> (UnionTypeDefinition -> String)
-> ([UnionTypeDefinition] -> ShowS)
-> Show UnionTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionTypeDefinition -> ShowS
showsPrec :: Int -> UnionTypeDefinition -> ShowS
$cshow :: UnionTypeDefinition -> String
show :: UnionTypeDefinition -> String
$cshowList :: [UnionTypeDefinition] -> ShowS
showList :: [UnionTypeDefinition] -> ShowS
Show, UnionTypeDefinition -> UnionTypeDefinition -> Bool
(UnionTypeDefinition -> UnionTypeDefinition -> Bool)
-> (UnionTypeDefinition -> UnionTypeDefinition -> Bool)
-> Eq UnionTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionTypeDefinition -> UnionTypeDefinition -> Bool
== :: UnionTypeDefinition -> UnionTypeDefinition -> Bool
$c/= :: UnionTypeDefinition -> UnionTypeDefinition -> Bool
/= :: UnionTypeDefinition -> UnionTypeDefinition -> Bool
Eq, (forall x. UnionTypeDefinition -> Rep UnionTypeDefinition x)
-> (forall x. Rep UnionTypeDefinition x -> UnionTypeDefinition)
-> Generic UnionTypeDefinition
forall x. Rep UnionTypeDefinition x -> UnionTypeDefinition
forall x. UnionTypeDefinition -> Rep UnionTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnionTypeDefinition -> Rep UnionTypeDefinition x
from :: forall x. UnionTypeDefinition -> Rep UnionTypeDefinition x
$cto :: forall x. Rep UnionTypeDefinition x -> UnionTypeDefinition
to :: forall x. Rep UnionTypeDefinition x -> UnionTypeDefinition
Generic)

-- | https://spec.graphql.org/draft/#UnionMemberTypes
newtype UnionMemberTypes = UnionMemberTypes (NonEmpty NamedType)
    deriving stock ((forall x. UnionMemberTypes -> Rep UnionMemberTypes x)
-> (forall x. Rep UnionMemberTypes x -> UnionMemberTypes)
-> Generic UnionMemberTypes
forall x. Rep UnionMemberTypes x -> UnionMemberTypes
forall x. UnionMemberTypes -> Rep UnionMemberTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnionMemberTypes -> Rep UnionMemberTypes x
from :: forall x. UnionMemberTypes -> Rep UnionMemberTypes x
$cto :: forall x. Rep UnionMemberTypes x -> UnionMemberTypes
to :: forall x. Rep UnionMemberTypes x -> UnionMemberTypes
Generic)
    deriving newtype (Int -> UnionMemberTypes -> ShowS
[UnionMemberTypes] -> ShowS
UnionMemberTypes -> String
(Int -> UnionMemberTypes -> ShowS)
-> (UnionMemberTypes -> String)
-> ([UnionMemberTypes] -> ShowS)
-> Show UnionMemberTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionMemberTypes -> ShowS
showsPrec :: Int -> UnionMemberTypes -> ShowS
$cshow :: UnionMemberTypes -> String
show :: UnionMemberTypes -> String
$cshowList :: [UnionMemberTypes] -> ShowS
showList :: [UnionMemberTypes] -> ShowS
Show, UnionMemberTypes -> UnionMemberTypes -> Bool
(UnionMemberTypes -> UnionMemberTypes -> Bool)
-> (UnionMemberTypes -> UnionMemberTypes -> Bool)
-> Eq UnionMemberTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionMemberTypes -> UnionMemberTypes -> Bool
== :: UnionMemberTypes -> UnionMemberTypes -> Bool
$c/= :: UnionMemberTypes -> UnionMemberTypes -> Bool
/= :: UnionMemberTypes -> UnionMemberTypes -> Bool
Eq, NonEmpty UnionMemberTypes -> UnionMemberTypes
UnionMemberTypes -> UnionMemberTypes -> UnionMemberTypes
(UnionMemberTypes -> UnionMemberTypes -> UnionMemberTypes)
-> (NonEmpty UnionMemberTypes -> UnionMemberTypes)
-> (forall b.
    Integral b =>
    b -> UnionMemberTypes -> UnionMemberTypes)
-> Semigroup UnionMemberTypes
forall b. Integral b => b -> UnionMemberTypes -> UnionMemberTypes
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: UnionMemberTypes -> UnionMemberTypes -> UnionMemberTypes
<> :: UnionMemberTypes -> UnionMemberTypes -> UnionMemberTypes
$csconcat :: NonEmpty UnionMemberTypes -> UnionMemberTypes
sconcat :: NonEmpty UnionMemberTypes -> UnionMemberTypes
$cstimes :: forall b. Integral b => b -> UnionMemberTypes -> UnionMemberTypes
stimes :: forall b. Integral b => b -> UnionMemberTypes -> UnionMemberTypes
Semigroup)

-- | https://spec.graphql.org/draft/#UnionTypeExtension
data UnionTypeExtension
    = UnionTypeExtension Name (Maybe Directives) (Maybe UnionMemberTypes)
    deriving stock (Int -> UnionTypeExtension -> ShowS
[UnionTypeExtension] -> ShowS
UnionTypeExtension -> String
(Int -> UnionTypeExtension -> ShowS)
-> (UnionTypeExtension -> String)
-> ([UnionTypeExtension] -> ShowS)
-> Show UnionTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnionTypeExtension -> ShowS
showsPrec :: Int -> UnionTypeExtension -> ShowS
$cshow :: UnionTypeExtension -> String
show :: UnionTypeExtension -> String
$cshowList :: [UnionTypeExtension] -> ShowS
showList :: [UnionTypeExtension] -> ShowS
Show, UnionTypeExtension -> UnionTypeExtension -> Bool
(UnionTypeExtension -> UnionTypeExtension -> Bool)
-> (UnionTypeExtension -> UnionTypeExtension -> Bool)
-> Eq UnionTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnionTypeExtension -> UnionTypeExtension -> Bool
== :: UnionTypeExtension -> UnionTypeExtension -> Bool
$c/= :: UnionTypeExtension -> UnionTypeExtension -> Bool
/= :: UnionTypeExtension -> UnionTypeExtension -> Bool
Eq, (forall x. UnionTypeExtension -> Rep UnionTypeExtension x)
-> (forall x. Rep UnionTypeExtension x -> UnionTypeExtension)
-> Generic UnionTypeExtension
forall x. Rep UnionTypeExtension x -> UnionTypeExtension
forall x. UnionTypeExtension -> Rep UnionTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnionTypeExtension -> Rep UnionTypeExtension x
from :: forall x. UnionTypeExtension -> Rep UnionTypeExtension x
$cto :: forall x. Rep UnionTypeExtension x -> UnionTypeExtension
to :: forall x. Rep UnionTypeExtension x -> UnionTypeExtension
Generic)

-- | https://spec.graphql.org/draft/#EnumTypeDefinition
data EnumTypeDefinition
    = EnumTypeDefinition
        (Maybe Description)
        Name
        (Maybe Directives)
        (Maybe EnumValuesDefinition)
    deriving stock (Int -> EnumTypeDefinition -> ShowS
[EnumTypeDefinition] -> ShowS
EnumTypeDefinition -> String
(Int -> EnumTypeDefinition -> ShowS)
-> (EnumTypeDefinition -> String)
-> ([EnumTypeDefinition] -> ShowS)
-> Show EnumTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumTypeDefinition -> ShowS
showsPrec :: Int -> EnumTypeDefinition -> ShowS
$cshow :: EnumTypeDefinition -> String
show :: EnumTypeDefinition -> String
$cshowList :: [EnumTypeDefinition] -> ShowS
showList :: [EnumTypeDefinition] -> ShowS
Show, EnumTypeDefinition -> EnumTypeDefinition -> Bool
(EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> Eq EnumTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
== :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$c/= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
/= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
Eq, (forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x)
-> (forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition)
-> Generic EnumTypeDefinition
forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
from :: forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
$cto :: forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
to :: forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
Generic)

-- | https://spec.graphql.org/draft/#EnumValuesDefinition
newtype EnumValuesDefinition = EnumValuesDefinition (NonEmpty EnumValueDefinition)
    deriving stock ((forall x. EnumValuesDefinition -> Rep EnumValuesDefinition x)
-> (forall x. Rep EnumValuesDefinition x -> EnumValuesDefinition)
-> Generic EnumValuesDefinition
forall x. Rep EnumValuesDefinition x -> EnumValuesDefinition
forall x. EnumValuesDefinition -> Rep EnumValuesDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValuesDefinition -> Rep EnumValuesDefinition x
from :: forall x. EnumValuesDefinition -> Rep EnumValuesDefinition x
$cto :: forall x. Rep EnumValuesDefinition x -> EnumValuesDefinition
to :: forall x. Rep EnumValuesDefinition x -> EnumValuesDefinition
Generic)
    deriving newtype (Int -> EnumValuesDefinition -> ShowS
[EnumValuesDefinition] -> ShowS
EnumValuesDefinition -> String
(Int -> EnumValuesDefinition -> ShowS)
-> (EnumValuesDefinition -> String)
-> ([EnumValuesDefinition] -> ShowS)
-> Show EnumValuesDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValuesDefinition -> ShowS
showsPrec :: Int -> EnumValuesDefinition -> ShowS
$cshow :: EnumValuesDefinition -> String
show :: EnumValuesDefinition -> String
$cshowList :: [EnumValuesDefinition] -> ShowS
showList :: [EnumValuesDefinition] -> ShowS
Show, EnumValuesDefinition -> EnumValuesDefinition -> Bool
(EnumValuesDefinition -> EnumValuesDefinition -> Bool)
-> (EnumValuesDefinition -> EnumValuesDefinition -> Bool)
-> Eq EnumValuesDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValuesDefinition -> EnumValuesDefinition -> Bool
== :: EnumValuesDefinition -> EnumValuesDefinition -> Bool
$c/= :: EnumValuesDefinition -> EnumValuesDefinition -> Bool
/= :: EnumValuesDefinition -> EnumValuesDefinition -> Bool
Eq, NonEmpty EnumValuesDefinition -> EnumValuesDefinition
EnumValuesDefinition
-> EnumValuesDefinition -> EnumValuesDefinition
(EnumValuesDefinition
 -> EnumValuesDefinition -> EnumValuesDefinition)
-> (NonEmpty EnumValuesDefinition -> EnumValuesDefinition)
-> (forall b.
    Integral b =>
    b -> EnumValuesDefinition -> EnumValuesDefinition)
-> Semigroup EnumValuesDefinition
forall b.
Integral b =>
b -> EnumValuesDefinition -> EnumValuesDefinition
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: EnumValuesDefinition
-> EnumValuesDefinition -> EnumValuesDefinition
<> :: EnumValuesDefinition
-> EnumValuesDefinition -> EnumValuesDefinition
$csconcat :: NonEmpty EnumValuesDefinition -> EnumValuesDefinition
sconcat :: NonEmpty EnumValuesDefinition -> EnumValuesDefinition
$cstimes :: forall b.
Integral b =>
b -> EnumValuesDefinition -> EnumValuesDefinition
stimes :: forall b.
Integral b =>
b -> EnumValuesDefinition -> EnumValuesDefinition
Semigroup)

-- | https://spec.graphql.org/draft/#EnumValueDefinition
data EnumValueDefinition
    = EnumValueDefinition (Maybe Description) EnumValue (Maybe Directives)
    deriving stock (Int -> EnumValueDefinition -> ShowS
[EnumValueDefinition] -> ShowS
EnumValueDefinition -> String
(Int -> EnumValueDefinition -> ShowS)
-> (EnumValueDefinition -> String)
-> ([EnumValueDefinition] -> ShowS)
-> Show EnumValueDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValueDefinition -> ShowS
showsPrec :: Int -> EnumValueDefinition -> ShowS
$cshow :: EnumValueDefinition -> String
show :: EnumValueDefinition -> String
$cshowList :: [EnumValueDefinition] -> ShowS
showList :: [EnumValueDefinition] -> ShowS
Show, EnumValueDefinition -> EnumValueDefinition -> Bool
(EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> Eq EnumValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValueDefinition -> EnumValueDefinition -> Bool
== :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
Eq, (forall x. EnumValueDefinition -> Rep EnumValueDefinition x)
-> (forall x. Rep EnumValueDefinition x -> EnumValueDefinition)
-> Generic EnumValueDefinition
forall x. Rep EnumValueDefinition x -> EnumValueDefinition
forall x. EnumValueDefinition -> Rep EnumValueDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValueDefinition -> Rep EnumValueDefinition x
from :: forall x. EnumValueDefinition -> Rep EnumValueDefinition x
$cto :: forall x. Rep EnumValueDefinition x -> EnumValueDefinition
to :: forall x. Rep EnumValueDefinition x -> EnumValueDefinition
Generic)

enumValueDefinitionName :: EnumValueDefinition -> Name
enumValueDefinitionName :: EnumValueDefinition -> Name
enumValueDefinitionName (EnumValueDefinition Maybe Description
_ EnumValue
value Maybe Directives
_) = EnumValue -> Name
enumValueName EnumValue
value

-- | https://spec.graphql.org/draft/#EnumTypeExtension
data EnumTypeExtension
    = EnumTypeExtension Name (Maybe Directives) (Maybe EnumValuesDefinition)
    deriving stock (Int -> EnumTypeExtension -> ShowS
[EnumTypeExtension] -> ShowS
EnumTypeExtension -> String
(Int -> EnumTypeExtension -> ShowS)
-> (EnumTypeExtension -> String)
-> ([EnumTypeExtension] -> ShowS)
-> Show EnumTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumTypeExtension -> ShowS
showsPrec :: Int -> EnumTypeExtension -> ShowS
$cshow :: EnumTypeExtension -> String
show :: EnumTypeExtension -> String
$cshowList :: [EnumTypeExtension] -> ShowS
showList :: [EnumTypeExtension] -> ShowS
Show, EnumTypeExtension -> EnumTypeExtension -> Bool
(EnumTypeExtension -> EnumTypeExtension -> Bool)
-> (EnumTypeExtension -> EnumTypeExtension -> Bool)
-> Eq EnumTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumTypeExtension -> EnumTypeExtension -> Bool
== :: EnumTypeExtension -> EnumTypeExtension -> Bool
$c/= :: EnumTypeExtension -> EnumTypeExtension -> Bool
/= :: EnumTypeExtension -> EnumTypeExtension -> Bool
Eq, (forall x. EnumTypeExtension -> Rep EnumTypeExtension x)
-> (forall x. Rep EnumTypeExtension x -> EnumTypeExtension)
-> Generic EnumTypeExtension
forall x. Rep EnumTypeExtension x -> EnumTypeExtension
forall x. EnumTypeExtension -> Rep EnumTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumTypeExtension -> Rep EnumTypeExtension x
from :: forall x. EnumTypeExtension -> Rep EnumTypeExtension x
$cto :: forall x. Rep EnumTypeExtension x -> EnumTypeExtension
to :: forall x. Rep EnumTypeExtension x -> EnumTypeExtension
Generic)

-- | InputObjectTypeDefinition
-- https://spec.graphql.org/draft/#InputObjectTypeDefinition
data InputObjectTypeDefinition
    = InputObjectTypeDefinition
        (Maybe Description)
        Name
        (Maybe Directives)
        (Maybe InputFieldsDefinition)
    deriving stock (Int -> InputObjectTypeDefinition -> ShowS
[InputObjectTypeDefinition] -> ShowS
InputObjectTypeDefinition -> String
(Int -> InputObjectTypeDefinition -> ShowS)
-> (InputObjectTypeDefinition -> String)
-> ([InputObjectTypeDefinition] -> ShowS)
-> Show InputObjectTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectTypeDefinition -> ShowS
showsPrec :: Int -> InputObjectTypeDefinition -> ShowS
$cshow :: InputObjectTypeDefinition -> String
show :: InputObjectTypeDefinition -> String
$cshowList :: [InputObjectTypeDefinition] -> ShowS
showList :: [InputObjectTypeDefinition] -> ShowS
Show, InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
(InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> Eq InputObjectTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
== :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$c/= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
/= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
Eq, (forall x.
 InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x)
-> (forall x.
    Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition)
-> Generic InputObjectTypeDefinition
forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
from :: forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
$cto :: forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
to :: forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
Generic)

-- | InputFieldsDefinition
-- https://spec.graphql.org/draft/#InputFieldsDefinition
newtype InputFieldsDefinition = InputFieldsDefinition (NonEmpty InputValueDefinition)
    deriving stock ((forall x. InputFieldsDefinition -> Rep InputFieldsDefinition x)
-> (forall x. Rep InputFieldsDefinition x -> InputFieldsDefinition)
-> Generic InputFieldsDefinition
forall x. Rep InputFieldsDefinition x -> InputFieldsDefinition
forall x. InputFieldsDefinition -> Rep InputFieldsDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputFieldsDefinition -> Rep InputFieldsDefinition x
from :: forall x. InputFieldsDefinition -> Rep InputFieldsDefinition x
$cto :: forall x. Rep InputFieldsDefinition x -> InputFieldsDefinition
to :: forall x. Rep InputFieldsDefinition x -> InputFieldsDefinition
Generic)
    deriving newtype (Int -> InputFieldsDefinition -> ShowS
[InputFieldsDefinition] -> ShowS
InputFieldsDefinition -> String
(Int -> InputFieldsDefinition -> ShowS)
-> (InputFieldsDefinition -> String)
-> ([InputFieldsDefinition] -> ShowS)
-> Show InputFieldsDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputFieldsDefinition -> ShowS
showsPrec :: Int -> InputFieldsDefinition -> ShowS
$cshow :: InputFieldsDefinition -> String
show :: InputFieldsDefinition -> String
$cshowList :: [InputFieldsDefinition] -> ShowS
showList :: [InputFieldsDefinition] -> ShowS
Show, InputFieldsDefinition -> InputFieldsDefinition -> Bool
(InputFieldsDefinition -> InputFieldsDefinition -> Bool)
-> (InputFieldsDefinition -> InputFieldsDefinition -> Bool)
-> Eq InputFieldsDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputFieldsDefinition -> InputFieldsDefinition -> Bool
== :: InputFieldsDefinition -> InputFieldsDefinition -> Bool
$c/= :: InputFieldsDefinition -> InputFieldsDefinition -> Bool
/= :: InputFieldsDefinition -> InputFieldsDefinition -> Bool
Eq, NonEmpty InputFieldsDefinition -> InputFieldsDefinition
InputFieldsDefinition
-> InputFieldsDefinition -> InputFieldsDefinition
(InputFieldsDefinition
 -> InputFieldsDefinition -> InputFieldsDefinition)
-> (NonEmpty InputFieldsDefinition -> InputFieldsDefinition)
-> (forall b.
    Integral b =>
    b -> InputFieldsDefinition -> InputFieldsDefinition)
-> Semigroup InputFieldsDefinition
forall b.
Integral b =>
b -> InputFieldsDefinition -> InputFieldsDefinition
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: InputFieldsDefinition
-> InputFieldsDefinition -> InputFieldsDefinition
<> :: InputFieldsDefinition
-> InputFieldsDefinition -> InputFieldsDefinition
$csconcat :: NonEmpty InputFieldsDefinition -> InputFieldsDefinition
sconcat :: NonEmpty InputFieldsDefinition -> InputFieldsDefinition
$cstimes :: forall b.
Integral b =>
b -> InputFieldsDefinition -> InputFieldsDefinition
stimes :: forall b.
Integral b =>
b -> InputFieldsDefinition -> InputFieldsDefinition
Semigroup)

-- | InputObjectTypeExtension
-- https://spec.graphql.org/draft/#InputObjectTypeExtension
data InputObjectTypeExtension
    = InputObjectTypeExtension Name (Maybe Directives) (Maybe InputFieldsDefinition)
    deriving stock (Int -> InputObjectTypeExtension -> ShowS
[InputObjectTypeExtension] -> ShowS
InputObjectTypeExtension -> String
(Int -> InputObjectTypeExtension -> ShowS)
-> (InputObjectTypeExtension -> String)
-> ([InputObjectTypeExtension] -> ShowS)
-> Show InputObjectTypeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectTypeExtension -> ShowS
showsPrec :: Int -> InputObjectTypeExtension -> ShowS
$cshow :: InputObjectTypeExtension -> String
show :: InputObjectTypeExtension -> String
$cshowList :: [InputObjectTypeExtension] -> ShowS
showList :: [InputObjectTypeExtension] -> ShowS
Show, InputObjectTypeExtension -> InputObjectTypeExtension -> Bool
(InputObjectTypeExtension -> InputObjectTypeExtension -> Bool)
-> (InputObjectTypeExtension -> InputObjectTypeExtension -> Bool)
-> Eq InputObjectTypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectTypeExtension -> InputObjectTypeExtension -> Bool
== :: InputObjectTypeExtension -> InputObjectTypeExtension -> Bool
$c/= :: InputObjectTypeExtension -> InputObjectTypeExtension -> Bool
/= :: InputObjectTypeExtension -> InputObjectTypeExtension -> Bool
Eq, (forall x.
 InputObjectTypeExtension -> Rep InputObjectTypeExtension x)
-> (forall x.
    Rep InputObjectTypeExtension x -> InputObjectTypeExtension)
-> Generic InputObjectTypeExtension
forall x.
Rep InputObjectTypeExtension x -> InputObjectTypeExtension
forall x.
InputObjectTypeExtension -> Rep InputObjectTypeExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InputObjectTypeExtension -> Rep InputObjectTypeExtension x
from :: forall x.
InputObjectTypeExtension -> Rep InputObjectTypeExtension x
$cto :: forall x.
Rep InputObjectTypeExtension x -> InputObjectTypeExtension
to :: forall x.
Rep InputObjectTypeExtension x -> InputObjectTypeExtension
Generic)

-- | Directive definition
-- https://spec.graphql.org/draft/#DirectiveDefinition
data DirectiveDefinition
    = DirectiveDefinition
        (Maybe Description)
        Name
        (Maybe ArgumentsDefinition)
        Bool
        DirectiveLocations
    deriving stock (Int -> DirectiveDefinition -> ShowS
[DirectiveDefinition] -> ShowS
DirectiveDefinition -> String
(Int -> DirectiveDefinition -> ShowS)
-> (DirectiveDefinition -> String)
-> ([DirectiveDefinition] -> ShowS)
-> Show DirectiveDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectiveDefinition -> ShowS
showsPrec :: Int -> DirectiveDefinition -> ShowS
$cshow :: DirectiveDefinition -> String
show :: DirectiveDefinition -> String
$cshowList :: [DirectiveDefinition] -> ShowS
showList :: [DirectiveDefinition] -> ShowS
Show, DirectiveDefinition -> DirectiveDefinition -> Bool
(DirectiveDefinition -> DirectiveDefinition -> Bool)
-> (DirectiveDefinition -> DirectiveDefinition -> Bool)
-> Eq DirectiveDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectiveDefinition -> DirectiveDefinition -> Bool
== :: DirectiveDefinition -> DirectiveDefinition -> Bool
$c/= :: DirectiveDefinition -> DirectiveDefinition -> Bool
/= :: DirectiveDefinition -> DirectiveDefinition -> Bool
Eq, (forall x. DirectiveDefinition -> Rep DirectiveDefinition x)
-> (forall x. Rep DirectiveDefinition x -> DirectiveDefinition)
-> Generic DirectiveDefinition
forall x. Rep DirectiveDefinition x -> DirectiveDefinition
forall x. DirectiveDefinition -> Rep DirectiveDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectiveDefinition -> Rep DirectiveDefinition x
from :: forall x. DirectiveDefinition -> Rep DirectiveDefinition x
$cto :: forall x. Rep DirectiveDefinition x -> DirectiveDefinition
to :: forall x. Rep DirectiveDefinition x -> DirectiveDefinition
Generic)

-- | https://spec.graphql.org/draft/#DirectiveLocations
type DirectiveLocations = NonEmpty DirectiveLocation

-- | https://spec.graphql.org/draft/#DirectiveLocation
data DirectiveLocation
    = LocationExecutableDirective ExecutableDirectiveLocation
    | LocationTypeSystemDirective TypeSystemDirectiveLocation
    deriving stock (Int -> DirectiveLocation -> ShowS
[DirectiveLocation] -> ShowS
DirectiveLocation -> String
(Int -> DirectiveLocation -> ShowS)
-> (DirectiveLocation -> String)
-> ([DirectiveLocation] -> ShowS)
-> Show DirectiveLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DirectiveLocation -> ShowS
showsPrec :: Int -> DirectiveLocation -> ShowS
$cshow :: DirectiveLocation -> String
show :: DirectiveLocation -> String
$cshowList :: [DirectiveLocation] -> ShowS
showList :: [DirectiveLocation] -> ShowS
Show, DirectiveLocation -> DirectiveLocation -> Bool
(DirectiveLocation -> DirectiveLocation -> Bool)
-> (DirectiveLocation -> DirectiveLocation -> Bool)
-> Eq DirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DirectiveLocation -> DirectiveLocation -> Bool
== :: DirectiveLocation -> DirectiveLocation -> Bool
$c/= :: DirectiveLocation -> DirectiveLocation -> Bool
/= :: DirectiveLocation -> DirectiveLocation -> Bool
Eq, (forall x. DirectiveLocation -> Rep DirectiveLocation x)
-> (forall x. Rep DirectiveLocation x -> DirectiveLocation)
-> Generic DirectiveLocation
forall x. Rep DirectiveLocation x -> DirectiveLocation
forall x. DirectiveLocation -> Rep DirectiveLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DirectiveLocation -> Rep DirectiveLocation x
from :: forall x. DirectiveLocation -> Rep DirectiveLocation x
$cto :: forall x. Rep DirectiveLocation x -> DirectiveLocation
to :: forall x. Rep DirectiveLocation x -> DirectiveLocation
Generic)

-- | A GraphQL 'Name'
-- https://spec.graphql.org/draft/#Name
newtype Name = Name MisoString
    deriving stock ((forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic)
    deriving newtype
        (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord 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
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$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
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Semigroup Name
Name
Semigroup Name =>
Name -> (Name -> Name -> Name) -> ([Name] -> Name) -> Monoid Name
[Name] -> Name
Name -> Name -> Name
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Name
mempty :: Name
$cmappend :: Name -> Name -> Name
mappend :: Name -> Name -> Name
$cmconcat :: [Name] -> Name
mconcat :: [Name] -> Name
Monoid, NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Name -> Name -> Name
<> :: Name -> Name -> Name
$csconcat :: NonEmpty Name -> Name
sconcat :: NonEmpty Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
stimes :: forall b. Integral b => b -> Name -> Name
Semigroup, String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
$cfromString :: String -> Name
fromString :: String -> Name
IsString, Name -> MisoString
(Name -> MisoString) -> ToMisoString Name
forall str. (str -> MisoString) -> ToMisoString str
$ctoMisoString :: Name -> MisoString
toMisoString :: Name -> MisoString
ToMisoString, MisoString -> Either String Name
(MisoString -> Either String Name) -> FromMisoString Name
forall t. (MisoString -> Either String t) -> FromMisoString t
$cfromMisoStringEither :: MisoString -> Either String Name
fromMisoStringEither :: MisoString -> Either String Name
FromMisoString)