{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe #-}

-- | This module defines an abstract syntax tree for the @GraphQL@ language. It
-- follows closely the structure given in the specification. Please refer to
-- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
-- for more information.
module Language.GraphQL.AST.Document
    ( Argument(..)
    , ArgumentsDefinition(..)
    , ConstValue(..)
    , Definition(..)
    , Description(..)
    , Directive(..)
    , Document
    , EnumValueDefinition(..)
    , ExecutableDefinition(..)
    , Field(..)
    , FieldDefinition(..)
    , FragmentDefinition(..)
    , FragmentSpread(..)
    , ImplementsInterfaces(..)
    , InlineFragment(..)
    , InputValueDefinition(..)
    , Location(..)
    , Name
    , NamedType
    , Node(..)
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
    , OperationType(..)
    , OperationTypeDefinition(..)
    , SchemaExtension(..)
    , Selection(..)
    , SelectionSet
    , SelectionSetOpt
    , Type(..)
    , TypeCondition
    , TypeDefinition(..)
    , TypeExtension(..)
    , TypeSystemDefinition(..)
    , TypeSystemExtension(..)
    , UnionMemberTypes(..)
    , Value(..)
    , VariableDefinition(..)
    ) where

import Data.Foldable (toList)
import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import qualified Data.Text as Text
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)

-- * Language

-- ** Source Text

-- | Name.
type Name = Text

-- | Error location, line and column.
data Location = Location
    { Location -> Word
line :: Word
    , Location -> Word
column :: Word
    } deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show)

instance Ord Location where
    compare :: Location -> Location -> Ordering
compare (Location thisLine :: Word
thisLine thisColumn :: Word
thisColumn) (Location thatLine :: Word
thatLine thatColumn :: Word
thatColumn)
        | Word
thisLine Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
thatLine = Ordering
LT
        | Word
thisLine Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
thatLine = Ordering
GT
        | Bool
otherwise = Word -> Word -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Word
thisColumn Word
thatColumn

-- | Contains some tree node with a location.
data Node a = Node
    { Node a -> a
node :: a
    , Node a -> Location
location :: Location
    } deriving (Node a -> Node a -> Bool
(Node a -> Node a -> Bool)
-> (Node a -> Node a -> Bool) -> Eq (Node a)
forall a. Eq a => Node a -> Node a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node a -> Node a -> Bool
$c/= :: forall a. Eq a => Node a -> Node a -> Bool
== :: Node a -> Node a -> Bool
$c== :: forall a. Eq a => Node a -> Node a -> Bool
Eq, Int -> Node a -> ShowS
[Node a] -> ShowS
Node a -> String
(Int -> Node a -> ShowS)
-> (Node a -> String) -> ([Node a] -> ShowS) -> Show (Node a)
forall a. Show a => Int -> Node a -> ShowS
forall a. Show a => [Node a] -> ShowS
forall a. Show a => Node a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node a] -> ShowS
$cshowList :: forall a. Show a => [Node a] -> ShowS
show :: Node a -> String
$cshow :: forall a. Show a => Node a -> String
showsPrec :: Int -> Node a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Node a -> ShowS
Show)

instance Functor Node where
    fmap :: (a -> b) -> Node a -> Node b
fmap f :: a -> b
f Node{..} = b -> Location -> Node b
forall a. a -> Location -> Node a
Node (a -> b
f a
node) Location
location

-- ** Document

-- | GraphQL document.
type Document = NonEmpty Definition

-- | All kinds of definitions that can occur in a GraphQL document.
data Definition
    = ExecutableDefinition ExecutableDefinition
    | TypeSystemDefinition TypeSystemDefinition Location
    | TypeSystemExtension TypeSystemExtension Location
    deriving (Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c== :: Definition -> Definition -> Bool
Eq, 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
showList :: [Definition] -> ShowS
$cshowList :: [Definition] -> ShowS
show :: Definition -> String
$cshow :: Definition -> String
showsPrec :: Int -> Definition -> ShowS
$cshowsPrec :: Int -> Definition -> ShowS
Show)

