{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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(..)
    , escape
    , showVariableName
    , showVariable
    ) where

import Data.Char (ord)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty)
import Numeric (showFloat, showHex)
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
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: 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
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show)

instance Ord Location where
    compare :: Location -> Location -> Ordering
compare (Location Word
thisLine Word
thisColumn) (Location Word
thatLine 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
    { forall a. Node a -> a
node :: a
    , forall 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
$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
/= :: Node a -> Node a -> Bool
Eq

instance Show a => Show (Node a) where
    show :: Node a -> String
show Node{ a
$sel:node:Node :: forall a. Node a -> a
node :: a
node } = a -> String
forall a. Show a => a -> String
show a
node

instance Functor Node where
    fmap :: forall a b. (a -> b) -> Node a -> Node b
fmap a -> b
f Node{a
Location
$sel:node:Node :: forall a. Node a -> a
$sel:location:Node :: forall a. Node a -> Location
node :: a
location :: Location
..} = 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
$c== :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
/= :: 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
$cshowsPrec :: Int -> Definition -> ShowS
showsPrec :: Int -> Definition -> ShowS
$cshow :: Definition -> String
show :: Definition -> String
$cshowList :: [Definition] -> ShowS
showList :: [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
$c== :: ExecutableDefinition -> ExecutableDefinition -> Bool
== :: ExecutableDefinition -> ExecutableDefinition -> Bool
$c/= :: ExecutableDefinition -> ExecutableDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> ExecutableDefinition -> ShowS
showsPrec :: Int -> ExecutableDefinition -> ShowS
$cshow :: ExecutableDefinition -> String
show :: ExecutableDefinition -> String
$cshowList :: [ExecutableDefinition] -> ShowS
showList :: [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
$c== :: OperationDefinition -> OperationDefinition -> Bool
== :: OperationDefinition -> OperationDefinition -> Bool
$c/= :: OperationDefinition -> OperationDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> OperationDefinition -> ShowS
showsPrec :: Int -> OperationDefinition -> ShowS
$cshow :: OperationDefinition -> String
show :: OperationDefinition -> String
$cshowList :: [OperationDefinition] -> ShowS
showList :: [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
$c== :: OperationType -> OperationType -> Bool
== :: OperationType -> OperationType -> Bool
$c/= :: OperationType -> OperationType -> Bool
/= :: 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
$cshowsPrec :: Int -> OperationType -> ShowS
showsPrec :: Int -> OperationType -> ShowS
$cshow :: OperationType -> String
show :: OperationType -> String
$cshowList :: [OperationType] -> ShowS
showList :: [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
$c== :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
/= :: 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
$cshowsPrec :: Int -> Selection -> ShowS
showsPrec :: Int -> Selection -> ShowS
$cshow :: Selection -> String
show :: Selection -> String
$cshowList :: [Selection] -> ShowS
showList :: [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
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: 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
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [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
$c== :: InlineFragment -> InlineFragment -> Bool
== :: InlineFragment -> InlineFragment -> Bool
$c/= :: InlineFragment -> InlineFragment -> Bool
/= :: 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
$cshowsPrec :: Int -> InlineFragment -> ShowS
showsPrec :: Int -> InlineFragment -> ShowS
$cshow :: InlineFragment -> String
show :: InlineFragment -> String
$cshowList :: [InlineFragment] -> ShowS
showList :: [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
$c== :: FragmentSpread -> FragmentSpread -> Bool
== :: FragmentSpread -> FragmentSpread -> Bool
$c/= :: FragmentSpread -> FragmentSpread -> Bool
/= :: 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
$cshowsPrec :: Int -> FragmentSpread -> ShowS
showsPrec :: Int -> FragmentSpread -> ShowS
$cshow :: FragmentSpread -> String
show :: FragmentSpread -> String
$cshowList :: [FragmentSpread] -> ShowS
showList :: [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
$c== :: Argument -> Argument -> Bool
== :: Argument -> Argument -> Bool
$c/= :: Argument -> Argument -> Bool
/= :: 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
$cshowsPrec :: Int -> Argument -> ShowS
showsPrec :: Int -> Argument -> ShowS
$cshow :: Argument -> String
show :: Argument -> String
$cshowList :: [Argument] -> ShowS
showList :: [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
$c== :: FragmentDefinition -> FragmentDefinition -> Bool
== :: FragmentDefinition -> FragmentDefinition -> Bool
$c/= :: FragmentDefinition -> FragmentDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> FragmentDefinition -> ShowS
showsPrec :: Int -> FragmentDefinition -> ShowS
$cshow :: FragmentDefinition -> String
show :: FragmentDefinition -> String
$cshowList :: [FragmentDefinition] -> ShowS
showList :: [FragmentDefinition] -> ShowS
Show)

-- | Type condition.
type TypeCondition = Name

-- ** Input Values

-- | Escapes a single character according to the GraphQL escaping rules for
-- double-quoted string values.
--
-- Characters, that should be escaped, are written as escaped characters with a
-- backslash or Unicode with an \"\\u\". Other characters are returned as
-- strings.
escape :: Char -> String
escape :: Char -> String
escape Char
char'
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = String
"\\\\"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' = String
"\\\""
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b' = String
"\\b"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f' = String
"\\f"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String
"\\n"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = String
"\\r"
    | Char
char' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' = String
"\\t"
    | Char
char' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0010' = String -> Char -> String
unicode  String
"\\u000" Char
char'
    | Char
char' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x0020' = String -> Char -> String
unicode String
"\\u00" Char
char'
    | Bool
otherwise = [Char
char']
  where
    unicode :: String -> Char -> String
unicode String
prefix Char
uchar = String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Int -> ShowS) -> Int -> ShowS
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
uchar) String
""

showList' :: Show a => [a] -> String
showList' :: forall a. Show a => [a] -> String
showList' [a]
list = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (a -> String
forall a. Show a => a -> String
show (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

showObject :: Show a => [ObjectField a] -> String
showObject :: forall a. Show a => [ObjectField a] -> String
showObject [ObjectField a]
fields =
    String
"{ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (ObjectField a -> String
forall a. Show a => a -> String
show (ObjectField a -> String) -> [ObjectField a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectField a]
fields) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" }"

-- | Input value (literal or variable).
data Value
    = Variable Name
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Node 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
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq

instance Show Value where
    showList :: [Value] -> ShowS
showList = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> ([Value] -> String) -> [Value] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> String
forall a. Show a => [a] -> String
showList'
    show :: Value -> String
show (Variable Name
variableName) = Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: Name -> String
Text.unpack Name
variableName
    show (Int Int32
integer) = Int32 -> String
forall a. Show a => a -> String
show Int32
integer
    show (Float Double
float) = ConstValue -> String
forall a. Show a => a -> String
show (ConstValue -> String) -> ConstValue -> String
forall a b. (a -> b) -> a -> b
$ Double -> ConstValue
ConstFloat Double
float
    show (String Name
text) = ConstValue -> String
forall a. Show a => a -> String
show (ConstValue -> String) -> ConstValue -> String
forall a b. (a -> b) -> a -> b
$  Name -> ConstValue
ConstString Name
text
    show (Boolean Bool
boolean) = Bool -> String
forall a. Show a => a -> String
show Bool
boolean
    show Value
Null = String
"null"
    show (Enum Name
name) = Name -> String
Text.unpack Name
name
    show (List [Node Value]
list) = [Node Value] -> String
forall a. Show a => a -> String
show [Node Value]
list
    show (Object [ObjectField Value]
fields) = [ObjectField Value] -> String
forall a. Show a => [ObjectField a] -> String
showObject [ObjectField Value]
fields

-- | Constant input value.
data ConstValue
    = ConstInt Int32
    | ConstFloat Double
    | ConstString Text
    | ConstBoolean Bool
    | ConstNull
    | ConstEnum Name
    | ConstList [Node 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
$c== :: ConstValue -> ConstValue -> Bool
== :: ConstValue -> ConstValue -> Bool
$c/= :: ConstValue -> ConstValue -> Bool
/= :: ConstValue -> ConstValue -> Bool
Eq

instance Show ConstValue where
    showList :: [ConstValue] -> ShowS
showList = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS)
-> ([ConstValue] -> String) -> [ConstValue] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ConstValue] -> String
forall a. Show a => [a] -> String
showList'
    show :: ConstValue -> String
show (ConstInt Int32
integer) = Int32 -> String
forall a. Show a => a -> String
show Int32
integer
    show (ConstFloat Double
float) = Double -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat Double
float String
forall a. Monoid a => a
mempty
    show (ConstString Name
text) = String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> ShowS) -> String -> Name -> String
forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr (String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> (Char -> String) -> Char -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
escape) String
"\"" Name
text
    show (ConstBoolean Bool
boolean) = Bool -> String
forall a. Show a => a -> String
show Bool
boolean
    show ConstValue
ConstNull = String
"null"
    show (ConstEnum Name
name) = Name -> String
Text.unpack Name
name
    show (ConstList [Node ConstValue]
list) = [Node ConstValue] -> String
forall a. Show a => a -> String
show [Node ConstValue]
list
    show (ConstObject [ObjectField ConstValue]
fields) = [ObjectField ConstValue] -> String
forall a. Show a => [ObjectField a] -> String
showObject [ObjectField ConstValue]
fields

-- | Key-value pair.
--
-- A list of 'ObjectField's represents a GraphQL object type.
data ObjectField a = ObjectField
    { forall a. ObjectField a -> Name
name :: Name
    , forall a. ObjectField a -> Node a
value :: Node a
    , forall 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
$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
/= :: ObjectField a -> ObjectField a -> Bool
Eq

instance Show a => Show (ObjectField a) where
    show :: ObjectField a -> String
show ObjectField{Name
Node a
Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:location:ObjectField :: forall a. ObjectField a -> Location
name :: Name
value :: Node a
location :: Location
..} = Name -> String
Text.unpack Name
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Node a -> String
forall a. Show a => a -> String
show Node a
value

instance Functor ObjectField where
    fmap :: forall a b. (a -> b) -> ObjectField a -> ObjectField b
fmap a -> b
f ObjectField{Name
Node a
Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:location:ObjectField :: forall a. ObjectField a -> Location
name :: Name
value :: Node a
location :: Location
..} = Name -> Node b -> Location -> ObjectField b
forall a. Name -> Node a -> Location -> ObjectField a
ObjectField Name
name (a -> b
f (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node a
value) Location
location

-- ** 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
$c== :: VariableDefinition -> VariableDefinition -> Bool
== :: VariableDefinition -> VariableDefinition -> Bool
$c/= :: VariableDefinition -> VariableDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> VariableDefinition -> ShowS
showsPrec :: Int -> VariableDefinition -> ShowS
$cshow :: VariableDefinition -> String
show :: VariableDefinition -> String
$cshowList :: [VariableDefinition] -> ShowS
showList :: [VariableDefinition] -> ShowS
Show)

showVariableName :: VariableDefinition -> String
showVariableName :: VariableDefinition -> String
showVariableName (VariableDefinition Name
name Type
_ Maybe (Node ConstValue)
_ Location
_) = String
"$" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
Text.unpack Name
name

showVariable :: VariableDefinition -> String
showVariable :: VariableDefinition -> String
showVariable var :: VariableDefinition
var@(VariableDefinition Name
_ Type
type' Maybe (Node ConstValue)
_ Location
_) = VariableDefinition -> String
showVariableName VariableDefinition
var String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type -> String
forall a. Show a => a -> String
show Type
type'

-- ** 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
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq

instance Show Type where
    show :: Type -> String
show (TypeNamed Name
typeName) = Name -> String
Text.unpack Name
typeName
    show (TypeList Type
listType) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"[", Type -> String
forall a. Show a => a -> String
show Type
listType, String
"]"]
    show (TypeNonNull NonNullType
nonNullType) = NonNullType -> String
forall a. Show a => a -> String
show NonNullType
nonNullType

-- | 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
$c== :: NonNullType -> NonNullType -> Bool
== :: NonNullType -> NonNullType -> Bool
$c/= :: NonNullType -> NonNullType -> Bool
/= :: NonNullType -> NonNullType -> Bool
Eq

instance Show NonNullType where
    show :: NonNullType -> String
show (NonNullTypeNamed Name
typeName) = Name -> String
Text.unpack (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Name
typeName Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"!"
    show (NonNullTypeList Type
listType) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"[", Type -> String
forall a. Show a => a -> String
show Type
listType, String
"]!"]

-- ** 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
$c== :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
/= :: 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
$cshowsPrec :: Int -> Directive -> ShowS
showsPrec :: Int -> Directive -> ShowS
$cshow :: Directive -> String
show :: Directive -> String
$cshowList :: [Directive] -> ShowS
showList :: [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
$c== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
== :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
$c/= :: TypeSystemDefinition -> TypeSystemDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> TypeSystemDefinition -> ShowS
showsPrec :: Int -> TypeSystemDefinition -> ShowS
$cshow :: TypeSystemDefinition -> String
show :: TypeSystemDefinition -> String
$cshowList :: [TypeSystemDefinition] -> ShowS
showList :: [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
$c== :: TypeSystemExtension -> TypeSystemExtension -> Bool
== :: TypeSystemExtension -> TypeSystemExtension -> Bool
$c/= :: TypeSystemExtension -> TypeSystemExtension -> Bool
/= :: 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
$cshowsPrec :: Int -> TypeSystemExtension -> ShowS
showsPrec :: Int -> TypeSystemExtension -> ShowS
$cshow :: TypeSystemExtension -> String
show :: TypeSystemExtension -> String
$cshowList :: [TypeSystemExtension] -> ShowS
showList :: [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
$c== :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
== :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
$c/= :: OperationTypeDefinition -> OperationTypeDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> OperationTypeDefinition -> ShowS
showsPrec :: Int -> OperationTypeDefinition -> ShowS
$cshow :: OperationTypeDefinition -> String
show :: OperationTypeDefinition -> String
$cshowList :: [OperationTypeDefinition] -> ShowS
showList :: [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
$c== :: SchemaExtension -> SchemaExtension -> Bool
== :: SchemaExtension -> SchemaExtension -> Bool
$c/= :: SchemaExtension -> SchemaExtension -> Bool
/= :: 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
$cshowsPrec :: Int -> SchemaExtension -> ShowS
showsPrec :: Int -> SchemaExtension -> ShowS
$cshow :: SchemaExtension -> String
show :: SchemaExtension -> String
$cshowList :: [SchemaExtension] -> ShowS
showList :: [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
$c== :: Description -> Description -> Bool
== :: Description -> Description -> Bool
$c/= :: Description -> Description -> Bool
/= :: 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
$cshowsPrec :: Int -> Description -> ShowS
showsPrec :: Int -> Description -> ShowS
$cshow :: Description -> String
show :: Description -> String
$cshowList :: [Description] -> ShowS
showList :: [Description] -> ShowS
Show)

instance Semigroup Description
  where
    Description Maybe Name
lhs <> :: Description -> Description -> Description
<> Description Maybe Name
rhs = Maybe Name -> Description
Description (Maybe Name -> Description) -> Maybe Name -> Description
forall a b. (a -> b) -> a -> b
$ Maybe Name
lhs Maybe Name -> Maybe Name -> Maybe Name
forall a. Semigroup a => a -> a -> a
<> Maybe Name
rhs

instance Monoid Description
  where
    mempty :: Description
mempty = Maybe Name -> Description
Description Maybe Name
forall a. Monoid a => a
mempty

-- ** 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
$c== :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> TypeDefinition -> ShowS
showsPrec :: Int -> TypeDefinition -> ShowS
$cshow :: TypeDefinition -> String
show :: TypeDefinition -> String
$cshowList :: [TypeDefinition] -> ShowS
showList :: [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
$c== :: TypeExtension -> TypeExtension -> Bool
== :: TypeExtension -> TypeExtension -> Bool
$c/= :: TypeExtension -> TypeExtension -> Bool
/= :: 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
$cshowsPrec :: Int -> TypeExtension -> ShowS
showsPrec :: Int -> TypeExtension -> ShowS
$cshow :: TypeExtension -> String
show :: TypeExtension -> String
$cshowList :: [TypeExtension] -> ShowS
showList :: [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 t Name
xs) == :: ImplementsInterfaces t -> ImplementsInterfaces t -> Bool
== (ImplementsInterfaces t Name
ys)
        = t Name -> [Name]
forall a. t a -> [a]
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 a. t a -> [a]
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 t Name
interfaces) = Name -> String
Text.unpack
        (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Name
Text.append Name
"implements"
        (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> [Name] -> Name
Text.intercalate Name
" & "
        ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ t Name -> [Name]
forall a. t a -> [a]
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
$c== :: FieldDefinition -> FieldDefinition -> Bool
== :: FieldDefinition -> FieldDefinition -> Bool
$c/= :: FieldDefinition -> FieldDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> FieldDefinition -> ShowS
showsPrec :: Int -> FieldDefinition -> ShowS
$cshow :: FieldDefinition -> String
show :: FieldDefinition -> String
$cshowList :: [FieldDefinition] -> ShowS
showList :: [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
$c== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
== :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
$c/= :: ArgumentsDefinition -> ArgumentsDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> ArgumentsDefinition -> ShowS
showsPrec :: Int -> ArgumentsDefinition -> ShowS
$cshow :: ArgumentsDefinition -> String
show :: ArgumentsDefinition -> String
$cshowList :: [ArgumentsDefinition] -> ShowS
showList :: [ArgumentsDefinition] -> ShowS
Show)

instance Semigroup ArgumentsDefinition where
    (ArgumentsDefinition [InputValueDefinition]
xs) <> :: ArgumentsDefinition -> ArgumentsDefinition -> ArgumentsDefinition
<> (ArgumentsDefinition [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
$c== :: InputValueDefinition -> InputValueDefinition -> Bool
== :: InputValueDefinition -> InputValueDefinition -> Bool
$c/= :: InputValueDefinition -> InputValueDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> InputValueDefinition -> ShowS
showsPrec :: Int -> InputValueDefinition -> ShowS
$cshow :: InputValueDefinition -> String
show :: InputValueDefinition -> String
$cshowList :: [InputValueDefinition] -> ShowS
showList :: [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 t Name
xs) == :: UnionMemberTypes t -> UnionMemberTypes t -> Bool
== (UnionMemberTypes t Name
ys) = t Name -> [Name]
forall a. t a -> [a]
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 a. t a -> [a]
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 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] -> Name
forall a b. (a -> b) -> a -> b
$ t Name -> [Name]
forall a. t a -> [a]
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
$c== :: EnumValueDefinition -> EnumValueDefinition -> Bool
== :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
/= :: 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
$cshowsPrec :: Int -> EnumValueDefinition -> ShowS
showsPrec :: Int -> EnumValueDefinition -> ShowS
$cshow :: EnumValueDefinition -> String
show :: EnumValueDefinition -> String
$cshowList :: [EnumValueDefinition] -> ShowS
showList :: [EnumValueDefinition] -> ShowS
Show)