{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.AST.Parser
( document
) where
import Control.Applicative (Alternative(..), liftA2, optional)
import Control.Applicative.Combinators (sepBy1)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import qualified Language.GraphQL.AST.DirectiveLocation as Directive
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Lexer
import Text.Megaparsec
( MonadParsec(..)
, SourcePos(..)
, getSourcePos
, lookAhead
, option
, try
, unPos
, (<?>)
)
document :: Parser Full.Document
document :: Parser Document
document = Parser ()
unicodeBOM
Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
spaceConsumer
Parser () -> Parser Document -> Parser Document
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Document -> Parser Document
forall a. Parser a -> Parser a
lexeme (ParsecT Void Text Identity Definition -> Parser Document
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Definition
definition)
definition :: Parser Full.Definition
definition :: ParsecT Void Text Identity Definition
definition = ExecutableDefinition -> Definition
Full.ExecutableDefinition (ExecutableDefinition -> Definition)
-> ParsecT Void Text Identity ExecutableDefinition
-> ParsecT Void Text Identity Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ExecutableDefinition
executableDefinition
ParsecT Void Text Identity Definition
-> ParsecT Void Text Identity Definition
-> ParsecT Void Text Identity Definition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Definition
typeSystemDefinition'
ParsecT Void Text Identity Definition
-> ParsecT Void Text Identity Definition
-> ParsecT Void Text Identity Definition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Definition
typeSystemExtension'
ParsecT Void Text Identity Definition
-> String -> ParsecT Void Text Identity Definition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Definition"
where
typeSystemDefinition' :: ParsecT Void Text Identity Definition
typeSystemDefinition' = do
Location
location <- Parser Location
getLocation
TypeSystemDefinition
definition' <- Parser TypeSystemDefinition
typeSystemDefinition
Definition -> ParsecT Void Text Identity Definition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition -> ParsecT Void Text Identity Definition)
-> Definition -> ParsecT Void Text Identity Definition
forall a b. (a -> b) -> a -> b
$ TypeSystemDefinition -> Location -> Definition
Full.TypeSystemDefinition TypeSystemDefinition
definition' Location
location
typeSystemExtension' :: ParsecT Void Text Identity Definition
typeSystemExtension' = do
Location
location <- Parser Location
getLocation
TypeSystemExtension
definition' <- Parser TypeSystemExtension
typeSystemExtension
Definition -> ParsecT Void Text Identity Definition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition -> ParsecT Void Text Identity Definition)
-> Definition -> ParsecT Void Text Identity Definition
forall a b. (a -> b) -> a -> b
$ TypeSystemExtension -> Location -> Definition
Full.TypeSystemExtension TypeSystemExtension
definition' Location
location
getLocation :: Parser Full.Location
getLocation :: Parser Location
getLocation = SourcePos -> Location
fromSourcePosition (SourcePos -> Location)
-> ParsecT Void Text Identity SourcePos -> Parser Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
where
fromSourcePosition :: SourcePos -> Location
fromSourcePosition SourcePos{String
Pos
sourceName :: SourcePos -> String
sourceLine :: SourcePos -> Pos
sourceColumn :: SourcePos -> Pos
sourceColumn :: Pos
sourceLine :: Pos
sourceName :: String
..} =
Word -> Word -> Location
Full.Location (Pos -> Word
wordFromPosition Pos
sourceLine) (Pos -> Word
wordFromPosition Pos
sourceColumn)
wordFromPosition :: Pos -> Word
wordFromPosition = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> (Pos -> Int) -> Pos -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos
executableDefinition :: Parser Full.ExecutableDefinition
executableDefinition :: ParsecT Void Text Identity ExecutableDefinition
executableDefinition = OperationDefinition -> ExecutableDefinition
Full.DefinitionOperation (OperationDefinition -> ExecutableDefinition)
-> ParsecT Void Text Identity OperationDefinition
-> ParsecT Void Text Identity ExecutableDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity OperationDefinition
operationDefinition
ParsecT Void Text Identity ExecutableDefinition
-> ParsecT Void Text Identity ExecutableDefinition
-> ParsecT Void Text Identity ExecutableDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FragmentDefinition -> ExecutableDefinition
Full.DefinitionFragment (FragmentDefinition -> ExecutableDefinition)
-> ParsecT Void Text Identity FragmentDefinition
-> ParsecT Void Text Identity ExecutableDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity FragmentDefinition
fragmentDefinition
ParsecT Void Text Identity ExecutableDefinition
-> String -> ParsecT Void Text Identity ExecutableDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ExecutableDefinition"
typeSystemDefinition :: Parser Full.TypeSystemDefinition
typeSystemDefinition :: Parser TypeSystemDefinition
typeSystemDefinition = Parser TypeSystemDefinition
schemaDefinition
Parser TypeSystemDefinition
-> Parser TypeSystemDefinition -> Parser TypeSystemDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TypeSystemDefinition
typeSystemDefinitionWithDescription
Parser TypeSystemDefinition
-> String -> Parser TypeSystemDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"TypeSystemDefinition"
where
typeSystemDefinitionWithDescription :: Parser TypeSystemDefinition
typeSystemDefinitionWithDescription = Parser Description
description
Parser Description
-> (Description -> Parser TypeSystemDefinition)
-> Parser TypeSystemDefinition
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Parser TypeSystemDefinition
-> Parser TypeSystemDefinition -> Parser TypeSystemDefinition)
-> (Description -> Parser TypeSystemDefinition)
-> (Description -> Parser TypeSystemDefinition)
-> Description
-> Parser TypeSystemDefinition
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Parser TypeSystemDefinition
-> Parser TypeSystemDefinition -> Parser TypeSystemDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Description -> Parser TypeSystemDefinition
typeDefinition' Description -> Parser TypeSystemDefinition
directiveDefinition
typeDefinition' :: Description -> Parser TypeSystemDefinition
typeDefinition' Description
description' = TypeDefinition -> TypeSystemDefinition
Full.TypeDefinition
(TypeDefinition -> TypeSystemDefinition)
-> ParsecT Void Text Identity TypeDefinition
-> Parser TypeSystemDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Description -> ParsecT Void Text Identity TypeDefinition
typeDefinition Description
description'
typeSystemExtension :: Parser Full.TypeSystemExtension
typeSystemExtension :: Parser TypeSystemExtension
typeSystemExtension = SchemaExtension -> TypeSystemExtension
Full.SchemaExtension (SchemaExtension -> TypeSystemExtension)
-> ParsecT Void Text Identity SchemaExtension
-> Parser TypeSystemExtension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity SchemaExtension
schemaExtension
Parser TypeSystemExtension
-> Parser TypeSystemExtension -> Parser TypeSystemExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeExtension -> TypeSystemExtension
Full.TypeExtension (TypeExtension -> TypeSystemExtension)
-> ParsecT Void Text Identity TypeExtension
-> Parser TypeSystemExtension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity TypeExtension
typeExtension
Parser TypeSystemExtension -> String -> Parser TypeSystemExtension
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"TypeSystemExtension"
directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition
directiveDefinition :: Description -> Parser TypeSystemDefinition
directiveDefinition Description
description' = Description
-> Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition
Full.DirectiveDefinition Description
description'
(Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"directive"
ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition)
-> Parser ()
-> ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
at
ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition
-> NonEmpty DirectiveLocation
-> TypeSystemDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(ArgumentsDefinition
-> NonEmpty DirectiveLocation -> TypeSystemDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(ArgumentsDefinition
-> NonEmpty DirectiveLocation -> TypeSystemDefinition)
-> ParsecT Void Text Identity ArgumentsDefinition
-> ParsecT
Void
Text
Identity
(NonEmpty DirectiveLocation -> TypeSystemDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity ArgumentsDefinition
argumentsDefinition
ParsecT
Void
Text
Identity
(NonEmpty DirectiveLocation -> TypeSystemDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(NonEmpty DirectiveLocation -> TypeSystemDefinition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParsecT Void Text Identity Text
symbol Text
"on"
ParsecT
Void
Text
Identity
(NonEmpty DirectiveLocation -> TypeSystemDefinition)
-> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
-> Parser TypeSystemDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
directiveLocations
Parser TypeSystemDefinition
-> String -> Parser TypeSystemDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"DirectiveDefinition"
directiveLocations :: Parser (NonEmpty DirectiveLocation)
directiveLocations :: ParsecT Void Text Identity (NonEmpty DirectiveLocation)
directiveLocations = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
pipe
ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
-> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser DirectiveLocation
directiveLocation Parser DirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`NonEmpty.sepBy1` ParsecT Void Text Identity Text
pipe
ParsecT Void Text Identity (NonEmpty DirectiveLocation)
-> String
-> ParsecT Void Text Identity (NonEmpty DirectiveLocation)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"DirectiveLocations"
directiveLocation :: Parser DirectiveLocation
directiveLocation :: Parser DirectiveLocation
directiveLocation = ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.Query ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"QUERY")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.Mutation ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"MUTATION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.Subscription ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"SUBSCRIPTION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.FieldDefinition TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"FIELD_DEFINITION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.Field ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"FIELD")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.FragmentDefinition ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
"FRAGMENT_DEFINITION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.FragmentSpread ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
"FRAGMENT_SPREAD")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e (ExecutableDirectiveLocation
Directive.InlineFragment ExecutableDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ExecutableDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
"INLINE_FRAGMENT")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Schema TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"SCHEMA")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Scalar TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"SCALAR")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Object TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"OBJECT")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.ArgumentDefinition TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"ARGUMENT_DEFINITION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Interface TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"INTERFACE")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Union TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"UNION")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.EnumValue TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"ENUM_VALUE")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.Enum TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"ENUM")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.InputObject TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"INPUT_OBJECT")
Parser DirectiveLocation
-> Parser DirectiveLocation -> Parser DirectiveLocation
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t (TypeSystemDirectiveLocation
Directive.InputFieldDefinition TypeSystemDirectiveLocation
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"INPUT_FIELD_DEFINITION")
Parser DirectiveLocation -> String -> Parser DirectiveLocation
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"DirectiveLocation"
where
e :: ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
e = (ExecutableDirectiveLocation -> DirectiveLocation)
-> ParsecT Void Text Identity ExecutableDirectiveLocation
-> Parser DirectiveLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutableDirectiveLocation -> DirectiveLocation
Directive.ExecutableDirectiveLocation
t :: ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
t = (TypeSystemDirectiveLocation -> DirectiveLocation)
-> ParsecT Void Text Identity TypeSystemDirectiveLocation
-> Parser DirectiveLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeSystemDirectiveLocation -> DirectiveLocation
Directive.TypeSystemDirectiveLocation
typeDefinition :: Full.Description -> Parser Full.TypeDefinition
typeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
typeDefinition Description
description' = Description -> ParsecT Void Text Identity TypeDefinition
scalarTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Description -> ParsecT Void Text Identity TypeDefinition
objectTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Description -> ParsecT Void Text Identity TypeDefinition
interfaceTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Description -> ParsecT Void Text Identity TypeDefinition
unionTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Description -> ParsecT Void Text Identity TypeDefinition
enumTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Description -> ParsecT Void Text Identity TypeDefinition
inputObjectTypeDefinition Description
description'
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"TypeDefinition"
typeExtension :: Parser Full.TypeExtension
typeExtension :: ParsecT Void Text Identity TypeExtension
typeExtension = ParsecT Void Text Identity TypeExtension
scalarTypeExtension
ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeExtension
objectTypeExtension
ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeExtension
interfaceTypeExtension
ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeExtension
unionTypeExtension
ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeExtension
enumTypeExtension
ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity TypeExtension
inputObjectTypeExtension
ParsecT Void Text Identity TypeExtension
-> String -> ParsecT Void Text Identity TypeExtension
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"TypeExtension"
scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
scalarTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
scalarTypeDefinition Description
description' = Description -> Text -> [Directive] -> TypeDefinition
Full.ScalarTypeDefinition Description
description'
(Text -> [Directive] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void Text Identity (Text -> [Directive] -> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"scalar"
ParsecT Void Text Identity (Text -> [Directive] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Directive] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity ([Directive] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ScalarTypeDefinition"
scalarTypeExtension :: Parser Full.TypeExtension
scalarTypeExtension :: ParsecT Void Text Identity TypeExtension
scalarTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"scalar" String
"ScalarTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ (Text -> NonEmpty Directive -> TypeExtension
Full.ScalarTypeExtension (Text -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive) ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:| []
objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
objectTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
objectTypeDefinition Description
description' = Description
-> Text
-> ImplementsInterfaces []
-> [Directive]
-> [FieldDefinition]
-> TypeDefinition
Full.ObjectTypeDefinition Description
description'
(Text
-> ImplementsInterfaces []
-> [Directive]
-> [FieldDefinition]
-> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text
-> ImplementsInterfaces []
-> [Directive]
-> [FieldDefinition]
-> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"type"
ParsecT
Void
Text
Identity
(Text
-> ImplementsInterfaces []
-> [Directive]
-> [FieldDefinition]
-> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(ImplementsInterfaces []
-> [Directive] -> [FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(ImplementsInterfaces []
-> [Directive] -> [FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT
Void
Text
Identity
([Directive] -> [FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImplementsInterfaces []
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([Text] -> ImplementsInterfaces []
forall (t :: * -> *). t Text -> ImplementsInterfaces t
Full.ImplementsInterfaces []) ((ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (ImplementsInterfaces t)
implementsInterfaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1)
ParsecT
Void
Text
Identity
([Directive] -> [FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT Void Text Identity ([FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT Void Text Identity ([FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [FieldDefinition]
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [FieldDefinition]
-> ParsecT Void Text Identity [FieldDefinition]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity FieldDefinition
-> ParsecT Void Text Identity [FieldDefinition]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity FieldDefinition
fieldDefinition)
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ObjectTypeDefinition"
objectTypeExtension :: Parser Full.TypeExtension
objectTypeExtension :: ParsecT Void Text Identity TypeExtension
objectTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"type" String
"ObjectTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity TypeExtension
fieldsDefinitionExtension ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:|
[ ParsecT Void Text Identity TypeExtension
directivesExtension
, ParsecT Void Text Identity TypeExtension
implementsInterfacesExtension
]
where
fieldsDefinitionExtension :: ParsecT Void Text Identity TypeExtension
fieldsDefinitionExtension = Text
-> ImplementsInterfaces []
-> [Directive]
-> NonEmpty FieldDefinition
-> TypeExtension
Full.ObjectTypeFieldsDefinitionExtension
(Text
-> ImplementsInterfaces []
-> [Directive]
-> NonEmpty FieldDefinition
-> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(ImplementsInterfaces []
-> [Directive] -> NonEmpty FieldDefinition -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(ImplementsInterfaces []
-> [Directive] -> NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT
Void
Text
Identity
([Directive] -> NonEmpty FieldDefinition -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImplementsInterfaces []
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([Text] -> ImplementsInterfaces []
forall (t :: * -> *). t Text -> ImplementsInterfaces t
Full.ImplementsInterfaces []) ((ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (ImplementsInterfaces t)
implementsInterfaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1)
ParsecT
Void
Text
Identity
([Directive] -> NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (NonEmpty FieldDefinition -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity (NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty FieldDefinition)
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity FieldDefinition
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity FieldDefinition
fieldDefinition)
directivesExtension :: ParsecT Void Text Identity TypeExtension
directivesExtension = Text
-> ImplementsInterfaces [] -> NonEmpty Directive -> TypeExtension
Full.ObjectTypeDirectivesExtension
(Text
-> ImplementsInterfaces [] -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(ImplementsInterfaces [] -> NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(ImplementsInterfaces [] -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImplementsInterfaces []
-> ParsecT Void Text Identity (ImplementsInterfaces [])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([Text] -> ImplementsInterfaces []
forall (t :: * -> *). t Text -> ImplementsInterfaces t
Full.ImplementsInterfaces []) ((ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text])
-> ParsecT Void Text Identity (ImplementsInterfaces [])
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (ImplementsInterfaces t)
implementsInterfaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1)
ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
implementsInterfacesExtension :: ParsecT Void Text Identity TypeExtension
implementsInterfacesExtension = Text -> ImplementsInterfaces NonEmpty -> TypeExtension
Full.ObjectTypeImplementsInterfacesExtension
(Text -> ImplementsInterfaces NonEmpty -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void Text Identity (ImplementsInterfaces NonEmpty -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void Text Identity (ImplementsInterfaces NonEmpty -> TypeExtension)
-> ParsecT Void Text Identity (ImplementsInterfaces NonEmpty)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Text))
-> ParsecT Void Text Identity (ImplementsInterfaces NonEmpty)
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (ImplementsInterfaces t)
implementsInterfaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Text)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
NonEmpty.sepBy1
description :: Parser Full.Description
description :: Parser Description
description = Maybe Text -> Description
Full.Description
(Maybe Text -> Description)
-> ParsecT Void Text Identity (Maybe Text) -> Parser Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
stringValue
Parser Description -> String -> Parser Description
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Description"
unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
unionTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
unionTypeDefinition Description
description' = Description
-> Text -> [Directive] -> UnionMemberTypes [] -> TypeDefinition
Full.UnionTypeDefinition Description
description'
(Text -> [Directive] -> UnionMemberTypes [] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> [Directive] -> UnionMemberTypes [] -> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"union"
ParsecT
Void
Text
Identity
(Text -> [Directive] -> UnionMemberTypes [] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> UnionMemberTypes [] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> UnionMemberTypes [] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (UnionMemberTypes [] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT Void Text Identity (UnionMemberTypes [] -> TypeDefinition)
-> ParsecT Void Text Identity (UnionMemberTypes [])
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UnionMemberTypes []
-> ParsecT Void Text Identity (UnionMemberTypes [])
-> ParsecT Void Text Identity (UnionMemberTypes [])
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option ([Text] -> UnionMemberTypes []
forall (t :: * -> *). t Text -> UnionMemberTypes t
Full.UnionMemberTypes []) ((ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text])
-> ParsecT Void Text Identity (UnionMemberTypes [])
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (UnionMemberTypes t)
unionMemberTypes ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser [Text]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy1)
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"UnionTypeDefinition"
unionTypeExtension :: Parser Full.TypeExtension
unionTypeExtension :: ParsecT Void Text Identity TypeExtension
unionTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"union" String
"UnionTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity TypeExtension
unionMemberTypesExtension ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:| [ParsecT Void Text Identity TypeExtension
directivesExtension]
where
unionMemberTypesExtension :: ParsecT Void Text Identity TypeExtension
unionMemberTypesExtension = Text -> [Directive] -> UnionMemberTypes NonEmpty -> TypeExtension
Full.UnionTypeUnionMemberTypesExtension
(Text -> [Directive] -> UnionMemberTypes NonEmpty -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> UnionMemberTypes NonEmpty -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> UnionMemberTypes NonEmpty -> TypeExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (UnionMemberTypes NonEmpty -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity (UnionMemberTypes NonEmpty -> TypeExtension)
-> ParsecT Void Text Identity (UnionMemberTypes NonEmpty)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Text))
-> ParsecT Void Text Identity (UnionMemberTypes NonEmpty)
forall (t :: * -> *).
Foldable t =>
(ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (UnionMemberTypes t)
unionMemberTypes ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Text)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
NonEmpty.sepBy1
directivesExtension :: ParsecT Void Text Identity TypeExtension
directivesExtension = Text -> NonEmpty Directive -> TypeExtension
Full.UnionTypeDirectivesExtension
(Text -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
unionMemberTypes ::
Foldable t =>
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
Parser (Full.UnionMemberTypes t)
unionMemberTypes :: (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (UnionMemberTypes t)
unionMemberTypes ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text)
sepBy' = t Text -> UnionMemberTypes t
forall (t :: * -> *). t Text -> UnionMemberTypes t
Full.UnionMemberTypes
(t Text -> UnionMemberTypes t)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (t Text -> UnionMemberTypes t)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
equals
ParsecT Void Text Identity (t Text -> UnionMemberTypes t)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (t Text -> UnionMemberTypes t)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
pipe
ParsecT Void Text Identity (t Text -> UnionMemberTypes t)
-> Parser (t Text) -> Parser (UnionMemberTypes t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text)
`sepBy'` ParsecT Void Text Identity Text
pipe
Parser (UnionMemberTypes t)
-> String -> Parser (UnionMemberTypes t)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"UnionMemberTypes"
interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
interfaceTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
interfaceTypeDefinition Description
description' = Description
-> Text -> [Directive] -> [FieldDefinition] -> TypeDefinition
Full.InterfaceTypeDefinition Description
description'
(Text -> [Directive] -> [FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> [Directive] -> [FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"interface"
ParsecT
Void
Text
Identity
(Text -> [Directive] -> [FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> [FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> [FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT Void Text Identity ([FieldDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT Void Text Identity ([FieldDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [FieldDefinition]
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [FieldDefinition]
-> ParsecT Void Text Identity [FieldDefinition]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity FieldDefinition
-> ParsecT Void Text Identity [FieldDefinition]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity FieldDefinition
fieldDefinition)
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"InterfaceTypeDefinition"
interfaceTypeExtension :: Parser Full.TypeExtension
interfaceTypeExtension :: ParsecT Void Text Identity TypeExtension
interfaceTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"interface" String
"InterfaceTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity TypeExtension
fieldsDefinitionExtension ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:| [ParsecT Void Text Identity TypeExtension
directivesExtension]
where
fieldsDefinitionExtension :: ParsecT Void Text Identity TypeExtension
fieldsDefinitionExtension = Text -> [Directive] -> NonEmpty FieldDefinition -> TypeExtension
Full.InterfaceTypeFieldsDefinitionExtension
(Text -> [Directive] -> NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> NonEmpty FieldDefinition -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (NonEmpty FieldDefinition -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity (NonEmpty FieldDefinition -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty FieldDefinition)
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity FieldDefinition
-> ParsecT Void Text Identity (NonEmpty FieldDefinition)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity FieldDefinition
fieldDefinition)
directivesExtension :: ParsecT Void Text Identity TypeExtension
directivesExtension = Text -> NonEmpty Directive -> TypeExtension
Full.InterfaceTypeDirectivesExtension
(Text -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
enumTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
enumTypeDefinition Description
description' = Description
-> Text -> [Directive] -> [EnumValueDefinition] -> TypeDefinition
Full.EnumTypeDefinition Description
description'
(Text -> [Directive] -> [EnumValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> [Directive] -> [EnumValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"enum"
ParsecT
Void
Text
Identity
(Text -> [Directive] -> [EnumValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> [EnumValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> [EnumValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity ([EnumValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity ([EnumValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [EnumValueDefinition]
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity [EnumValueDefinition]
-> ParsecT Void Text Identity [EnumValueDefinition])
-> Parser EnumValueDefinition
-> ParsecT Void Text Identity [EnumValueDefinition]
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn ParsecT Void Text Identity [EnumValueDefinition]
-> ParsecT Void Text Identity [EnumValueDefinition]
forall a. Parser a -> Parser a
braces Parser EnumValueDefinition
enumValueDefinition
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"EnumTypeDefinition"
enumTypeExtension :: Parser Full.TypeExtension
enumTypeExtension :: ParsecT Void Text Identity TypeExtension
enumTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"enum" String
"EnumTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity TypeExtension
enumValuesDefinitionExtension ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:| [ParsecT Void Text Identity TypeExtension
directivesExtension]
where
enumValuesDefinitionExtension :: ParsecT Void Text Identity TypeExtension
enumValuesDefinitionExtension = Text
-> [Directive] -> NonEmpty EnumValueDefinition -> TypeExtension
Full.EnumTypeEnumValuesDefinitionExtension
(Text
-> [Directive] -> NonEmpty EnumValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> NonEmpty EnumValueDefinition -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> NonEmpty EnumValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (NonEmpty EnumValueDefinition -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity (NonEmpty EnumValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty EnumValueDefinition)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty EnumValueDefinition)
-> ParsecT Void Text Identity (NonEmpty EnumValueDefinition)
forall a. Parser a -> Parser a
braces (Parser EnumValueDefinition
-> ParsecT Void Text Identity (NonEmpty EnumValueDefinition)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some Parser EnumValueDefinition
enumValueDefinition)
directivesExtension :: ParsecT Void Text Identity TypeExtension
directivesExtension = Text -> NonEmpty Directive -> TypeExtension
Full.EnumTypeDirectivesExtension
(Text -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
inputObjectTypeDefinition :: Description -> ParsecT Void Text Identity TypeDefinition
inputObjectTypeDefinition Description
description' = Description
-> Text -> [Directive] -> [InputValueDefinition] -> TypeDefinition
Full.InputObjectTypeDefinition Description
description'
(Text -> [Directive] -> [InputValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Text -> [Directive] -> [InputValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"input"
ParsecT
Void
Text
Identity
(Text -> [Directive] -> [InputValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> [InputValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> [InputValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity ([InputValueDefinition] -> TypeDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity ([InputValueDefinition] -> TypeDefinition)
-> ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity TypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity [InputValueDefinition])
-> Parser InputValueDefinition
-> ParsecT Void Text Identity [InputValueDefinition]
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity [InputValueDefinition]
forall a. Parser a -> Parser a
braces Parser InputValueDefinition
inputValueDefinition
ParsecT Void Text Identity TypeDefinition
-> String -> ParsecT Void Text Identity TypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"InputObjectTypeDefinition"
inputObjectTypeExtension :: Parser Full.TypeExtension
inputObjectTypeExtension :: ParsecT Void Text Identity TypeExtension
inputObjectTypeExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"input" String
"InputObjectTypeExtension"
(NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension)
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
-> ParsecT Void Text Identity TypeExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity TypeExtension
inputFieldsDefinitionExtension ParsecT Void Text Identity TypeExtension
-> [ParsecT Void Text Identity TypeExtension]
-> NonEmpty (ParsecT Void Text Identity TypeExtension)
forall a. a -> [a] -> NonEmpty a
:| [ParsecT Void Text Identity TypeExtension
directivesExtension]
where
inputFieldsDefinitionExtension :: ParsecT Void Text Identity TypeExtension
inputFieldsDefinitionExtension = Text
-> [Directive] -> NonEmpty InputValueDefinition -> TypeExtension
Full.InputObjectTypeInputFieldsDefinitionExtension
(Text
-> [Directive] -> NonEmpty InputValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive] -> NonEmpty InputValueDefinition -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
([Directive] -> NonEmpty InputValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void Text Identity (NonEmpty InputValueDefinition -> TypeExtension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void Text Identity (NonEmpty InputValueDefinition -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty InputValueDefinition)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty InputValueDefinition)
-> ParsecT Void Text Identity (NonEmpty InputValueDefinition)
forall a. Parser a -> Parser a
braces (Parser InputValueDefinition
-> ParsecT Void Text Identity (NonEmpty InputValueDefinition)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some Parser InputValueDefinition
inputValueDefinition)
directivesExtension :: ParsecT Void Text Identity TypeExtension
directivesExtension = Text -> NonEmpty Directive -> TypeExtension
Full.InputObjectTypeDirectivesExtension
(Text -> NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity (NonEmpty Directive -> TypeExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity TypeExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
enumValueDefinition :: Parser Full.EnumValueDefinition
enumValueDefinition :: Parser EnumValueDefinition
enumValueDefinition = Description -> Text -> [Directive] -> EnumValueDefinition
Full.EnumValueDefinition
(Description -> Text -> [Directive] -> EnumValueDefinition)
-> Parser Description
-> ParsecT
Void Text Identity (Text -> [Directive] -> EnumValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Description
description
ParsecT
Void Text Identity (Text -> [Directive] -> EnumValueDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity ([Directive] -> EnumValueDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
enumValue
ParsecT Void Text Identity ([Directive] -> EnumValueDefinition)
-> ParsecT Void Text Identity [Directive]
-> Parser EnumValueDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
Parser EnumValueDefinition -> String -> Parser EnumValueDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"EnumValueDefinition"
implementsInterfaces ::
Foldable t =>
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
Parser (Full.ImplementsInterfaces t)
implementsInterfaces :: (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text))
-> Parser (ImplementsInterfaces t)
implementsInterfaces ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text)
sepBy' = t Text -> ImplementsInterfaces t
forall (t :: * -> *). t Text -> ImplementsInterfaces t
Full.ImplementsInterfaces
(t Text -> ImplementsInterfaces t)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (t Text -> ImplementsInterfaces t)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"implements"
ParsecT Void Text Identity (t Text -> ImplementsInterfaces t)
-> ParsecT Void Text Identity (Maybe Text)
-> ParsecT Void Text Identity (t Text -> ImplementsInterfaces t)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
amp
ParsecT Void Text Identity (t Text -> ImplementsInterfaces t)
-> Parser (t Text) -> Parser (ImplementsInterfaces t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser (t Text)
`sepBy'` ParsecT Void Text Identity Text
amp
Parser (ImplementsInterfaces t)
-> String -> Parser (ImplementsInterfaces t)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ImplementsInterfaces"
inputValueDefinition :: Parser Full.InputValueDefinition
inputValueDefinition :: Parser InputValueDefinition
inputValueDefinition = Description
-> Text
-> Type
-> Maybe (Node ConstValue)
-> [Directive]
-> InputValueDefinition
Full.InputValueDefinition
(Description
-> Text
-> Type
-> Maybe (Node ConstValue)
-> [Directive]
-> InputValueDefinition)
-> Parser Description
-> ParsecT
Void
Text
Identity
(Text
-> Type
-> Maybe (Node ConstValue)
-> [Directive]
-> InputValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Description
description
ParsecT
Void
Text
Identity
(Text
-> Type
-> Maybe (Node ConstValue)
-> [Directive]
-> InputValueDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(Type
-> Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(Type
-> Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
-> Parser ()
-> ParsecT
Void
Text
Identity
(Type
-> Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon
ParsecT
Void
Text
Identity
(Type
-> Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
-> ParsecT Void Text Identity Type
-> ParsecT
Void
Text
Identity
(Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Type
type'
ParsecT
Void
Text
Identity
(Maybe (Node ConstValue) -> [Directive] -> InputValueDefinition)
-> ParsecT Void Text Identity (Maybe (Node ConstValue))
-> ParsecT Void Text Identity ([Directive] -> InputValueDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (Maybe (Node ConstValue))
defaultValue
ParsecT Void Text Identity ([Directive] -> InputValueDefinition)
-> ParsecT Void Text Identity [Directive]
-> Parser InputValueDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
Parser InputValueDefinition
-> String -> Parser InputValueDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"InputValueDefinition"
argumentsDefinition :: Parser Full.ArgumentsDefinition
argumentsDefinition :: ParsecT Void Text Identity ArgumentsDefinition
argumentsDefinition = [InputValueDefinition] -> ArgumentsDefinition
Full.ArgumentsDefinition
([InputValueDefinition] -> ArgumentsDefinition)
-> ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity ArgumentsDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity [InputValueDefinition])
-> Parser InputValueDefinition
-> ParsecT Void Text Identity [InputValueDefinition]
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn ParsecT Void Text Identity [InputValueDefinition]
-> ParsecT Void Text Identity [InputValueDefinition]
forall a. Parser a -> Parser a
parens Parser InputValueDefinition
inputValueDefinition
ParsecT Void Text Identity ArgumentsDefinition
-> String -> ParsecT Void Text Identity ArgumentsDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ArgumentsDefinition"
fieldDefinition :: Parser Full.FieldDefinition
fieldDefinition :: ParsecT Void Text Identity FieldDefinition
fieldDefinition = Description
-> Text
-> ArgumentsDefinition
-> Type
-> [Directive]
-> FieldDefinition
Full.FieldDefinition
(Description
-> Text
-> ArgumentsDefinition
-> Type
-> [Directive]
-> FieldDefinition)
-> Parser Description
-> ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition -> Type -> [Directive] -> FieldDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Description
description
ParsecT
Void
Text
Identity
(Text
-> ArgumentsDefinition -> Type -> [Directive] -> FieldDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
(ArgumentsDefinition -> Type -> [Directive] -> FieldDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT
Void
Text
Identity
(ArgumentsDefinition -> Type -> [Directive] -> FieldDefinition)
-> ParsecT Void Text Identity ArgumentsDefinition
-> ParsecT
Void Text Identity (Type -> [Directive] -> FieldDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity ArgumentsDefinition
argumentsDefinition
ParsecT Void Text Identity (Type -> [Directive] -> FieldDefinition)
-> Parser ()
-> ParsecT
Void Text Identity (Type -> [Directive] -> FieldDefinition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon
ParsecT Void Text Identity (Type -> [Directive] -> FieldDefinition)
-> ParsecT Void Text Identity Type
-> ParsecT Void Text Identity ([Directive] -> FieldDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Type
type'
ParsecT Void Text Identity ([Directive] -> FieldDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT Void Text Identity FieldDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT Void Text Identity FieldDefinition
-> String -> ParsecT Void Text Identity FieldDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"FieldDefinition"
schemaDefinition :: Parser Full.TypeSystemDefinition
schemaDefinition :: Parser TypeSystemDefinition
schemaDefinition = [Directive]
-> NonEmpty OperationTypeDefinition -> TypeSystemDefinition
Full.SchemaDefinition
([Directive]
-> NonEmpty OperationTypeDefinition -> TypeSystemDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT
Void
Text
Identity
([Directive]
-> NonEmpty OperationTypeDefinition -> TypeSystemDefinition)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"schema"
ParsecT
Void
Text
Identity
([Directive]
-> NonEmpty OperationTypeDefinition -> TypeSystemDefinition)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void
Text
Identity
(NonEmpty OperationTypeDefinition -> TypeSystemDefinition)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void
Text
Identity
(NonEmpty OperationTypeDefinition -> TypeSystemDefinition)
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
-> Parser TypeSystemDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
operationTypeDefinitions
Parser TypeSystemDefinition
-> String -> Parser TypeSystemDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"SchemaDefinition"
operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition)
operationTypeDefinitions :: ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
operationTypeDefinitions = ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition))
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity OperationTypeDefinition
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity OperationTypeDefinition
operationTypeDefinition
schemaExtension :: Parser Full.SchemaExtension
schemaExtension :: ParsecT Void Text Identity SchemaExtension
schemaExtension = Text
-> String
-> NonEmpty (ParsecT Void Text Identity SchemaExtension)
-> ParsecT Void Text Identity SchemaExtension
forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
extend Text
"schema" String
"SchemaExtension"
(NonEmpty (ParsecT Void Text Identity SchemaExtension)
-> ParsecT Void Text Identity SchemaExtension)
-> NonEmpty (ParsecT Void Text Identity SchemaExtension)
-> ParsecT Void Text Identity SchemaExtension
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity SchemaExtension
schemaOperationExtension ParsecT Void Text Identity SchemaExtension
-> [ParsecT Void Text Identity SchemaExtension]
-> NonEmpty (ParsecT Void Text Identity SchemaExtension)
forall a. a -> [a] -> NonEmpty a
:| [ParsecT Void Text Identity SchemaExtension
directivesExtension]
where
directivesExtension :: ParsecT Void Text Identity SchemaExtension
directivesExtension = NonEmpty Directive -> SchemaExtension
Full.SchemaDirectivesExtension
(NonEmpty Directive -> SchemaExtension)
-> ParsecT Void Text Identity (NonEmpty Directive)
-> ParsecT Void Text Identity SchemaExtension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity (NonEmpty Directive)
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Directive
directive
schemaOperationExtension :: ParsecT Void Text Identity SchemaExtension
schemaOperationExtension = [Directive] -> NonEmpty OperationTypeDefinition -> SchemaExtension
Full.SchemaOperationExtension
([Directive]
-> NonEmpty OperationTypeDefinition -> SchemaExtension)
-> ParsecT Void Text Identity [Directive]
-> ParsecT
Void
Text
Identity
(NonEmpty OperationTypeDefinition -> SchemaExtension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Directive]
directives
ParsecT
Void
Text
Identity
(NonEmpty OperationTypeDefinition -> SchemaExtension)
-> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
-> ParsecT Void Text Identity SchemaExtension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity (NonEmpty OperationTypeDefinition)
operationTypeDefinitions
operationTypeDefinition :: Parser Full.OperationTypeDefinition
operationTypeDefinition :: ParsecT Void Text Identity OperationTypeDefinition
operationTypeDefinition = OperationType -> Text -> OperationTypeDefinition
Full.OperationTypeDefinition
(OperationType -> Text -> OperationTypeDefinition)
-> ParsecT Void Text Identity OperationType
-> ParsecT Void Text Identity (Text -> OperationTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity OperationType
operationType ParsecT Void Text Identity (Text -> OperationTypeDefinition)
-> Parser ()
-> ParsecT Void Text Identity (Text -> OperationTypeDefinition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon
ParsecT Void Text Identity (Text -> OperationTypeDefinition)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OperationTypeDefinition
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity OperationTypeDefinition
-> String -> ParsecT Void Text Identity OperationTypeDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"OperationTypeDefinition"
operationDefinition :: Parser Full.OperationDefinition
operationDefinition :: ParsecT Void Text Identity OperationDefinition
operationDefinition = ParsecT Void Text Identity OperationDefinition
shorthand
ParsecT Void Text Identity OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity OperationDefinition
operationDefinition'
ParsecT Void Text Identity OperationDefinition
-> String -> ParsecT Void Text Identity OperationDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"OperationDefinition"
where
shorthand :: ParsecT Void Text Identity OperationDefinition
shorthand = do
Location
location <- Parser Location
getLocation
SelectionSet
selectionSet' <- Parser SelectionSet
selectionSet
OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationDefinition
-> ParsecT Void Text Identity OperationDefinition)
-> OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
forall a b. (a -> b) -> a -> b
$ SelectionSet -> Location -> OperationDefinition
Full.SelectionSet SelectionSet
selectionSet' Location
location
operationDefinition' :: ParsecT Void Text Identity OperationDefinition
operationDefinition' = do
Location
location <- Parser Location
getLocation
OperationType
operationType' <- ParsecT Void Text Identity OperationType
operationType
Maybe Text
operationName <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
name
[VariableDefinition]
variableDefinitions' <- Parser [VariableDefinition]
variableDefinitions
[Directive]
directives' <- ParsecT Void Text Identity [Directive]
directives
SelectionSet
selectionSet' <- Parser SelectionSet
selectionSet
OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationDefinition
-> ParsecT Void Text Identity OperationDefinition)
-> OperationDefinition
-> ParsecT Void Text Identity OperationDefinition
forall a b. (a -> b) -> a -> b
$ OperationType
-> Maybe Text
-> [VariableDefinition]
-> [Directive]
-> SelectionSet
-> Location
-> OperationDefinition
Full.OperationDefinition
OperationType
operationType'
Maybe Text
operationName
[VariableDefinition]
variableDefinitions'
[Directive]
directives'
SelectionSet
selectionSet'
Location
location
operationType :: Parser Full.OperationType
operationType :: ParsecT Void Text Identity OperationType
operationType = OperationType
Full.Query OperationType
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OperationType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"query"
ParsecT Void Text Identity OperationType
-> ParsecT Void Text Identity OperationType
-> ParsecT Void Text Identity OperationType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OperationType
Full.Mutation OperationType
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OperationType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"mutation"
ParsecT Void Text Identity OperationType
-> ParsecT Void Text Identity OperationType
-> ParsecT Void Text Identity OperationType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OperationType
Full.Subscription OperationType
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OperationType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"subscription"
ParsecT Void Text Identity OperationType
-> String -> ParsecT Void Text Identity OperationType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"OperationType"
selectionSet :: Parser Full.SelectionSet
selectionSet :: Parser SelectionSet
selectionSet = Parser SelectionSet -> Parser SelectionSet
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity Selection -> Parser SelectionSet
forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
NonEmpty.some ParsecT Void Text Identity Selection
selection) Parser SelectionSet -> String -> Parser SelectionSet
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"SelectionSet"
selectionSetOpt :: Parser Full.SelectionSetOpt
selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = (Parser SelectionSetOpt -> Parser SelectionSetOpt)
-> ParsecT Void Text Identity Selection -> Parser SelectionSetOpt
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn Parser SelectionSetOpt -> Parser SelectionSetOpt
forall a. Parser a -> Parser a
braces ParsecT Void Text Identity Selection
selection Parser SelectionSetOpt -> String -> Parser SelectionSetOpt
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"SelectionSet"
selection :: Parser Full.Selection
selection :: ParsecT Void Text Identity Selection
selection = Field -> Selection
Full.FieldSelection (Field -> Selection)
-> ParsecT Void Text Identity Field
-> ParsecT Void Text Identity Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Field
field
ParsecT Void Text Identity Selection
-> ParsecT Void Text Identity Selection
-> ParsecT Void Text Identity Selection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FragmentSpread -> Selection
Full.FragmentSpreadSelection (FragmentSpread -> Selection)
-> ParsecT Void Text Identity FragmentSpread
-> ParsecT Void Text Identity Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity FragmentSpread
-> ParsecT Void Text Identity FragmentSpread
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity FragmentSpread
fragmentSpread
ParsecT Void Text Identity Selection
-> ParsecT Void Text Identity Selection
-> ParsecT Void Text Identity Selection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InlineFragment -> Selection
Full.InlineFragmentSelection (InlineFragment -> Selection)
-> ParsecT Void Text Identity InlineFragment
-> ParsecT Void Text Identity Selection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity InlineFragment
inlineFragment
ParsecT Void Text Identity Selection
-> String -> ParsecT Void Text Identity Selection
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Selection"
field :: Parser Full.Field
field :: ParsecT Void Text Identity Field
field = String
-> ParsecT Void Text Identity Field
-> ParsecT Void Text Identity Field
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Field" (ParsecT Void Text Identity Field
-> ParsecT Void Text Identity Field)
-> ParsecT Void Text Identity Field
-> ParsecT Void Text Identity Field
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Maybe Text
alias' <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
alias
Text
name' <- ParsecT Void Text Identity Text
name
[Argument]
arguments' <- Parser [Argument]
arguments
[Directive]
directives' <- ParsecT Void Text Identity [Directive]
directives
SelectionSetOpt
selectionSetOpt' <- Parser SelectionSetOpt
selectionSetOpt
Field -> ParsecT Void Text Identity Field
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field -> ParsecT Void Text Identity Field)
-> Field -> ParsecT Void Text Identity Field
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> [Argument]
-> [Directive]
-> SelectionSetOpt
-> Location
-> Field
Full.Field Maybe Text
alias' Text
name' [Argument]
arguments' [Directive]
directives' SelectionSetOpt
selectionSetOpt' Location
location
alias :: Parser Full.Name
alias :: ParsecT Void Text Identity Text
alias = ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> Parser () -> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
colon) ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Alias"
arguments :: Parser [Full.Argument]
arguments :: Parser [Argument]
arguments = (Parser [Argument] -> Parser [Argument])
-> Parser Argument -> Parser [Argument]
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn Parser [Argument] -> Parser [Argument]
forall a. Parser a -> Parser a
parens Parser Argument
argument Parser [Argument] -> String -> Parser [Argument]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Arguments"
argument :: Parser Full.Argument
argument :: Parser Argument
argument = String -> Parser Argument -> Parser Argument
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Argument" (Parser Argument -> Parser Argument)
-> Parser Argument -> Parser Argument
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
name' <- ParsecT Void Text Identity Text
name
Parser ()
colon
Node Value
value' <- Parser Value -> Parser (Node Value)
forall a. Parser a -> Parser (Node a)
valueNode Parser Value
value
Argument -> Parser Argument
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argument -> Parser Argument) -> Argument -> Parser Argument
forall a b. (a -> b) -> a -> b
$ Text -> Node Value -> Location -> Argument
Full.Argument Text
name' Node Value
value' Location
location
fragmentSpread :: Parser Full.FragmentSpread
fragmentSpread :: ParsecT Void Text Identity FragmentSpread
fragmentSpread = String
-> ParsecT Void Text Identity FragmentSpread
-> ParsecT Void Text Identity FragmentSpread
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentSpread" (ParsecT Void Text Identity FragmentSpread
-> ParsecT Void Text Identity FragmentSpread)
-> ParsecT Void Text Identity FragmentSpread
-> ParsecT Void Text Identity FragmentSpread
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
_ <- ParsecT Void Text Identity Text
spread
Text
fragmentName' <- ParsecT Void Text Identity Text
fragmentName
[Directive]
directives' <- ParsecT Void Text Identity [Directive]
directives
FragmentSpread -> ParsecT Void Text Identity FragmentSpread
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FragmentSpread -> ParsecT Void Text Identity FragmentSpread)
-> FragmentSpread -> ParsecT Void Text Identity FragmentSpread
forall a b. (a -> b) -> a -> b
$ Text -> [Directive] -> Location -> FragmentSpread
Full.FragmentSpread Text
fragmentName' [Directive]
directives' Location
location
inlineFragment :: Parser Full.InlineFragment
inlineFragment :: ParsecT Void Text Identity InlineFragment
inlineFragment = String
-> ParsecT Void Text Identity InlineFragment
-> ParsecT Void Text Identity InlineFragment
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InlineFragment" (ParsecT Void Text Identity InlineFragment
-> ParsecT Void Text Identity InlineFragment)
-> ParsecT Void Text Identity InlineFragment
-> ParsecT Void Text Identity InlineFragment
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
_ <- ParsecT Void Text Identity Text
spread
Maybe Text
typeCondition' <- ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity Text
typeCondition
[Directive]
directives' <- ParsecT Void Text Identity [Directive]
directives
SelectionSet
selectionSet' <- Parser SelectionSet
selectionSet
InlineFragment -> ParsecT Void Text Identity InlineFragment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InlineFragment -> ParsecT Void Text Identity InlineFragment)
-> InlineFragment -> ParsecT Void Text Identity InlineFragment
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> [Directive] -> SelectionSet -> Location -> InlineFragment
Full.InlineFragment Maybe Text
typeCondition' [Directive]
directives' SelectionSet
selectionSet' Location
location
fragmentDefinition :: Parser Full.FragmentDefinition
fragmentDefinition :: ParsecT Void Text Identity FragmentDefinition
fragmentDefinition = String
-> ParsecT Void Text Identity FragmentDefinition
-> ParsecT Void Text Identity FragmentDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentDefinition" (ParsecT Void Text Identity FragmentDefinition
-> ParsecT Void Text Identity FragmentDefinition)
-> ParsecT Void Text Identity FragmentDefinition
-> ParsecT Void Text Identity FragmentDefinition
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
_ <- Text -> ParsecT Void Text Identity Text
symbol Text
"fragment"
Text
fragmentName' <- ParsecT Void Text Identity Text
name
Text
typeCondition' <- ParsecT Void Text Identity Text
typeCondition
[Directive]
directives' <- ParsecT Void Text Identity [Directive]
directives
SelectionSet
selectionSet' <- Parser SelectionSet
selectionSet
FragmentDefinition -> ParsecT Void Text Identity FragmentDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FragmentDefinition
-> ParsecT Void Text Identity FragmentDefinition)
-> FragmentDefinition
-> ParsecT Void Text Identity FragmentDefinition
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> [Directive]
-> SelectionSet
-> Location
-> FragmentDefinition
Full.FragmentDefinition
Text
fragmentName' Text
typeCondition' [Directive]
directives' SelectionSet
selectionSet' Location
location
fragmentName :: Parser Full.Name
fragmentName :: ParsecT Void Text Identity Text
fragmentName = ParsecT Void Text Identity Text -> Parser ()
forall a. Parser a -> Parser ()
but (Text -> ParsecT Void Text Identity Text
symbol Text
"on") Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"FragmentName"
typeCondition :: Parser Full.TypeCondition
typeCondition :: ParsecT Void Text Identity Text
typeCondition = Text -> ParsecT Void Text Identity Text
symbol Text
"on" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"TypeCondition"
valueNode :: forall a. Parser a -> Parser (Full.Node a)
valueNode :: Parser a -> Parser (Node a)
valueNode Parser a
valueParser = do
Location
location <- Parser Location
getLocation
a
value' <- Parser a
valueParser
Node a -> Parser (Node a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node a -> Parser (Node a)) -> Node a -> Parser (Node a)
forall a b. (a -> b) -> a -> b
$ a -> Location -> Node a
forall a. a -> Location -> Node a
Full.Node a
value' Location
location
value :: Parser Full.Value
value :: Parser Value
value = Text -> Value
Full.Variable (Text -> Value) -> ParsecT Void Text Identity Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
variable
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Value
Full.Float (Double -> Value)
-> ParsecT Void Text Identity Double -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Double
float
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int32 -> Value
Full.Int (Int32 -> Value)
-> ParsecT Void Text Identity Int32 -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int32
forall a. Integral a => Parser a
integer
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Value
Full.Boolean (Bool -> Value) -> ParsecT Void Text Identity Bool -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Bool
booleanValue
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value
Full.Null Value -> ParsecT Void Text Identity Text -> Parser Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
nullValue
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Value
Full.String (Text -> Value) -> ParsecT Void Text Identity Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
stringValue
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Value
Full.Enum (Text -> Value) -> ParsecT Void Text Identity Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
enumValue
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Node Value] -> Value
Full.List ([Node Value] -> Value)
-> ParsecT Void Text Identity [Node Value] -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Node Value]
-> ParsecT Void Text Identity [Node Value]
forall a. Parser a -> Parser a
brackets (Parser (Node Value) -> ParsecT Void Text Identity [Node Value]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser (Node Value) -> ParsecT Void Text Identity [Node Value])
-> Parser (Node Value) -> ParsecT Void Text Identity [Node Value]
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Node Value)
forall a. Parser a -> Parser (Node a)
valueNode Parser Value
value)
Parser Value -> Parser Value -> Parser Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ObjectField Value] -> Value
Full.Object ([ObjectField Value] -> Value)
-> ParsecT Void Text Identity [ObjectField Value] -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [ObjectField Value]
-> ParsecT Void Text Identity [ObjectField Value]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (ObjectField Value)
-> ParsecT Void Text Identity [ObjectField Value]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT Void Text Identity (ObjectField Value)
-> ParsecT Void Text Identity [ObjectField Value])
-> ParsecT Void Text Identity (ObjectField Value)
-> ParsecT Void Text Identity [ObjectField Value]
forall a b. (a -> b) -> a -> b
$ Parser (Node Value)
-> ParsecT Void Text Identity (ObjectField Value)
forall a. Parser (Node a) -> Parser (ObjectField a)
objectField (Parser (Node Value)
-> ParsecT Void Text Identity (ObjectField Value))
-> Parser (Node Value)
-> ParsecT Void Text Identity (ObjectField Value)
forall a b. (a -> b) -> a -> b
$ Parser Value -> Parser (Node Value)
forall a. Parser a -> Parser (Node a)
valueNode Parser Value
value)
Parser Value -> String -> Parser Value
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Value"
constValue :: Parser Full.ConstValue
constValue :: Parser ConstValue
constValue = Double -> ConstValue
Full.ConstFloat (Double -> ConstValue)
-> ParsecT Void Text Identity Double -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Double
float
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int32 -> ConstValue
Full.ConstInt (Int32 -> ConstValue)
-> ParsecT Void Text Identity Int32 -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int32
forall a. Integral a => Parser a
integer
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ConstValue
Full.ConstBoolean (Bool -> ConstValue)
-> ParsecT Void Text Identity Bool -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Bool
booleanValue
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConstValue
Full.ConstNull ConstValue -> ParsecT Void Text Identity Text -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
nullValue
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ConstValue
Full.ConstString (Text -> ConstValue)
-> ParsecT Void Text Identity Text -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
stringValue
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ConstValue
Full.ConstEnum (Text -> ConstValue)
-> ParsecT Void Text Identity Text -> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
enumValue
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Node ConstValue] -> ConstValue
Full.ConstList ([Node ConstValue] -> ConstValue)
-> ParsecT Void Text Identity [Node ConstValue]
-> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [Node ConstValue]
-> ParsecT Void Text Identity [Node ConstValue]
forall a. Parser a -> Parser a
brackets (ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity [Node ConstValue]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity [Node ConstValue])
-> ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity [Node ConstValue]
forall a b. (a -> b) -> a -> b
$ Parser ConstValue -> ParsecT Void Text Identity (Node ConstValue)
forall a. Parser a -> Parser (Node a)
valueNode Parser ConstValue
constValue)
Parser ConstValue -> Parser ConstValue -> Parser ConstValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ObjectField ConstValue] -> ConstValue
Full.ConstObject ([ObjectField ConstValue] -> ConstValue)
-> ParsecT Void Text Identity [ObjectField ConstValue]
-> Parser ConstValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [ObjectField ConstValue]
-> ParsecT Void Text Identity [ObjectField ConstValue]
forall a. Parser a -> Parser a
braces (ParsecT Void Text Identity (ObjectField ConstValue)
-> ParsecT Void Text Identity [ObjectField ConstValue]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity (ObjectField ConstValue)
-> ParsecT Void Text Identity [ObjectField ConstValue])
-> ParsecT Void Text Identity (ObjectField ConstValue)
-> ParsecT Void Text Identity [ObjectField ConstValue]
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity (ObjectField ConstValue)
forall a. Parser (Node a) -> Parser (ObjectField a)
objectField (ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity (ObjectField ConstValue))
-> ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity (ObjectField ConstValue)
forall a b. (a -> b) -> a -> b
$ Parser ConstValue -> ParsecT Void Text Identity (Node ConstValue)
forall a. Parser a -> Parser (Node a)
valueNode Parser ConstValue
constValue)
Parser ConstValue -> String -> Parser ConstValue
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Value"
booleanValue :: Parser Bool
booleanValue :: ParsecT Void Text Identity Bool
booleanValue = Bool
True Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"true"
ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool
False Bool
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
symbol Text
"false"
ParsecT Void Text Identity Bool
-> String -> ParsecT Void Text Identity Bool
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"BooleanValue"
enumValue :: Parser Full.Name
enumValue :: ParsecT Void Text Identity Text
enumValue = ParsecT Void Text Identity Text -> Parser ()
forall a. Parser a -> Parser ()
but (Text -> ParsecT Void Text Identity Text
symbol Text
"true")
Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parser ()
forall a. Parser a -> Parser ()
but (Text -> ParsecT Void Text Identity Text
symbol Text
"false")
Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text -> Parser ()
forall a. Parser a -> Parser ()
but (Text -> ParsecT Void Text Identity Text
symbol Text
"null")
Parser ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"EnumValue"
stringValue :: Parser Text
stringValue :: ParsecT Void Text Identity Text
stringValue = ParsecT Void Text Identity Text
blockString ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
string ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"StringValue"
nullValue :: Parser Text
nullValue :: ParsecT Void Text Identity Text
nullValue = Text -> ParsecT Void Text Identity Text
symbol Text
"null" ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"NullValue"
objectField :: forall a. Parser (Full.Node a) -> Parser (Full.ObjectField a)
objectField :: Parser (Node a) -> Parser (ObjectField a)
objectField Parser (Node a)
valueParser = String -> Parser (ObjectField a) -> Parser (ObjectField a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"ObjectField" (Parser (ObjectField a) -> Parser (ObjectField a))
-> Parser (ObjectField a) -> Parser (ObjectField a)
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
fieldName <- ParsecT Void Text Identity Text
name
Parser ()
colon
Node a
fieldValue <- Parser (Node a)
valueParser
ObjectField a -> Parser (ObjectField a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectField a -> Parser (ObjectField a))
-> ObjectField a -> Parser (ObjectField a)
forall a b. (a -> b) -> a -> b
$ Text -> Node a -> Location -> ObjectField a
forall a. Text -> Node a -> Location -> ObjectField a
Full.ObjectField Text
fieldName Node a
fieldValue Location
location
variableDefinitions :: Parser [Full.VariableDefinition]
variableDefinitions :: Parser [VariableDefinition]
variableDefinitions = (Parser [VariableDefinition] -> Parser [VariableDefinition])
-> Parser VariableDefinition -> Parser [VariableDefinition]
forall a. (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn Parser [VariableDefinition] -> Parser [VariableDefinition]
forall a. Parser a -> Parser a
parens Parser VariableDefinition
variableDefinition
Parser [VariableDefinition]
-> String -> Parser [VariableDefinition]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"VariableDefinitions"
variableDefinition :: Parser Full.VariableDefinition
variableDefinition :: Parser VariableDefinition
variableDefinition = String -> Parser VariableDefinition -> Parser VariableDefinition
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"VariableDefinition" (Parser VariableDefinition -> Parser VariableDefinition)
-> Parser VariableDefinition -> Parser VariableDefinition
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Text
variableName <- ParsecT Void Text Identity Text
variable
Parser ()
colon
Type
variableType <- ParsecT Void Text Identity Type
type'
Maybe (Node ConstValue)
variableValue <- ParsecT Void Text Identity (Maybe (Node ConstValue))
defaultValue
VariableDefinition -> Parser VariableDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VariableDefinition -> Parser VariableDefinition)
-> VariableDefinition -> Parser VariableDefinition
forall a b. (a -> b) -> a -> b
$ Text
-> Type
-> Maybe (Node ConstValue)
-> Location
-> VariableDefinition
Full.VariableDefinition Text
variableName Type
variableType Maybe (Node ConstValue)
variableValue Location
location
variable :: Parser Full.Name
variable :: ParsecT Void Text Identity Text
variable = ParsecT Void Text Identity Text
dollar ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
name ParsecT Void Text Identity Text
-> String -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Variable"
defaultValue :: Parser (Maybe (Full.Node Full.ConstValue))
defaultValue :: ParsecT Void Text Identity (Maybe (Node ConstValue))
defaultValue = ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity (Maybe (Node ConstValue))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Text
equals ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Node ConstValue)
-> ParsecT Void Text Identity (Node ConstValue)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ConstValue -> ParsecT Void Text Identity (Node ConstValue)
forall a. Parser a -> Parser (Node a)
valueNode Parser ConstValue
constValue) ParsecT Void Text Identity (Maybe (Node ConstValue))
-> String -> ParsecT Void Text Identity (Maybe (Node ConstValue))
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"DefaultValue"
type' :: Parser Full.Type
type' :: ParsecT Void Text Identity Type
type' = ParsecT Void Text Identity Type -> ParsecT Void Text Identity Type
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (NonNullType -> Type
Full.TypeNonNull (NonNullType -> Type)
-> ParsecT Void Text Identity NonNullType
-> ParsecT Void Text Identity Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity NonNullType
nonNullType)
ParsecT Void Text Identity Type
-> ParsecT Void Text Identity Type
-> ParsecT Void Text Identity Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Type -> Type
Full.TypeList (Type -> Type)
-> ParsecT Void Text Identity Type
-> ParsecT Void Text Identity Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Type -> ParsecT Void Text Identity Type
forall a. Parser a -> Parser a
brackets ParsecT Void Text Identity Type
type'
ParsecT Void Text Identity Type
-> ParsecT Void Text Identity Type
-> ParsecT Void Text Identity Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Type
Full.TypeNamed (Text -> Type)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name
ParsecT Void Text Identity Type
-> String -> ParsecT Void Text Identity Type
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Type"
nonNullType :: Parser Full.NonNullType
nonNullType :: ParsecT Void Text Identity NonNullType
nonNullType = Text -> NonNullType
Full.NonNullTypeNamed (Text -> NonNullType)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity NonNullType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
name ParsecT Void Text Identity NonNullType
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity NonNullType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
bang
ParsecT Void Text Identity NonNullType
-> ParsecT Void Text Identity NonNullType
-> ParsecT Void Text Identity NonNullType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Type -> NonNullType
Full.NonNullTypeList (Type -> NonNullType)
-> ParsecT Void Text Identity Type
-> ParsecT Void Text Identity NonNullType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Type -> ParsecT Void Text Identity Type
forall a. Parser a -> Parser a
brackets ParsecT Void Text Identity Type
type' ParsecT Void Text Identity NonNullType
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity NonNullType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
bang
ParsecT Void Text Identity NonNullType
-> String -> ParsecT Void Text Identity NonNullType
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"NonNullType"
directives :: Parser [Full.Directive]
directives :: ParsecT Void Text Identity [Directive]
directives = ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity [Directive]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Void Text Identity Directive
directive ParsecT Void Text Identity [Directive]
-> String -> ParsecT Void Text Identity [Directive]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"Directives"
directive :: Parser Full.Directive
directive :: ParsecT Void Text Identity Directive
directive = String
-> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity Directive
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Directive" (ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity Directive)
-> ParsecT Void Text Identity Directive
-> ParsecT Void Text Identity Directive
forall a b. (a -> b) -> a -> b
$ do
Location
location <- Parser Location
getLocation
Parser ()
at
Text
directiveName <- ParsecT Void Text Identity Text
name
[Argument]
directiveArguments <- Parser [Argument]
arguments
Directive -> ParsecT Void Text Identity Directive
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directive -> ParsecT Void Text Identity Directive)
-> Directive -> ParsecT Void Text Identity Directive
forall a b. (a -> b) -> a -> b
$ Text -> [Argument] -> Location -> Directive
Full.Directive Text
directiveName [Argument]
directiveArguments Location
location
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn Parser [a] -> Parser [a]
surround = [a] -> Parser [a] -> Parser [a]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [a] -> Parser [a]
surround (Parser [a] -> Parser [a])
-> (Parser a -> Parser [a]) -> Parser a -> Parser [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
but :: Parser a -> Parser ()
but :: Parser a -> Parser ()
but Parser a
pn = Bool
False Bool -> Parser a -> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead Parser a
pn ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ParsecT Void Text Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True ParsecT Void Text Identity Bool -> (Bool -> Parser ()) -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty
Bool
True -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()