-- | Top-level definition of a document, either an operation or a fragment.
data ExecutableDefinition
    = DefinitionOperation OperationDefinition
    | DefinitionFragment FragmentDefinition
    deriving (ExecutableDefinition -> ExecutableDefinition -> Bool
(ExecutableDefinition -> ExecutableDefinition -> Bool)
-> (ExecutableDefinition -> ExecutableDefinition -> Bool)
-> Eq ExecutableDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutableDefinition -> ExecutableDefinition -> Bool
$c/= :: ExecutableDefinition -> ExecutableDefinition -> Bool
== :: ExecutableDefinition -> ExecutableDefinition -> Bool
$c== :: ExecutableDefinition -> ExecutableDefinition -> Bool
Eq, 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
showList :: [ExecutableDefinition] -> ShowS
$cshowList :: [ExecutableDefinition] -> ShowS
show :: ExecutableDefinition -> String
$cshow :: ExecutableDefinition -> String
showsPrec :: Int -> ExecutableDefinition -> ShowS
$cshowsPrec :: Int -> ExecutableDefinition -> ShowS
Show)

-- ** Operations

-- | Operation definition.
data OperationDefinition
    = SelectionSet SelectionSet Location
    | OperationDefinition
        OperationType
        (Maybe Name)
        [VariableDefinition]
        [Directive]
        SelectionSet
        Location
    deriving (OperationDefinition -> OperationDefinition -> Bool
(OperationDefinition -> OperationDefinition -> Bool)
-> (OperationDefinition -> OperationDefinition -> Bool)
-> Eq OperationDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationDefinition -> OperationDefinition -> Bool
$c/= :: OperationDefinition -> OperationDefinition -> Bool
== :: OperationDefinition -> OperationDefinition -> Bool
$c== :: OperationDefinition -> OperationDefinition -> Bool
Eq, 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
showList :: [OperationDefinition] -> ShowS
$cshowList :: [OperationDefinition] -> ShowS
show :: OperationDefinition -> String
$cshow :: OperationDefinition -> String
showsPrec :: Int -> OperationDefinition -> ShowS
$cshowsPrec :: Int -> OperationDefinition -> ShowS
Show)

-- | GraphQL has 3 operation types:
--
-- * query - a read-only fetch.
-- * mutation - a write operation followed by a fetch.
-- * subscription - a long-lived request that fetches data in response to
-- source events.
data OperationType = Query | Mutation | Subscription deriving (OperationType -> OperationType -> Bool
(OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool) -> Eq OperationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationType -> OperationType -> Bool
$c/= :: OperationType -> OperationType -> Bool
== :: OperationType -> OperationType -> Bool
$c== :: OperationType -> OperationType -> Bool
Eq, 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
showList :: [OperationType] -> ShowS
$cshowList :: [OperationType] -> ShowS
show :: OperationType -> String
$cshow :: OperationType -> String
showsPrec :: Int -> OperationType -> ShowS
$cshowsPrec :: Int -> OperationType -> ShowS
Show)

-- ** Selection Sets

-- | "Top-level" selection, selection on an operation or fragment.
type SelectionSet = NonEmpty Selection

-- | Field selection.
type SelectionSetOpt = [Selection]

-- | Selection is a single entry in a selection set. It can be a single 'Field',
-- 'FragmentSpread' or an 'InlineFragment'.
data Selection
    = FieldSelection Field
    | FragmentSpreadSelection FragmentSpread
    | InlineFragmentSelection InlineFragment
    deriving (Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, 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
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show)

-- | The only required property of a field is its name. Optionally it can also
-- have an alias, arguments, directives and a list of subfields.
--
-- In the following query "user" is a field with two subfields, "id" and "name":
--
-- @
-- {
--   user {
--     id
--     name
--   }
-- }
-- @
data Field =
    Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location
    deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, 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
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show)

