graphql/src/Language/GraphQL/AST/Parser.hs

553 lines
18 KiB
Haskell
Raw Normal View History

2020-09-30 05:14:52 +02:00
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
2019-06-21 10:44:58 +02:00
{-# LANGUAGE OverloadedStrings #-}
2020-07-20 21:29:12 +02:00
{-# LANGUAGE RecordWildCards #-}
-- | @GraphQL@ document parser.
module Language.GraphQL.AST.Parser
2019-07-14 05:58:05 +02:00
( document
) where
import Control.Applicative (Alternative(..), liftA2, optional)
import Control.Applicative.Combinators (sepBy1)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
2020-01-28 11:08:28 +01:00
import Data.List.NonEmpty (NonEmpty(..))
2020-01-07 13:56:58 +01:00
import Data.Text (Text)
2020-01-15 20:20:50 +01:00
import qualified Language.GraphQL.AST.DirectiveLocation as Directive
import Language.GraphQL.AST.DirectiveLocation
( DirectiveLocation
, ExecutableDirectiveLocation
, TypeSystemDirectiveLocation
)
2020-09-30 05:14:52 +02:00
import qualified Language.GraphQL.AST.Document as Full
import Language.GraphQL.AST.Lexer
2020-07-20 21:29:12 +02:00
import Text.Megaparsec
( MonadParsec(..)
, SourcePos(..)
2020-07-20 21:29:12 +02:00
, getSourcePos
, lookAhead
, option
, try
, unPos
, (<?>)
)
-- | Parser for the GraphQL documents.
2020-09-30 05:14:52 +02:00
document :: Parser Full.Document
document = unicodeBOM
*> spaceConsumer
*> lexeme (NonEmpty.some definition)
2020-09-30 05:14:52 +02:00
definition :: Parser Full.Definition
definition = Full.ExecutableDefinition <$> executableDefinition
2020-07-20 21:29:12 +02:00
<|> typeSystemDefinition'
<|> typeSystemExtension'
2020-01-03 07:20:48 +01:00
<?> "Definition"
2020-07-20 21:29:12 +02:00
where
typeSystemDefinition' = do
location <- getLocation
definition' <- typeSystemDefinition
2020-09-30 05:14:52 +02:00
pure $ Full.TypeSystemDefinition definition' location
2020-07-20 21:29:12 +02:00
typeSystemExtension' = do
location <- getLocation
definition' <- typeSystemExtension
2020-09-30 05:14:52 +02:00
pure $ Full.TypeSystemExtension definition' location
2020-07-20 21:29:12 +02:00
2020-09-30 05:14:52 +02:00
getLocation :: Parser Full.Location
2020-07-20 21:29:12 +02:00
getLocation = fromSourcePosition <$> getSourcePos
where
fromSourcePosition SourcePos{..} =
2020-09-30 05:14:52 +02:00
Full.Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
2020-07-20 21:29:12 +02:00
wordFromPosition = fromIntegral . unPos
2020-01-03 07:20:48 +01:00
2020-09-30 05:14:52 +02:00
executableDefinition :: Parser Full.ExecutableDefinition
executableDefinition = Full.DefinitionOperation <$> operationDefinition
<|> Full.DefinitionFragment <$> fragmentDefinition
2020-01-03 07:20:48 +01:00
<?> "ExecutableDefinition"
2020-09-30 05:14:52 +02:00
typeSystemDefinition :: Parser Full.TypeSystemDefinition
2020-01-03 07:20:48 +01:00
typeSystemDefinition = schemaDefinition
<|> typeSystemDefinitionWithDescription
2020-01-05 07:42:04 +01:00
<?> "TypeSystemDefinition"
where
typeSystemDefinitionWithDescription = description
>>= liftA2 (<|>) typeDefinition' directiveDefinition
2020-09-30 05:14:52 +02:00
typeDefinition' description' = Full.TypeDefinition
<$> typeDefinition description'
2020-01-05 07:42:04 +01:00
2020-09-30 05:14:52 +02:00
typeSystemExtension :: Parser Full.TypeSystemExtension
typeSystemExtension = Full.SchemaExtension <$> schemaExtension
<|> Full.TypeExtension <$> typeExtension
2020-01-25 16:37:17 +01:00
<?> "TypeSystemExtension"
2020-09-30 05:14:52 +02:00
directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition
directiveDefinition description' = Full.DirectiveDefinition description'
<$ symbol "directive"
2020-01-15 20:20:50 +01:00
<* at
<*> name
<*> argumentsDefinition
<* symbol "on"
<*> directiveLocations
<?> "DirectiveDefinition"
2020-01-15 20:20:50 +01:00
directiveLocations :: Parser (NonEmpty DirectiveLocation)
directiveLocations = optional pipe
*> directiveLocation `NonEmpty.sepBy1` pipe
<?> "DirectiveLocations"
2020-01-15 20:20:50 +01:00
directiveLocation :: Parser DirectiveLocation
directiveLocation
= Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
<|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
<?> "DirectiveLocation"
2020-01-15 20:20:50 +01:00
executableDirectiveLocation :: Parser ExecutableDirectiveLocation
executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
<|> Directive.Mutation <$ symbol "MUTATION"
<|> Directive.Subscription <$ symbol "SUBSCRIPTION"
<|> Directive.Field <$ symbol "FIELD"
<|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
<|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
<|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
<?> "ExecutableDirectiveLocation"
2020-01-15 20:20:50 +01:00
typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
<|> Directive.Scalar <$ symbol "SCALAR"
<|> Directive.Object <$ symbol "OBJECT"
<|> Directive.FieldDefinition <$ symbol "FIELD_DEFINITION"
<|> Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION"
<|> Directive.Interface <$ symbol "INTERFACE"
<|> Directive.Union <$ symbol "UNION"
<|> Directive.Enum <$ symbol "ENUM"
<|> Directive.EnumValue <$ symbol "ENUM_VALUE"
<|> Directive.InputObject <$ symbol "INPUT_OBJECT"
<|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
<?> "TypeSystemDirectiveLocation"
2020-01-15 20:20:50 +01:00
2020-09-30 05:14:52 +02:00
typeDefinition :: Full.Description -> Parser Full.TypeDefinition
typeDefinition description' = scalarTypeDefinition description'
<|> objectTypeDefinition description'
<|> interfaceTypeDefinition description'
<|> unionTypeDefinition description'
<|> enumTypeDefinition description'
<|> inputObjectTypeDefinition description'
2020-01-05 07:42:04 +01:00
<?> "TypeDefinition"
2020-09-30 05:14:52 +02:00
typeExtension :: Parser Full.TypeExtension
typeExtension = scalarTypeExtension
<|> objectTypeExtension
<|> interfaceTypeExtension
<|> unionTypeExtension
<|> enumTypeExtension
<|> inputObjectTypeExtension
<?> "TypeExtension"
2020-09-30 05:14:52 +02:00
scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
scalarTypeDefinition description' = Full.ScalarTypeDefinition description'
<$ symbol "scalar"
2020-01-05 07:42:04 +01:00
<*> name
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-05 07:42:04 +01:00
<?> "ScalarTypeDefinition"
2020-09-30 05:14:52 +02:00
scalarTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
2020-09-30 05:14:52 +02:00
$ (Full.ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
2020-09-30 05:14:52 +02:00
objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
objectTypeDefinition description' = Full.ObjectTypeDefinition description'
<$ symbol "type"
2020-01-05 07:42:04 +01:00
<*> name
2020-09-30 05:14:52 +02:00
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-05 07:42:04 +01:00
<*> braces (many fieldDefinition)
<?> "ObjectTypeDefinition"
2020-09-30 05:14:52 +02:00
objectTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
objectTypeExtension = extend "type" "ObjectTypeExtension"
$ fieldsDefinitionExtension :|
[ directivesExtension
, implementsInterfacesExtension
]
where
2020-09-30 05:14:52 +02:00
fieldsDefinitionExtension = Full.ObjectTypeFieldsDefinitionExtension
<$> name
2020-09-30 05:14:52 +02:00
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
<*> directives
<*> braces (NonEmpty.some fieldDefinition)
2020-09-30 05:14:52 +02:00
directivesExtension = Full.ObjectTypeDirectivesExtension
<$> name
2020-09-30 05:14:52 +02:00
<*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
<*> NonEmpty.some directive
2020-09-30 05:14:52 +02:00
implementsInterfacesExtension = Full.ObjectTypeImplementsInterfacesExtension
<$> name
<*> implementsInterfaces NonEmpty.sepBy1
2020-09-30 05:14:52 +02:00
description :: Parser Full.Description
description = Full.Description
<$> optional stringValue
2020-01-05 07:42:04 +01:00
<?> "Description"
2020-09-30 05:14:52 +02:00
unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
unionTypeDefinition description' = Full.UnionTypeDefinition description'
<$ symbol "union"
2020-01-07 13:56:58 +01:00
<*> name
2020-01-15 20:20:50 +01:00
<*> directives
2020-09-30 05:14:52 +02:00
<*> option (Full.UnionMemberTypes []) (unionMemberTypes sepBy1)
2020-01-07 13:56:58 +01:00
<?> "UnionTypeDefinition"
2020-09-30 05:14:52 +02:00
unionTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
unionTypeExtension = extend "union" "UnionTypeExtension"
$ unionMemberTypesExtension :| [directivesExtension]
where
2020-09-30 05:14:52 +02:00
unionMemberTypesExtension = Full.UnionTypeUnionMemberTypesExtension
<$> name
<*> directives
<*> unionMemberTypes NonEmpty.sepBy1
2020-09-30 05:14:52 +02:00
directivesExtension = Full.UnionTypeDirectivesExtension
<$> name
<*> NonEmpty.some directive
2020-01-07 13:56:58 +01:00
unionMemberTypes ::
Foldable t =>
2020-09-30 05:14:52 +02:00
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
Parser (Full.UnionMemberTypes t)
unionMemberTypes sepBy' = Full.UnionMemberTypes
2020-01-07 13:56:58 +01:00
<$ equals
<* optional pipe
<*> name `sepBy'` pipe
<?> "UnionMemberTypes"
2020-01-05 07:42:04 +01:00
2020-09-30 05:14:52 +02:00
interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
<$ symbol "interface"
2020-01-11 08:32:25 +01:00
<*> name
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-11 08:32:25 +01:00
<*> braces (many fieldDefinition)
<?> "InterfaceTypeDefinition"
2020-09-30 05:14:52 +02:00
interfaceTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
$ fieldsDefinitionExtension :| [directivesExtension]
where
2020-09-30 05:14:52 +02:00
fieldsDefinitionExtension = Full.InterfaceTypeFieldsDefinitionExtension
<$> name
<*> directives
<*> braces (NonEmpty.some fieldDefinition)
2020-09-30 05:14:52 +02:00
directivesExtension = Full.InterfaceTypeDirectivesExtension
<$> name
<*> NonEmpty.some directive
2020-09-30 05:14:52 +02:00
enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
enumTypeDefinition description' = Full.EnumTypeDefinition description'
<$ symbol "enum"
<*> name
2020-01-15 20:20:50 +01:00
<*> directives
<*> listOptIn braces enumValueDefinition
<?> "EnumTypeDefinition"
2020-09-30 05:14:52 +02:00
enumTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
enumTypeExtension = extend "enum" "EnumTypeExtension"
$ enumValuesDefinitionExtension :| [directivesExtension]
where
2020-09-30 05:14:52 +02:00
enumValuesDefinitionExtension = Full.EnumTypeEnumValuesDefinitionExtension
<$> name
<*> directives
<*> braces (NonEmpty.some enumValueDefinition)
2020-09-30 05:14:52 +02:00
directivesExtension = Full.EnumTypeDirectivesExtension
<$> name
<*> NonEmpty.some directive
2020-09-30 05:14:52 +02:00
inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
inputObjectTypeDefinition description' = Full.InputObjectTypeDefinition description'
<$ symbol "input"
<*> name
2020-01-15 20:20:50 +01:00
<*> directives
<*> listOptIn braces inputValueDefinition
<?> "InputObjectTypeDefinition"
2020-09-30 05:14:52 +02:00
inputObjectTypeExtension :: Parser Full.TypeExtension
2020-01-28 11:08:28 +01:00
inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
$ inputFieldsDefinitionExtension :| [directivesExtension]
where
2020-09-30 05:14:52 +02:00
inputFieldsDefinitionExtension = Full.InputObjectTypeInputFieldsDefinitionExtension
<$> name
<*> directives
<*> braces (NonEmpty.some inputValueDefinition)
2020-09-30 05:14:52 +02:00
directivesExtension = Full.InputObjectTypeDirectivesExtension
<$> name
<*> NonEmpty.some directive
2020-09-30 05:14:52 +02:00
enumValueDefinition :: Parser Full.EnumValueDefinition
enumValueDefinition = Full.EnumValueDefinition
<$> description
<*> enumValue
2020-01-15 20:20:50 +01:00
<*> directives
<?> "EnumValueDefinition"
2020-01-07 13:56:58 +01:00
implementsInterfaces ::
Foldable t =>
2020-09-30 05:14:52 +02:00
(Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
Parser (Full.ImplementsInterfaces t)
implementsInterfaces sepBy' = Full.ImplementsInterfaces
2020-01-05 07:42:04 +01:00
<$ symbol "implements"
<* optional amp
2020-01-07 13:56:58 +01:00
<*> name `sepBy'` amp
2020-01-05 07:42:04 +01:00
<?> "ImplementsInterfaces"
2020-09-30 05:14:52 +02:00
inputValueDefinition :: Parser Full.InputValueDefinition
inputValueDefinition = Full.InputValueDefinition
2020-01-05 07:42:04 +01:00
<$> description
<*> name
<* colon
<*> type'
<*> defaultValue
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-05 07:42:04 +01:00
<?> "InputValueDefinition"
2020-09-30 05:14:52 +02:00
argumentsDefinition :: Parser Full.ArgumentsDefinition
argumentsDefinition = Full.ArgumentsDefinition
2020-01-15 20:20:50 +01:00
<$> listOptIn parens inputValueDefinition
2020-01-05 07:42:04 +01:00
<?> "ArgumentsDefinition"
2020-09-30 05:14:52 +02:00
fieldDefinition :: Parser Full.FieldDefinition
fieldDefinition = Full.FieldDefinition
2020-01-05 07:42:04 +01:00
<$> description
<*> name
2020-01-15 20:20:50 +01:00
<*> argumentsDefinition
2020-01-05 07:42:04 +01:00
<* colon
<*> type'
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-05 07:42:04 +01:00
<?> "FieldDefinition"
2020-01-03 07:20:48 +01:00
2020-09-30 05:14:52 +02:00
schemaDefinition :: Parser Full.TypeSystemDefinition
schemaDefinition = Full.SchemaDefinition
2020-01-03 07:20:48 +01:00
<$ symbol "schema"
2020-01-15 20:20:50 +01:00
<*> directives
2020-01-03 07:20:48 +01:00
<*> operationTypeDefinitions
<?> "SchemaDefinition"
2020-01-25 16:37:17 +01:00
2020-09-30 05:14:52 +02:00
operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition)
2020-01-25 16:37:17 +01:00
operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
2020-09-30 05:14:52 +02:00
schemaExtension :: Parser Full.SchemaExtension
2020-01-28 11:08:28 +01:00
schemaExtension = extend "schema" "SchemaExtension"
$ schemaOperationExtension :| [directivesExtension]
where
2020-09-30 05:14:52 +02:00
directivesExtension = Full.SchemaDirectivesExtension
2020-01-28 11:08:28 +01:00
<$> NonEmpty.some directive
2020-09-30 05:14:52 +02:00
schemaOperationExtension = Full.SchemaOperationExtension
2020-01-25 16:37:17 +01:00
<$> directives
<*> operationTypeDefinitions
2020-01-03 07:20:48 +01:00
2020-09-30 05:14:52 +02:00
operationTypeDefinition :: Parser Full.OperationTypeDefinition
operationTypeDefinition = Full.OperationTypeDefinition
2020-01-03 07:20:48 +01:00
<$> operationType <* colon
<*> name
<?> "OperationTypeDefinition"
2020-09-30 05:14:52 +02:00
operationDefinition :: Parser Full.OperationDefinition
operationDefinition = shorthand
2019-12-28 07:07:58 +01:00
<|> operationDefinition'
<?> "OperationDefinition"
2019-12-28 07:07:58 +01:00
where
shorthand = do
location <- getLocation
selectionSet' <- selectionSet
2020-09-30 05:14:52 +02:00
pure $ Full.SelectionSet selectionSet' location
operationDefinition' = do
location <- getLocation
operationType' <- operationType
operationName <- optional name
variableDefinitions' <- variableDefinitions
directives' <- directives
selectionSet' <- selectionSet
2020-09-30 05:14:52 +02:00
pure $ Full.OperationDefinition
operationType'
operationName
variableDefinitions'
directives'
selectionSet'
location
operationType :: Parser Full.OperationType
operationType = Full.Query <$ symbol "query"
<|> Full.Mutation <$ symbol "mutation"
<|> Full.Subscription <$ symbol "subscription"
2020-07-11 06:34:10 +02:00
<?> "OperationType"
2020-09-30 05:14:52 +02:00
selectionSet :: Parser Full.SelectionSet
selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
2020-09-30 05:14:52 +02:00
selectionSetOpt :: Parser Full.SelectionSetOpt
selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
2020-09-30 05:14:52 +02:00
selection :: Parser Full.Selection
selection = Full.FieldSelection <$> field
<|> Full.FragmentSpreadSelection <$> try fragmentSpread
<|> Full.InlineFragmentSelection <$> inlineFragment
<?> "Selection"
2020-09-30 05:14:52 +02:00
field :: Parser Full.Field
field = label "Field" $ do
location <- getLocation
alias' <- optional alias
name' <- name
arguments' <- arguments
directives' <- directives
selectionSetOpt' <- selectionSetOpt
2020-09-30 05:14:52 +02:00
pure $ Full.Field alias' name' arguments' directives' selectionSetOpt' location
2020-09-30 05:14:52 +02:00
alias :: Parser Full.Name
alias = try (name <* colon) <?> "Alias"
2020-09-30 05:14:52 +02:00
arguments :: Parser [Full.Argument]
arguments = listOptIn parens argument <?> "Arguments"
2020-09-30 05:14:52 +02:00
argument :: Parser Full.Argument
argument = label "Argument" $ do
location <- getLocation
name' <- name
colon
2020-09-30 05:14:52 +02:00
value' <- valueNode value
pure $ Full.Argument name' value' location
2020-09-30 05:14:52 +02:00
fragmentSpread :: Parser Full.FragmentSpread
fragmentSpread = label "FragmentSpread" $ do
location <- getLocation
_ <- spread
fragmentName' <- fragmentName
directives' <- directives
2020-09-30 05:14:52 +02:00
pure $ Full.FragmentSpread fragmentName' directives' location
2020-09-30 05:14:52 +02:00
inlineFragment :: Parser Full.InlineFragment
inlineFragment = label "InlineFragment" $ do
location <- getLocation
_ <- spread
typeCondition' <- optional typeCondition
directives' <- directives
selectionSet' <- selectionSet
2020-09-30 05:14:52 +02:00
pure $ Full.InlineFragment typeCondition' directives' selectionSet' location
2020-09-30 05:14:52 +02:00
fragmentDefinition :: Parser Full.FragmentDefinition
fragmentDefinition = label "FragmentDefinition" $ do
location <- getLocation
_ <- symbol "fragment"
fragmentName' <- name
typeCondition' <- typeCondition
directives' <- directives
selectionSet' <- selectionSet
2020-09-30 05:14:52 +02:00
pure $ Full.FragmentDefinition
fragmentName' typeCondition' directives' selectionSet' location
2020-09-30 05:14:52 +02:00
fragmentName :: Parser Full.Name
fragmentName = but (symbol "on") *> name <?> "FragmentName"
2020-09-30 05:14:52 +02:00
typeCondition :: Parser Full.TypeCondition
typeCondition = symbol "on" *> name <?> "TypeCondition"
2020-09-30 05:14:52 +02:00
valueNode :: forall a. Parser a -> Parser (Full.Node a)
valueNode valueParser = do
2020-09-21 07:28:40 +02:00
location <- getLocation
2020-09-30 05:14:52 +02:00
value' <- valueParser
pure $ Full.Node value' location
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"
2020-09-30 05:14:52 +02:00
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"
2020-05-22 10:11:48 +02:00
booleanValue :: Parser Bool
booleanValue = True <$ symbol "true"
<|> False <$ symbol "false"
<?> "BooleanValue"
2020-09-30 05:14:52 +02:00
enumValue :: Parser Full.Name
enumValue = but (symbol "true")
*> but (symbol "false")
*> but (symbol "null")
*> name
<?> "EnumValue"
stringValue :: Parser Text
stringValue = blockString <|> string <?> "StringValue"
nullValue :: Parser Text
nullValue = symbol "null" <?> "NullValue"
2020-09-30 05:14:52 +02:00
objectField :: Parser a -> Parser (Full.ObjectField a)
objectField valueParser = label "ObjectField" $ do
location <- getLocation
fieldName <- name
colon
fieldValue <- valueParser
2020-09-30 05:14:52 +02:00
pure $ Full.ObjectField fieldName fieldValue location
2020-09-30 05:14:52 +02:00
variableDefinitions :: Parser [Full.VariableDefinition]
variableDefinitions = listOptIn parens variableDefinition
<?> "VariableDefinitions"
2020-09-30 05:14:52 +02:00
variableDefinition :: Parser Full.VariableDefinition
2020-09-19 18:18:26 +02:00
variableDefinition = label "VariableDefinition" $ do
location <- getLocation
variableName <- variable
colon
variableType <- type'
variableValue <- defaultValue
2020-09-30 05:14:52 +02:00
pure $ Full.VariableDefinition variableName variableType variableValue location
2020-09-30 05:14:52 +02:00
variable :: Parser Full.Name
variable = dollar *> name <?> "Variable"
2020-09-30 05:14:52 +02:00
defaultValue :: Parser (Maybe (Full.Node Full.ConstValue))
defaultValue = optional (equals *> valueNode constValue) <?> "DefaultValue"
2020-09-30 05:14:52 +02:00
type' :: Parser Full.Type
type' = try (Full.TypeNonNull <$> nonNullType)
<|> Full.TypeList <$> brackets type'
<|> Full.TypeNamed <$> name
2020-01-05 07:42:04 +01:00
<?> "Type"
2020-09-30 05:14:52 +02:00
nonNullType :: Parser Full.NonNullType
nonNullType = Full.NonNullTypeNamed <$> name <* bang
<|> Full.NonNullTypeList <$> brackets type' <* bang
<?> "NonNullType"
2020-09-30 05:14:52 +02:00
directives :: Parser [Full.Directive]
directives = many directive <?> "Directives"
2020-09-30 05:14:52 +02:00
directive :: Parser Full.Directive
directive = label "Directive" $ do
location <- getLocation
at
directiveName <- name
directiveArguments <- arguments
2020-09-30 05:14:52 +02:00
pure $ Full.Directive directiveName directiveArguments location
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn surround = option [] . surround . some
-- Hack to reverse parser success
but :: Parser a -> Parser ()
but pn = False <$ lookAhead pn <|> pure True >>= \case
2019-06-21 10:44:58 +02:00
False -> empty
True -> pure ()