forked from OSS/graphql
Validate input object field names
This commit is contained in:
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
@ -18,7 +19,7 @@ import Language.GraphQL.AST.DirectiveLocation
|
||||
, ExecutableDirectiveLocation
|
||||
, TypeSystemDirectiveLocation
|
||||
)
|
||||
import Language.GraphQL.AST.Document
|
||||
import qualified Language.GraphQL.AST.Document as Full
|
||||
import Language.GraphQL.AST.Lexer
|
||||
import Text.Megaparsec
|
||||
( MonadParsec(..)
|
||||
@ -32,13 +33,13 @@ import Text.Megaparsec
|
||||
)
|
||||
|
||||
-- | Parser for the GraphQL documents.
|
||||
document :: Parser Document
|
||||
document :: Parser Full.Document
|
||||
document = unicodeBOM
|
||||
*> spaceConsumer
|
||||
*> lexeme (NonEmpty.some definition)
|
||||
|
||||
definition :: Parser Definition
|
||||
definition = ExecutableDefinition <$> executableDefinition
|
||||
definition :: Parser Full.Definition
|
||||
definition = Full.ExecutableDefinition <$> executableDefinition
|
||||
<|> typeSystemDefinition'
|
||||
<|> typeSystemExtension'
|
||||
<?> "Definition"
|
||||
@ -46,41 +47,41 @@ definition = ExecutableDefinition <$> executableDefinition
|
||||
typeSystemDefinition' = do
|
||||
location <- getLocation
|
||||
definition' <- typeSystemDefinition
|
||||
pure $ TypeSystemDefinition definition' location
|
||||
pure $ Full.TypeSystemDefinition definition' location
|
||||
typeSystemExtension' = do
|
||||
location <- getLocation
|
||||
definition' <- typeSystemExtension
|
||||
pure $ TypeSystemExtension definition' location
|
||||
pure $ Full.TypeSystemExtension definition' location
|
||||
|
||||
getLocation :: Parser Location
|
||||
getLocation :: Parser Full.Location
|
||||
getLocation = fromSourcePosition <$> getSourcePos
|
||||
where
|
||||
fromSourcePosition SourcePos{..} =
|
||||
Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
|
||||
Full.Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
|
||||
wordFromPosition = fromIntegral . unPos
|
||||
|
||||
executableDefinition :: Parser ExecutableDefinition
|
||||
executableDefinition = DefinitionOperation <$> operationDefinition
|
||||
<|> DefinitionFragment <$> fragmentDefinition
|
||||
executableDefinition :: Parser Full.ExecutableDefinition
|
||||
executableDefinition = Full.DefinitionOperation <$> operationDefinition
|
||||
<|> Full.DefinitionFragment <$> fragmentDefinition
|
||||
<?> "ExecutableDefinition"
|
||||
|
||||
typeSystemDefinition :: Parser TypeSystemDefinition
|
||||
typeSystemDefinition :: Parser Full.TypeSystemDefinition
|
||||
typeSystemDefinition = schemaDefinition
|
||||
<|> typeSystemDefinitionWithDescription
|
||||
<?> "TypeSystemDefinition"
|
||||
where
|
||||
typeSystemDefinitionWithDescription = description
|
||||
>>= liftA2 (<|>) typeDefinition' directiveDefinition
|
||||
typeDefinition' description' = TypeDefinition
|
||||
typeDefinition' description' = Full.TypeDefinition
|
||||
<$> typeDefinition description'
|
||||
|
||||
typeSystemExtension :: Parser TypeSystemExtension
|
||||
typeSystemExtension = SchemaExtension <$> schemaExtension
|
||||
<|> TypeExtension <$> typeExtension
|
||||
typeSystemExtension :: Parser Full.TypeSystemExtension
|
||||
typeSystemExtension = Full.SchemaExtension <$> schemaExtension
|
||||
<|> Full.TypeExtension <$> typeExtension
|
||||
<?> "TypeSystemExtension"
|
||||
|
||||
directiveDefinition :: Description -> Parser TypeSystemDefinition
|
||||
directiveDefinition description' = DirectiveDefinition description'
|
||||
directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition
|
||||
directiveDefinition description' = Full.DirectiveDefinition description'
|
||||
<$ symbol "directive"
|
||||
<* at
|
||||
<*> name
|
||||
@ -124,7 +125,7 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
|
||||
<|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
|
||||
<?> "TypeSystemDirectiveLocation"
|
||||
|
||||
typeDefinition :: Description -> Parser TypeDefinition
|
||||
typeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
typeDefinition description' = scalarTypeDefinition description'
|
||||
<|> objectTypeDefinition description'
|
||||
<|> interfaceTypeDefinition description'
|
||||
@ -133,7 +134,7 @@ typeDefinition description' = scalarTypeDefinition description'
|
||||
<|> inputObjectTypeDefinition description'
|
||||
<?> "TypeDefinition"
|
||||
|
||||
typeExtension :: Parser TypeExtension
|
||||
typeExtension :: Parser Full.TypeExtension
|
||||
typeExtension = scalarTypeExtension
|
||||
<|> objectTypeExtension
|
||||
<|> interfaceTypeExtension
|
||||
@ -142,143 +143,143 @@ typeExtension = scalarTypeExtension
|
||||
<|> inputObjectTypeExtension
|
||||
<?> "TypeExtension"
|
||||
|
||||
scalarTypeDefinition :: Description -> Parser TypeDefinition
|
||||
scalarTypeDefinition description' = ScalarTypeDefinition description'
|
||||
scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
scalarTypeDefinition description' = Full.ScalarTypeDefinition description'
|
||||
<$ symbol "scalar"
|
||||
<*> name
|
||||
<*> directives
|
||||
<?> "ScalarTypeDefinition"
|
||||
|
||||
scalarTypeExtension :: Parser TypeExtension
|
||||
scalarTypeExtension :: Parser Full.TypeExtension
|
||||
scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
|
||||
$ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
|
||||
$ (Full.ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
|
||||
|
||||
objectTypeDefinition :: Description -> Parser TypeDefinition
|
||||
objectTypeDefinition description' = ObjectTypeDefinition description'
|
||||
objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
objectTypeDefinition description' = Full.ObjectTypeDefinition description'
|
||||
<$ symbol "type"
|
||||
<*> name
|
||||
<*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> directives
|
||||
<*> braces (many fieldDefinition)
|
||||
<?> "ObjectTypeDefinition"
|
||||
|
||||
objectTypeExtension :: Parser TypeExtension
|
||||
objectTypeExtension :: Parser Full.TypeExtension
|
||||
objectTypeExtension = extend "type" "ObjectTypeExtension"
|
||||
$ fieldsDefinitionExtension :|
|
||||
[ directivesExtension
|
||||
, implementsInterfacesExtension
|
||||
]
|
||||
where
|
||||
fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension
|
||||
fieldsDefinitionExtension = Full.ObjectTypeFieldsDefinitionExtension
|
||||
<$> name
|
||||
<*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> directives
|
||||
<*> braces (NonEmpty.some fieldDefinition)
|
||||
directivesExtension = ObjectTypeDirectivesExtension
|
||||
directivesExtension = Full.ObjectTypeDirectivesExtension
|
||||
<$> name
|
||||
<*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
|
||||
<*> NonEmpty.some directive
|
||||
implementsInterfacesExtension = ObjectTypeImplementsInterfacesExtension
|
||||
implementsInterfacesExtension = Full.ObjectTypeImplementsInterfacesExtension
|
||||
<$> name
|
||||
<*> implementsInterfaces NonEmpty.sepBy1
|
||||
|
||||
description :: Parser Description
|
||||
description = Description
|
||||
description :: Parser Full.Description
|
||||
description = Full.Description
|
||||
<$> optional stringValue
|
||||
<?> "Description"
|
||||
|
||||
unionTypeDefinition :: Description -> Parser TypeDefinition
|
||||
unionTypeDefinition description' = UnionTypeDefinition description'
|
||||
unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
unionTypeDefinition description' = Full.UnionTypeDefinition description'
|
||||
<$ symbol "union"
|
||||
<*> name
|
||||
<*> directives
|
||||
<*> option (UnionMemberTypes []) (unionMemberTypes sepBy1)
|
||||
<*> option (Full.UnionMemberTypes []) (unionMemberTypes sepBy1)
|
||||
<?> "UnionTypeDefinition"
|
||||
|
||||
unionTypeExtension :: Parser TypeExtension
|
||||
unionTypeExtension :: Parser Full.TypeExtension
|
||||
unionTypeExtension = extend "union" "UnionTypeExtension"
|
||||
$ unionMemberTypesExtension :| [directivesExtension]
|
||||
where
|
||||
unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension
|
||||
unionMemberTypesExtension = Full.UnionTypeUnionMemberTypesExtension
|
||||
<$> name
|
||||
<*> directives
|
||||
<*> unionMemberTypes NonEmpty.sepBy1
|
||||
directivesExtension = UnionTypeDirectivesExtension
|
||||
directivesExtension = Full.UnionTypeDirectivesExtension
|
||||
<$> name
|
||||
<*> NonEmpty.some directive
|
||||
|
||||
unionMemberTypes ::
|
||||
Foldable t =>
|
||||
(Parser Text -> Parser Text -> Parser (t NamedType)) ->
|
||||
Parser (UnionMemberTypes t)
|
||||
unionMemberTypes sepBy' = UnionMemberTypes
|
||||
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
|
||||
Parser (Full.UnionMemberTypes t)
|
||||
unionMemberTypes sepBy' = Full.UnionMemberTypes
|
||||
<$ equals
|
||||
<* optional pipe
|
||||
<*> name `sepBy'` pipe
|
||||
<?> "UnionMemberTypes"
|
||||
|
||||
interfaceTypeDefinition :: Description -> Parser TypeDefinition
|
||||
interfaceTypeDefinition description' = InterfaceTypeDefinition description'
|
||||
interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
|
||||
<$ symbol "interface"
|
||||
<*> name
|
||||
<*> directives
|
||||
<*> braces (many fieldDefinition)
|
||||
<?> "InterfaceTypeDefinition"
|
||||
|
||||
interfaceTypeExtension :: Parser TypeExtension
|
||||
interfaceTypeExtension :: Parser Full.TypeExtension
|
||||
interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
|
||||
$ fieldsDefinitionExtension :| [directivesExtension]
|
||||
where
|
||||
fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension
|
||||
fieldsDefinitionExtension = Full.InterfaceTypeFieldsDefinitionExtension
|
||||
<$> name
|
||||
<*> directives
|
||||
<*> braces (NonEmpty.some fieldDefinition)
|
||||
directivesExtension = InterfaceTypeDirectivesExtension
|
||||
directivesExtension = Full.InterfaceTypeDirectivesExtension
|
||||
<$> name
|
||||
<*> NonEmpty.some directive
|
||||
|
||||
enumTypeDefinition :: Description -> Parser TypeDefinition
|
||||
enumTypeDefinition description' = EnumTypeDefinition description'
|
||||
enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
enumTypeDefinition description' = Full.EnumTypeDefinition description'
|
||||
<$ symbol "enum"
|
||||
<*> name
|
||||
<*> directives
|
||||
<*> listOptIn braces enumValueDefinition
|
||||
<?> "EnumTypeDefinition"
|
||||
|
||||
enumTypeExtension :: Parser TypeExtension
|
||||
enumTypeExtension :: Parser Full.TypeExtension
|
||||
enumTypeExtension = extend "enum" "EnumTypeExtension"
|
||||
$ enumValuesDefinitionExtension :| [directivesExtension]
|
||||
where
|
||||
enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension
|
||||
enumValuesDefinitionExtension = Full.EnumTypeEnumValuesDefinitionExtension
|
||||
<$> name
|
||||
<*> directives
|
||||
<*> braces (NonEmpty.some enumValueDefinition)
|
||||
directivesExtension = EnumTypeDirectivesExtension
|
||||
directivesExtension = Full.EnumTypeDirectivesExtension
|
||||
<$> name
|
||||
<*> NonEmpty.some directive
|
||||
|
||||
inputObjectTypeDefinition :: Description -> Parser TypeDefinition
|
||||
inputObjectTypeDefinition description' = InputObjectTypeDefinition description'
|
||||
inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
|
||||
inputObjectTypeDefinition description' = Full.InputObjectTypeDefinition description'
|
||||
<$ symbol "input"
|
||||
<*> name
|
||||
<*> directives
|
||||
<*> listOptIn braces inputValueDefinition
|
||||
<?> "InputObjectTypeDefinition"
|
||||
|
||||
inputObjectTypeExtension :: Parser TypeExtension
|
||||
inputObjectTypeExtension :: Parser Full.TypeExtension
|
||||
inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
|
||||
$ inputFieldsDefinitionExtension :| [directivesExtension]
|
||||
where
|
||||
inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension
|
||||
inputFieldsDefinitionExtension = Full.InputObjectTypeInputFieldsDefinitionExtension
|
||||
<$> name
|
||||
<*> directives
|
||||
<*> braces (NonEmpty.some inputValueDefinition)
|
||||
directivesExtension = InputObjectTypeDirectivesExtension
|
||||
directivesExtension = Full.InputObjectTypeDirectivesExtension
|
||||
<$> name
|
||||
<*> NonEmpty.some directive
|
||||
|
||||
enumValueDefinition :: Parser EnumValueDefinition
|
||||
enumValueDefinition = EnumValueDefinition
|
||||
enumValueDefinition :: Parser Full.EnumValueDefinition
|
||||
enumValueDefinition = Full.EnumValueDefinition
|
||||
<$> description
|
||||
<*> enumValue
|
||||
<*> directives
|
||||
@ -286,16 +287,16 @@ enumValueDefinition = EnumValueDefinition
|
||||
|
||||
implementsInterfaces ::
|
||||
Foldable t =>
|
||||
(Parser Text -> Parser Text -> Parser (t NamedType)) ->
|
||||
Parser (ImplementsInterfaces t)
|
||||
implementsInterfaces sepBy' = ImplementsInterfaces
|
||||
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
|
||||
Parser (Full.ImplementsInterfaces t)
|
||||
implementsInterfaces sepBy' = Full.ImplementsInterfaces
|
||||
<$ symbol "implements"
|
||||
<* optional amp
|
||||
<*> name `sepBy'` amp
|
||||
<?> "ImplementsInterfaces"
|
||||
|
||||
inputValueDefinition :: Parser InputValueDefinition
|
||||
inputValueDefinition = InputValueDefinition
|
||||
inputValueDefinition :: Parser Full.InputValueDefinition
|
||||
inputValueDefinition = Full.InputValueDefinition
|
||||
<$> description
|
||||
<*> name
|
||||
<* colon
|
||||
@ -304,13 +305,13 @@ inputValueDefinition = InputValueDefinition
|
||||
<*> directives
|
||||
<?> "InputValueDefinition"
|
||||
|
||||
argumentsDefinition :: Parser ArgumentsDefinition
|
||||
argumentsDefinition = ArgumentsDefinition
|
||||
argumentsDefinition :: Parser Full.ArgumentsDefinition
|
||||
argumentsDefinition = Full.ArgumentsDefinition
|
||||
<$> listOptIn parens inputValueDefinition
|
||||
<?> "ArgumentsDefinition"
|
||||
|
||||
fieldDefinition :: Parser FieldDefinition
|
||||
fieldDefinition = FieldDefinition
|
||||
fieldDefinition :: Parser Full.FieldDefinition
|
||||
fieldDefinition = Full.FieldDefinition
|
||||
<$> description
|
||||
<*> name
|
||||
<*> argumentsDefinition
|
||||
@ -319,33 +320,33 @@ fieldDefinition = FieldDefinition
|
||||
<*> directives
|
||||
<?> "FieldDefinition"
|
||||
|
||||
schemaDefinition :: Parser TypeSystemDefinition
|
||||
schemaDefinition = SchemaDefinition
|
||||
schemaDefinition :: Parser Full.TypeSystemDefinition
|
||||
schemaDefinition = Full.SchemaDefinition
|
||||
<$ symbol "schema"
|
||||
<*> directives
|
||||
<*> operationTypeDefinitions
|
||||
<?> "SchemaDefinition"
|
||||
|
||||
operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition)
|
||||
operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition)
|
||||
operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
|
||||
|
||||
schemaExtension :: Parser SchemaExtension
|
||||
schemaExtension :: Parser Full.SchemaExtension
|
||||
schemaExtension = extend "schema" "SchemaExtension"
|
||||
$ schemaOperationExtension :| [directivesExtension]
|
||||
where
|
||||
directivesExtension = SchemaDirectivesExtension
|
||||
directivesExtension = Full.SchemaDirectivesExtension
|
||||
<$> NonEmpty.some directive
|
||||
schemaOperationExtension = SchemaOperationExtension
|
||||
schemaOperationExtension = Full.SchemaOperationExtension
|
||||
<$> directives
|
||||
<*> operationTypeDefinitions
|
||||
|
||||
operationTypeDefinition :: Parser OperationTypeDefinition
|
||||
operationTypeDefinition = OperationTypeDefinition
|
||||
operationTypeDefinition :: Parser Full.OperationTypeDefinition
|
||||
operationTypeDefinition = Full.OperationTypeDefinition
|
||||
<$> operationType <* colon
|
||||
<*> name
|
||||
<?> "OperationTypeDefinition"
|
||||
|
||||
operationDefinition :: Parser OperationDefinition
|
||||
operationDefinition :: Parser Full.OperationDefinition
|
||||
operationDefinition = shorthand
|
||||
<|> operationDefinition'
|
||||
<?> "OperationDefinition"
|
||||
@ -353,7 +354,7 @@ operationDefinition = shorthand
|
||||
shorthand = do
|
||||
location <- getLocation
|
||||
selectionSet' <- selectionSet
|
||||
pure $ SelectionSet selectionSet' location
|
||||
pure $ Full.SelectionSet selectionSet' location
|
||||
operationDefinition' = do
|
||||
location <- getLocation
|
||||
operationType' <- operationType
|
||||
@ -361,27 +362,33 @@ operationDefinition = shorthand
|
||||
variableDefinitions' <- variableDefinitions
|
||||
directives' <- directives
|
||||
selectionSet' <- selectionSet
|
||||
pure $ OperationDefinition operationType' operationName variableDefinitions' directives' selectionSet' location
|
||||
pure $ Full.OperationDefinition
|
||||
operationType'
|
||||
operationName
|
||||
variableDefinitions'
|
||||
directives'
|
||||
selectionSet'
|
||||
location
|
||||
|
||||
operationType :: Parser OperationType
|
||||
operationType = Query <$ symbol "query"
|
||||
<|> Mutation <$ symbol "mutation"
|
||||
<|> Subscription <$ symbol "subscription"
|
||||
operationType :: Parser Full.OperationType
|
||||
operationType = Full.Query <$ symbol "query"
|
||||
<|> Full.Mutation <$ symbol "mutation"
|
||||
<|> Full.Subscription <$ symbol "subscription"
|
||||
<?> "OperationType"
|
||||
|
||||
selectionSet :: Parser SelectionSet
|
||||
selectionSet :: Parser Full.SelectionSet
|
||||
selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
|
||||
|
||||
selectionSetOpt :: Parser SelectionSetOpt
|
||||
selectionSetOpt :: Parser Full.SelectionSetOpt
|
||||
selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
|
||||
|
||||
selection :: Parser Selection
|
||||
selection = FieldSelection <$> field
|
||||
<|> FragmentSpreadSelection <$> try fragmentSpread
|
||||
<|> InlineFragmentSelection <$> inlineFragment
|
||||
selection :: Parser Full.Selection
|
||||
selection = Full.FieldSelection <$> field
|
||||
<|> Full.FragmentSpreadSelection <$> try fragmentSpread
|
||||
<|> Full.InlineFragmentSelection <$> inlineFragment
|
||||
<?> "Selection"
|
||||
|
||||
field :: Parser Field
|
||||
field :: Parser Full.Field
|
||||
field = label "Field" $ do
|
||||
location <- getLocation
|
||||
alias' <- optional alias
|
||||
@ -389,40 +396,40 @@ field = label "Field" $ do
|
||||
arguments' <- arguments
|
||||
directives' <- directives
|
||||
selectionSetOpt' <- selectionSetOpt
|
||||
pure $ Field alias' name' arguments' directives' selectionSetOpt' location
|
||||
pure $ Full.Field alias' name' arguments' directives' selectionSetOpt' location
|
||||
|
||||
alias :: Parser Name
|
||||
alias :: Parser Full.Name
|
||||
alias = try (name <* colon) <?> "Alias"
|
||||
|
||||
arguments :: Parser [Argument]
|
||||
arguments :: Parser [Full.Argument]
|
||||
arguments = listOptIn parens argument <?> "Arguments"
|
||||
|
||||
argument :: Parser Argument
|
||||
argument :: Parser Full.Argument
|
||||
argument = label "Argument" $ do
|
||||
location <- getLocation
|
||||
name' <- name
|
||||
colon
|
||||
value' <- valueNode
|
||||
pure $ Argument name' value' location
|
||||
value' <- valueNode value
|
||||
pure $ Full.Argument name' value' location
|
||||
|
||||
fragmentSpread :: Parser FragmentSpread
|
||||
fragmentSpread :: Parser Full.FragmentSpread
|
||||
fragmentSpread = label "FragmentSpread" $ do
|
||||
location <- getLocation
|
||||
_ <- spread
|
||||
fragmentName' <- fragmentName
|
||||
directives' <- directives
|
||||
pure $ FragmentSpread fragmentName' directives' location
|
||||
pure $ Full.FragmentSpread fragmentName' directives' location
|
||||
|
||||
inlineFragment :: Parser InlineFragment
|
||||
inlineFragment :: Parser Full.InlineFragment
|
||||
inlineFragment = label "InlineFragment" $ do
|
||||
location <- getLocation
|
||||
_ <- spread
|
||||
typeCondition' <- optional typeCondition
|
||||
directives' <- directives
|
||||
selectionSet' <- selectionSet
|
||||
pure $ InlineFragment typeCondition' directives' selectionSet' location
|
||||
pure $ Full.InlineFragment typeCondition' directives' selectionSet' location
|
||||
|
||||
fragmentDefinition :: Parser FragmentDefinition
|
||||
fragmentDefinition :: Parser Full.FragmentDefinition
|
||||
fragmentDefinition = label "FragmentDefinition" $ do
|
||||
location <- getLocation
|
||||
_ <- symbol "fragment"
|
||||
@ -430,42 +437,42 @@ fragmentDefinition = label "FragmentDefinition" $ do
|
||||
typeCondition' <- typeCondition
|
||||
directives' <- directives
|
||||
selectionSet' <- selectionSet
|
||||
pure $ FragmentDefinition
|
||||
pure $ Full.FragmentDefinition
|
||||
fragmentName' typeCondition' directives' selectionSet' location
|
||||
|
||||
fragmentName :: Parser Name
|
||||
fragmentName :: Parser Full.Name
|
||||
fragmentName = but (symbol "on") *> name <?> "FragmentName"
|
||||
|
||||
typeCondition :: Parser TypeCondition
|
||||
typeCondition :: Parser Full.TypeCondition
|
||||
typeCondition = symbol "on" *> name <?> "TypeCondition"
|
||||
|
||||
valueNode :: Parser (Node Value)
|
||||
valueNode = do
|
||||
valueNode :: forall a. Parser a -> Parser (Full.Node a)
|
||||
valueNode valueParser = do
|
||||
location <- getLocation
|
||||
value' <- value
|
||||
pure $ Node value' location
|
||||
value' <- valueParser
|
||||
pure $ Full.Node value' location
|
||||
|
||||
value :: Parser Value
|
||||
value = Variable <$> variable
|
||||
<|> Float <$> try float
|
||||
<|> Int <$> integer
|
||||
<|> Boolean <$> booleanValue
|
||||
<|> Null <$ nullValue
|
||||
<|> String <$> stringValue
|
||||
<|> Enum <$> try enumValue
|
||||
<|> List <$> brackets (some value)
|
||||
<|> Object <$> braces (some $ objectField value)
|
||||
value :: Parser Full.Value
|
||||
value = Full.Variable <$> variable
|
||||
<|> Full.Float <$> try float
|
||||
<|> Full.Int <$> integer
|
||||
<|> Full.Boolean <$> booleanValue
|
||||
<|> Full.Null <$ nullValue
|
||||
<|> Full.String <$> stringValue
|
||||
<|> Full.Enum <$> try enumValue
|
||||
<|> Full.List <$> brackets (some value)
|
||||
<|> Full.Object <$> braces (some $ objectField value)
|
||||
<?> "Value"
|
||||
|
||||
constValue :: Parser ConstValue
|
||||
constValue = ConstFloat <$> try float
|
||||
<|> ConstInt <$> integer
|
||||
<|> ConstBoolean <$> booleanValue
|
||||
<|> ConstNull <$ nullValue
|
||||
<|> ConstString <$> stringValue
|
||||
<|> ConstEnum <$> try enumValue
|
||||
<|> ConstList <$> brackets (some constValue)
|
||||
<|> ConstObject <$> braces (some $ objectField constValue)
|
||||
constValue :: Parser Full.ConstValue
|
||||
constValue = Full.ConstFloat <$> try float
|
||||
<|> Full.ConstInt <$> integer
|
||||
<|> Full.ConstBoolean <$> booleanValue
|
||||
<|> Full.ConstNull <$ nullValue
|
||||
<|> Full.ConstString <$> stringValue
|
||||
<|> Full.ConstEnum <$> try enumValue
|
||||
<|> Full.ConstList <$> brackets (some constValue)
|
||||
<|> Full.ConstObject <$> braces (some $ objectField constValue)
|
||||
<?> "Value"
|
||||
|
||||
booleanValue :: Parser Bool
|
||||
@ -473,7 +480,7 @@ booleanValue = True <$ symbol "true"
|
||||
<|> False <$ symbol "false"
|
||||
<?> "BooleanValue"
|
||||
|
||||
enumValue :: Parser Name
|
||||
enumValue :: Parser Full.Name
|
||||
enumValue = but (symbol "true")
|
||||
*> but (symbol "false")
|
||||
*> but (symbol "null")
|
||||
@ -486,54 +493,54 @@ stringValue = blockString <|> string <?> "StringValue"
|
||||
nullValue :: Parser Text
|
||||
nullValue = symbol "null" <?> "NullValue"
|
||||
|
||||
objectField :: Parser a -> Parser (ObjectField a)
|
||||
objectField :: Parser a -> Parser (Full.ObjectField a)
|
||||
objectField valueParser = label "ObjectField" $ do
|
||||
location <- getLocation
|
||||
fieldName <- name
|
||||
colon
|
||||
fieldValue <- valueParser
|
||||
pure $ ObjectField fieldName fieldValue location
|
||||
pure $ Full.ObjectField fieldName fieldValue location
|
||||
|
||||
variableDefinitions :: Parser [VariableDefinition]
|
||||
variableDefinitions :: Parser [Full.VariableDefinition]
|
||||
variableDefinitions = listOptIn parens variableDefinition
|
||||
<?> "VariableDefinitions"
|
||||
|
||||
variableDefinition :: Parser VariableDefinition
|
||||
variableDefinition :: Parser Full.VariableDefinition
|
||||
variableDefinition = label "VariableDefinition" $ do
|
||||
location <- getLocation
|
||||
variableName <- variable
|
||||
colon
|
||||
variableType <- type'
|
||||
variableValue <- defaultValue
|
||||
pure $ VariableDefinition variableName variableType variableValue location
|
||||
pure $ Full.VariableDefinition variableName variableType variableValue location
|
||||
|
||||
variable :: Parser Name
|
||||
variable :: Parser Full.Name
|
||||
variable = dollar *> name <?> "Variable"
|
||||
|
||||
defaultValue :: Parser (Maybe ConstValue)
|
||||
defaultValue = optional (equals *> constValue) <?> "DefaultValue"
|
||||
defaultValue :: Parser (Maybe (Full.Node Full.ConstValue))
|
||||
defaultValue = optional (equals *> valueNode constValue) <?> "DefaultValue"
|
||||
|
||||
type' :: Parser Type
|
||||
type' = try (TypeNonNull <$> nonNullType)
|
||||
<|> TypeList <$> brackets type'
|
||||
<|> TypeNamed <$> name
|
||||
type' :: Parser Full.Type
|
||||
type' = try (Full.TypeNonNull <$> nonNullType)
|
||||
<|> Full.TypeList <$> brackets type'
|
||||
<|> Full.TypeNamed <$> name
|
||||
<?> "Type"
|
||||
|
||||
nonNullType :: Parser NonNullType
|
||||
nonNullType = NonNullTypeNamed <$> name <* bang
|
||||
<|> NonNullTypeList <$> brackets type' <* bang
|
||||
nonNullType :: Parser Full.NonNullType
|
||||
nonNullType = Full.NonNullTypeNamed <$> name <* bang
|
||||
<|> Full.NonNullTypeList <$> brackets type' <* bang
|
||||
<?> "NonNullType"
|
||||
|
||||
directives :: Parser [Directive]
|
||||
directives :: Parser [Full.Directive]
|
||||
directives = many directive <?> "Directives"
|
||||
|
||||
directive :: Parser Directive
|
||||
directive :: Parser Full.Directive
|
||||
directive = label "Directive" $ do
|
||||
location <- getLocation
|
||||
at
|
||||
directiveName <- name
|
||||
directiveArguments <- arguments
|
||||
pure $ Directive directiveName directiveArguments location
|
||||
pure $ Full.Directive directiveName directiveArguments location
|
||||
|
||||
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
|
||||
listOptIn surround = option [] . surround . some
|
||||
|
||||
Reference in New Issue
Block a user