-- | Inline fragments don't have any name and the type condition ("on UserType")
-- is optional.
--
-- @
-- {
--   user {
--     ... on UserType {
--       id
--       name
--     }
-- }
-- @
data InlineFragment = InlineFragment
    (Maybe TypeCondition) [Directive] SelectionSet Location
    deriving (InlineFragment -> InlineFragment -> Bool
(InlineFragment -> InlineFragment -> Bool)
-> (InlineFragment -> InlineFragment -> Bool) -> Eq InlineFragment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineFragment -> InlineFragment -> Bool
$c/= :: InlineFragment -> InlineFragment -> Bool
== :: InlineFragment -> InlineFragment -> Bool
$c== :: InlineFragment -> InlineFragment -> Bool
Eq, 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
showList :: [InlineFragment] -> ShowS
$cshowList :: [InlineFragment] -> ShowS
show :: InlineFragment -> String
$cshow :: InlineFragment -> String
showsPrec :: Int -> InlineFragment -> ShowS
$cshowsPrec :: Int -> InlineFragment -> ShowS
Show)

-- | A fragment spread refers to a fragment defined outside the operation and is
-- expanded at the execution time.
--
-- @
-- {
--   user {
--     ...userFragment
--   }
-- }
--
-- fragment userFragment on UserType {
--   id
--   name
-- }
-- @
data FragmentSpread = FragmentSpread Name [Directive] Location
    deriving (FragmentSpread -> FragmentSpread -> Bool
(FragmentSpread -> FragmentSpread -> Bool)
-> (FragmentSpread -> FragmentSpread -> Bool) -> Eq FragmentSpread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragmentSpread -> FragmentSpread -> Bool
$c/= :: FragmentSpread -> FragmentSpread -> Bool
== :: FragmentSpread -> FragmentSpread -> Bool
$c== :: FragmentSpread -> FragmentSpread -> Bool
Eq, 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
showList :: [FragmentSpread] -> ShowS
$cshowList :: [FragmentSpread] -> ShowS
show :: FragmentSpread -> String
$cshow :: FragmentSpread -> String
showsPrec :: Int -> FragmentSpread -> ShowS
$cshowsPrec :: Int -> FragmentSpread -> ShowS
Show)

-- ** Arguments

-- | Single argument.
--
-- @
-- {
--   user(id: 4) {
--     name
--   }
-- }
-- @
--
--  Here "id" is an argument for the field "user" and its value is 4.
data Argument = Argument Name (Node Value) Location deriving (Argument -> Argument -> Bool
(Argument -> Argument -> Bool)
-> (Argument -> Argument -> Bool) -> Eq Argument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Argument -> Argument -> Bool
$c/= :: Argument -> Argument -> Bool
== :: Argument -> Argument -> Bool
$c== :: Argument -> Argument -> Bool
Eq, 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
showList :: [Argument] -> ShowS
$cshowList :: [Argument] -> ShowS
show :: Argument -> String
$cshow :: Argument -> String
showsPrec :: Int -> Argument -> ShowS
$cshowsPrec :: Int -> Argument -> ShowS
Show)

-- ** Fragments

-- | Fragment definition.
data FragmentDefinition
    = FragmentDefinition Name TypeCondition [Directive] SelectionSet Location
    deriving (FragmentDefinition -> FragmentDefinition -> Bool
(FragmentDefinition -> FragmentDefinition -> Bool)
-> (FragmentDefinition -> FragmentDefinition -> Bool)
-> Eq FragmentDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FragmentDefinition -> FragmentDefinition -> Bool
$c/= :: FragmentDefinition -> FragmentDefinition -> Bool
== :: FragmentDefinition -> FragmentDefinition -> Bool
$c== :: FragmentDefinition -> FragmentDefinition -> Bool
Eq, 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
showList :: [FragmentDefinition] -> ShowS
$cshowList :: [FragmentDefinition] -> ShowS
show :: FragmentDefinition -> String
$cshow :: FragmentDefinition -> String
showsPrec :: Int -> FragmentDefinition -> ShowS
$cshowsPrec :: Int -> FragmentDefinition -> ShowS
Show)

-- | Type condition.
type TypeCondition = Name

-- ** Input Values

-- | Input value (literal or variable).
data Value
    = Variable Name
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value]
    | Object [ObjectField Value]
    deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, 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
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)

-- | Constant input value.
data ConstValue
    = ConstInt Int32
    | ConstFloat Double
    | ConstString Text
    | ConstBoolean Bool
    | ConstNull
    | ConstEnum Name
    | ConstList [ConstValue]
    | ConstObject [ObjectField ConstValue]
    deriving (ConstValue -> ConstValue -> Bool
(ConstValue -> ConstValue -> Bool)
-> (ConstValue -> ConstValue -> Bool) -> Eq ConstValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstValue -> ConstValue -> Bool
$c/= :: ConstValue -> ConstValue -> Bool
== :: ConstValue -> ConstValue -> Bool
$c== :: ConstValue -> ConstValue -> Bool
Eq, Int -> ConstValue -> ShowS
[ConstValue] -> ShowS
ConstValue -> String
(Int -> ConstValue -> ShowS)
-> (ConstValue -> String)
-> ([ConstValue] -> ShowS)
-> Show ConstValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstValue] -> ShowS
$cshowList :: [ConstValue] -> ShowS
show :: ConstValue -> String
$cshow :: ConstValue -> String
showsPrec :: Int -> ConstValue -> ShowS
$cshowsPrec :: Int -> ConstValue -> ShowS
Show)

-- | Key-value pair.
--
-- A list of 'ObjectField's represents a GraphQL object type.
data ObjectField a = ObjectField
    { ObjectField a -> Name
name :: Name
    , ObjectField a -> Node a
value :: Node a
    , ObjectField a -> Location
location :: Location
    } deriving (ObjectField a -> ObjectField a -> Bool
(ObjectField a -> ObjectField a -> Bool)
-> (ObjectField a -> ObjectField a -> Bool) -> Eq (ObjectField a)
forall a. Eq a => ObjectField a -> ObjectField a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectField a -> ObjectField a -> Bool
$c/= :: forall a. Eq a => ObjectField a -> ObjectField a -> Bool
== :: ObjectField a -> ObjectField a -> Bool
$c== :: forall a. Eq a => ObjectField a -> ObjectField a -> Bool
Eq, Int -> ObjectField a -> ShowS
[ObjectField a] -> ShowS
ObjectField a -> String
(Int -> ObjectField a -> ShowS)
-> (ObjectField a -> String)
-> ([ObjectField a] -> ShowS)
-> Show (ObjectField a)
forall a. Show a => Int -> ObjectField a -> ShowS
forall a. Show a => [ObjectField a] -> ShowS
forall a. Show a => ObjectField a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectField a] -> ShowS
$cshowList :: forall a. Show a => [ObjectField a] -> ShowS
show :: ObjectField a -> String
$cshow :: forall a. Show a => ObjectField a -> String
showsPrec :: Int -> ObjectField a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ObjectField a -> ShowS
Show)

-- ** Variables

-- | Variable definition.
--
-- Each operation can include a list of variables:
--
-- @
-- query (protagonist: String = "Zarathustra") {
--   getAuthor(protagonist: $protagonist)
-- }
-- @
--
-- This query defines an optional variable @protagonist@ of type @String@,
-- its default value is "Zarathustra". If no default value is defined and no
-- value is provided, a variable can still be @null@ if its type is nullable.
--
-- Variables are usually passed along with the query, but not in the query
-- itself. They make queries reusable.
data VariableDefinition =
    VariableDefinition Name Type (Maybe (Node ConstValue)) Location
    deriving (VariableDefinition -> VariableDefinition -> Bool
(VariableDefinition -> VariableDefinition -> Bool)
-> (VariableDefinition -> VariableDefinition -> Bool)
-> Eq VariableDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariableDefinition -> VariableDefinition -> Bool
$c/= :: VariableDefinition -> VariableDefinition -> Bool
== :: VariableDefinition -> VariableDefinition -> Bool
$c== :: VariableDefinition -> VariableDefinition -> Bool
Eq, 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
showList :: [VariableDefinition] -> ShowS
$cshowList :: [VariableDefinition] -> ShowS
show :: VariableDefinition -> String
$cshow :: VariableDefinition -> String
showsPrec :: Int -> VariableDefinition -> ShowS
$cshowsPrec :: Int -> VariableDefinition -> ShowS
Show)

-- ** Type References

-- | Type representation.
data Type
    = TypeNamed Name
    | TypeList Type
    | TypeNonNull NonNullType
    deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, 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
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show)

-- | Represents type names.
type NamedType = Name

-- | Helper type to represent Non-Null types and lists of such types.
data NonNullType
    = NonNullTypeNamed Name
    | NonNullTypeList Type
    deriving (NonNullType -> NonNullType -> Bool
(NonNullType -> NonNullType -> Bool)
-> (NonNullType -> NonNullType -> Bool) -> Eq NonNullType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNullType -> NonNullType -> Bool
$c/= :: NonNullType -> NonNullType -> Bool
== :: NonNullType -> NonNullType -> Bool
$c== :: NonNullType -> NonNullType -> Bool
Eq, 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
showList :: [NonNullType] -> ShowS
$cshowList :: [NonNullType] -> ShowS
show :: NonNullType -> String
$cshow :: NonNullType -> String
showsPrec :: Int -> NonNullType -> ShowS
$cshowsPrec :: Int -> NonNullType -> ShowS
Show)

-- ** Directives

-- | Directive.
--
-- Directives begin with "@", can accept arguments, and can be applied to the
-- most GraphQL elements, providing additional information.
data Directive = Directive Name [Argument] Location deriving (Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c== :: Directive -> Directive -> Bool
Eq, 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
showList :: [Directive] -> ShowS
$cshowList :: [Directive] -> ShowS
show :: Directive -> String
$cshow :: Directive -> String
showsPrec :: Int -> Directive -> ShowS
$cshowsPrec :: Int -> Directive -> ShowS
Show)

-- * Type System

-- | Type system can define a schema, a type or a directive.
--
-- @
-- schema {
--   query: Query
-- }
--
-- directive @example on FIELD_DEFINITION
--
-- type Query {
--   field: String @example
-- }
-- @
--
-- This example defines a custom directive "@example", which is applied to a
-- field definition of the type definition "Query". On the top the schema
-- is defined by taking advantage of the type "Query".
data TypeSystemDefinition
    = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
    | TypeDefinition TypeDefinition
    | DirectiveDefinition
        Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
    deriving (TypeSystemDefinition -> TypeSystemDefinition -> Bool
(TypeSystemDefinition -> TypeSystemDefinition -> Bool)
-> (TypeSystemDefinition -> TypeSystemDefinition -> Bool)
-> Eq TypeSystemDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
$c/= :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
$c== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
Eq, 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
showList :: [TypeSystemDefinition] -> ShowS
$cshowList :: [TypeSystemDefinition] -> ShowS
show :: TypeSystemDefinition -> String
$cshow :: TypeSystemDefinition -> String
showsPrec :: Int -> TypeSystemDefinition -> ShowS
$cshowsPrec :: Int -> TypeSystemDefinition -> ShowS
Show)

-- ** Type System Extensions

-- | Extension for a type system definition. Only schema and type definitions
-- can be extended.
data TypeSystemExtension
    = SchemaExtension SchemaExtension
    | TypeExtension TypeExtension
    deriving (TypeSystemExtension -> TypeSystemExtension -> Bool
(TypeSystemExtension -> TypeSystemExtension -> Bool)
-> (TypeSystemExtension -> TypeSystemExtension -> Bool)
-> Eq TypeSystemExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSystemExtension -> TypeSystemExtension -> Bool
$c/= :: TypeSystemExtension -> TypeSystemExtension -> Bool
== :: TypeSystemExtension -> TypeSystemExtension -> Bool
$c== :: TypeSystemExtension -> TypeSystemExtension -> Bool
Eq, 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
showList :: [TypeSystemExtension] -> ShowS
$cshowList :: [TypeSystemExtension] -> ShowS
show :: TypeSystemExtension -> String
$cshow :: TypeSystemExtension -> String
showsPrec :: Int -> TypeSystemExtension -> ShowS
$cshowsPrec :: Int -> TypeSystemExtension -> ShowS
Show)

-- ** Schema

-- | Root operation type definition.
--
-- Defining root operation types is not required since they have defaults. So
-- the default query root type is "Query", and the default mutation root type
-- is "Mutation". But these defaults can be changed for a specific schema. In
-- the following code the query root type is changed to "MyQueryRootType", and
-- the mutation root type to "MyMutationRootType":
--
-- @
-- schema {
--   query: MyQueryRootType
--   mutation: MyMutationRootType
-- }
-- @
data OperationTypeDefinition
    = OperationTypeDefinition OperationType NamedType
    deriving (OperationTypeDefinition -> OperationTypeDefinition -> Bool
(OperationTypeDefinition -> OperationTypeDefinition -> Bool)
-> (OperationTypeDefinition -> OperationTypeDefinition -> Bool)
-> Eq OperationTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
$c/= :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
== :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
$c== :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
Eq, Int -> OperationTypeDefinition -> ShowS
[OperationTypeDefinition] -> ShowS
OperationTypeDefinition -> String
(Int -> OperationTypeDefinition -> ShowS)
-> (OperationTypeDefinition -> String)
-> ([OperationTypeDefinition] -> ShowS)
-> Show OperationTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationTypeDefinition] -> ShowS
$cshowList :: [OperationTypeDefinition] -> ShowS
show :: OperationTypeDefinition -> String
$cshow :: OperationTypeDefinition -> String
showsPrec :: Int -> OperationTypeDefinition -> ShowS
$cshowsPrec :: Int -> OperationTypeDefinition -> ShowS
Show)

-- | Extension of the schema definition by further operations or directives.
data SchemaExtension
    = SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
    | SchemaDirectivesExtension (NonEmpty Directive)
    deriving (SchemaExtension -> SchemaExtension -> Bool
(SchemaExtension -> SchemaExtension -> Bool)
-> (SchemaExtension -> SchemaExtension -> Bool)
-> Eq SchemaExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SchemaExtension -> SchemaExtension -> Bool
$c/= :: SchemaExtension -> SchemaExtension -> Bool
== :: SchemaExtension -> SchemaExtension -> Bool
$c== :: SchemaExtension -> SchemaExtension -> Bool
Eq, 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
showList :: [SchemaExtension] -> ShowS
$cshowList :: [SchemaExtension] -> ShowS
show :: SchemaExtension -> String
$cshow :: SchemaExtension -> String
showsPrec :: Int -> SchemaExtension -> ShowS
$cshowsPrec :: Int -> SchemaExtension -> ShowS
Show)

-- ** Descriptions

-- | GraphQL has built-in capability to document service APIs. Documentation
-- is a GraphQL string that precedes a particular definition and contains
-- Markdown. Any GraphQL definition can be documented this way.
--
-- @
-- """
-- Supported languages.
-- """
-- enum Language {
--   "English"
--   EN
--
--   "Russian"
--   RU
-- }
-- @
newtype Description = Description (Maybe Text)
    deriving (Description -> Description -> Bool
(Description -> Description -> Bool)
-> (Description -> Description -> Bool) -> Eq Description
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c== :: Description -> Description -> Bool
Eq, 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
showList :: [Description] -> ShowS
$cshowList :: [Description] -> ShowS
show :: Description -> String
$cshow :: Description -> String
showsPrec :: Int -> Description -> ShowS
$cshowsPrec :: Int -> Description -> ShowS
Show)

-- ** Types

-- | Type definitions describe various user-defined types.
data TypeDefinition
    = ScalarTypeDefinition Description Name [Directive]
    | ObjectTypeDefinition
        Description
        Name
        (ImplementsInterfaces [])
        [Directive]
        [FieldDefinition]
    | InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
    | UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
    | EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
    | InputObjectTypeDefinition
        Description Name [Directive] [InputValueDefinition]
    deriving (TypeDefinition -> TypeDefinition -> Bool
(TypeDefinition -> TypeDefinition -> Bool)
-> (TypeDefinition -> TypeDefinition -> Bool) -> Eq TypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c== :: TypeDefinition -> TypeDefinition -> Bool
Eq, 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
showList :: [TypeDefinition] -> ShowS
$cshowList :: [TypeDefinition] -> ShowS
show :: TypeDefinition -> String
$cshow :: TypeDefinition -> String
showsPrec :: Int -> TypeDefinition -> ShowS
$cshowsPrec :: Int -> TypeDefinition -> ShowS
Show)

-- | Extensions for custom, already defined types.
data TypeExtension
    = ScalarTypeExtension Name (NonEmpty Directive)
    | ObjectTypeFieldsDefinitionExtension
        Name (ImplementsInterfaces []) [Directive] (NonEmpty FieldDefinition)
    | ObjectTypeDirectivesExtension
        Name (ImplementsInterfaces []) (NonEmpty Directive)
    | ObjectTypeImplementsInterfacesExtension
        Name (ImplementsInterfaces NonEmpty)
    | InterfaceTypeFieldsDefinitionExtension
        Name [Directive] (NonEmpty FieldDefinition)
    | InterfaceTypeDirectivesExtension Name (NonEmpty Directive)
    | UnionTypeUnionMemberTypesExtension
        Name [Directive] (UnionMemberTypes NonEmpty)
    | UnionTypeDirectivesExtension Name (NonEmpty Directive)
    | EnumTypeEnumValuesDefinitionExtension
        Name [Directive] (NonEmpty EnumValueDefinition)
    | EnumTypeDirectivesExtension Name (NonEmpty Directive)
    | InputObjectTypeInputFieldsDefinitionExtension
        Name [Directive] (NonEmpty InputValueDefinition)
    | InputObjectTypeDirectivesExtension Name (NonEmpty Directive)
    deriving (TypeExtension -> TypeExtension -> Bool
(TypeExtension -> TypeExtension -> Bool)
-> (TypeExtension -> TypeExtension -> Bool) -> Eq TypeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeExtension -> TypeExtension -> Bool
$c/= :: TypeExtension -> TypeExtension -> Bool
== :: TypeExtension -> TypeExtension -> Bool
$c== :: TypeExtension -> TypeExtension -> Bool
Eq, 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
showList :: [TypeExtension] -> ShowS
$cshowList :: [TypeExtension] -> ShowS
show :: TypeExtension -> String
$cshow :: TypeExtension -> String
showsPrec :: Int -> TypeExtension -> ShowS
$cshowsPrec :: Int -> TypeExtension -> ShowS
Show)

-- ** Objects

-- | Defines a list of interfaces implemented by the given object type.
--
-- @
-- type Business implements NamedEntity & ValuedEntity {
--   name: String
-- }
-- @
--
-- Here the object type "Business" implements two interfaces: "NamedEntity" and
-- "ValuedEntity".
newtype ImplementsInterfaces t = ImplementsInterfaces (t NamedType)

instance Foldable t => Eq (ImplementsInterfaces t) where
    (ImplementsInterfaces xs :: t Name
xs) == :: ImplementsInterfaces t -> ImplementsInterfaces t -> Bool
== (ImplementsInterfaces ys :: t Name
ys)
        = t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
xs [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
ys

instance Foldable t => Show (ImplementsInterfaces t) where
    show :: ImplementsInterfaces t -> String
show (ImplementsInterfaces interfaces :: t Name
interfaces) = Name -> String
Text.unpack
        (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
Text.append "implements"
        (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Name
Text.intercalate " & "
        ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
interfaces

-- | Definition of a single field in a type.
--
-- @
-- type Person {
--   name: String
--   picture(width: Int, height: Int): Url
-- }
-- @
--
-- "name" and "picture", including their arguments and types, are field
-- definitions.
data FieldDefinition
    = FieldDefinition Description Name ArgumentsDefinition Type [Directive]
    deriving (FieldDefinition -> FieldDefinition -> Bool
(FieldDefinition -> FieldDefinition -> Bool)
-> (FieldDefinition -> FieldDefinition -> Bool)
-> Eq FieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldDefinition -> FieldDefinition -> Bool
$c/= :: FieldDefinition -> FieldDefinition -> Bool
== :: FieldDefinition -> FieldDefinition -> Bool
$c== :: FieldDefinition -> FieldDefinition -> Bool
Eq, 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
showList :: [FieldDefinition] -> ShowS
$cshowList :: [FieldDefinition] -> ShowS
show :: FieldDefinition -> String
$cshow :: FieldDefinition -> String
showsPrec :: Int -> FieldDefinition -> ShowS
$cshowsPrec :: Int -> FieldDefinition -> ShowS
Show)

-- | A list of values passed to a field.
--
-- @
-- type Person {
--   name: String
--   picture(width: Int, height: Int): Url
-- }
-- @
--
-- "Person" has two fields, "name" and "picture". "name" doesn't have any
-- arguments, so 'ArgumentsDefinition' contains an empty list. "picture"
-- contains definitions for 2 arguments: "width" and "height".
newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
    deriving (ArgumentsDefinition -> ArgumentsDefinition -> Bool
(ArgumentsDefinition -> ArgumentsDefinition -> Bool)
-> (ArgumentsDefinition -> ArgumentsDefinition -> Bool)
-> Eq ArgumentsDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
$c/= :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
$c== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
Eq, 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
showList :: [ArgumentsDefinition] -> ShowS
$cshowList :: [ArgumentsDefinition] -> ShowS
show :: ArgumentsDefinition -> String
$cshow :: ArgumentsDefinition -> String
showsPrec :: Int -> ArgumentsDefinition -> ShowS
$cshowsPrec :: Int -> ArgumentsDefinition -> ShowS
Show)

instance Semigroup ArgumentsDefinition where
    (ArgumentsDefinition xs :: [InputValueDefinition]
xs) <> :: ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition
<> (ArgumentsDefinition ys :: [InputValueDefinition]
ys) =
        [InputValueDefinition] -> ArgumentsDefinition
ArgumentsDefinition ([InputValueDefinition] -> ArgumentsDefinition)
-> [InputValueDefinition] -> ArgumentsDefinition
forall a b. (a -> b) -> a -> b
$ [InputValueDefinition]
xs [InputValueDefinition]
-> [InputValueDefinition] -> [InputValueDefinition]
forall a. Semigroup a => a -> a -> a
<> [InputValueDefinition]
ys

instance Monoid ArgumentsDefinition where
    mempty :: ArgumentsDefinition
mempty = [InputValueDefinition] -> ArgumentsDefinition
ArgumentsDefinition []

-- | Defines an input value.
--
-- * Input values can define field arguments, see 'ArgumentsDefinition'.
-- * They can also be used as field definitions in an input type.
--
-- @
-- input Point2D {
--   x: Float
--   y: Float
-- }
-- @
--
-- The input type "Point2D" contains two value definitions: "x" and "y".
data InputValueDefinition = InputValueDefinition
    Description Name Type (Maybe (Node ConstValue)) [Directive]
    deriving (InputValueDefinition -> InputValueDefinition -> Bool
(InputValueDefinition -> InputValueDefinition -> Bool)
-> (InputValueDefinition -> InputValueDefinition -> Bool)
-> Eq InputValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputValueDefinition -> InputValueDefinition -> Bool
$c/= :: InputValueDefinition -> InputValueDefinition -> Bool
== :: InputValueDefinition -> InputValueDefinition -> Bool
$c== :: InputValueDefinition -> InputValueDefinition -> Bool
Eq, 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
showList :: [InputValueDefinition] -> ShowS
$cshowList :: [InputValueDefinition] -> ShowS
show :: InputValueDefinition -> String
$cshow :: InputValueDefinition -> String
showsPrec :: Int -> InputValueDefinition -> ShowS
$cshowsPrec :: Int -> InputValueDefinition -> ShowS
Show)

-- ** Unions

-- | List of types forming a union.
--
-- @
-- union SearchResult = Person | Photo
-- @
--
-- "Person" and "Photo" are member types of the union "SearchResult".
newtype UnionMemberTypes t = UnionMemberTypes (t NamedType)

instance Foldable t => Eq (UnionMemberTypes t) where
    (UnionMemberTypes xs :: t Name
xs) == :: UnionMemberTypes t -> UnionMemberTypes t -> Bool
== (UnionMemberTypes ys :: t Name
ys) = t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
xs [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
ys

instance Foldable t => Show (UnionMemberTypes t) where
    show :: UnionMemberTypes t -> String
show (UnionMemberTypes memberTypes :: t Name
memberTypes) = Name -> String
Text.unpack
        (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Name
Text.intercalate " | "
        ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ t Name -> [Name]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Name
memberTypes

-- ** Enums

-- | Single value in an enum definition.
--
-- @
-- enum Direction {
--   NORTH
--   EAST
--   SOUTH
--   WEST
-- }
-- @
--
-- "NORTH, "EAST", "SOUTH", and "WEST" are value definitions of an enum type
-- definition "Direction".
data EnumValueDefinition = EnumValueDefinition Description Name [Directive]
    deriving (EnumValueDefinition -> EnumValueDefinition -> Bool
(EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> Eq EnumValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
== :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c== :: EnumValueDefinition -> EnumValueDefinition -> Bool
Eq, 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
showList :: [EnumValueDefinition] -> ShowS
$cshowList :: [EnumValueDefinition] -> ShowS
show :: EnumValueDefinition -> String
$cshow :: EnumValueDefinition -> String
showsPrec :: Int -> EnumValueDefinition -> ShowS
$cshowsPrec :: Int -> EnumValueDefinition -> ShowS
Show)