summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2020-07-10 08:43:47 +0200
committerEugen Wissner <belka@caraus.de>2020-07-10 08:43:47 +0200
commit04a58be3f86ced396eed26f90643e7c88e7f2b4d (patch)
tree10bfeac6558586c62454931a39cf1338d18bc745
parent28781586a5ecf31630730ef0d8dbdbfe6041e7d3 (diff)
downloadgraphql-04a58be3f86ced396eed26f90643e7c88e7f2b4d.tar.gz
Label parsers with help info
Fixes #36.
-rw-r--r--CHANGELOG.md2
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs6
-rw-r--r--src/Language/GraphQL/AST/Parser.hs99
3 files changed, 57 insertions, 50 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 23a9391..6267247 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -11,6 +11,8 @@ and this project adheres to
- Location of a parse error is returned in a singleton array with key
`locations`.
- Parsing comments in the front of definitions.
+- Some missing labels were added to the parsers, some labels were fixed to
+ refer to the AST nodes being parsed.
## Added
- `AST` reexports `AST.Parser`.
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index 0ba55e3..17d3f9c 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -168,11 +168,11 @@ blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
-- | Parser for integers.
integer :: Integral a => Parser a
-integer = Lexer.signed (pure ()) $ lexeme Lexer.decimal
+integer = Lexer.signed (pure ()) (lexeme Lexer.decimal) <?> "IntValue"
-- | Parser for floating-point numbers.
float :: Parser Double
-float = Lexer.signed (pure ()) $ lexeme Lexer.float
+float = Lexer.signed (pure ()) (lexeme Lexer.float) <?> "FloatValue"
-- | Parser for names (/[_A-Za-z][_0-9A-Za-z]*/).
name :: Parser T.Text
@@ -233,4 +233,4 @@ extend token extensionLabel parsers
tryExtension extensionParser = try
$ symbol "extend"
*> symbol token
- *> extensionParser \ No newline at end of file
+ *> extensionParser
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index 58b2afb..150586e 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -66,11 +66,13 @@ directiveDefinition description' = DirectiveDefinition description'
directiveLocations :: Parser (NonEmpty DirectiveLocation)
directiveLocations = optional pipe
*> directiveLocation `NonEmpty.sepBy1` pipe
+ <?> "DirectiveLocations"
directiveLocation :: Parser DirectiveLocation
directiveLocation
= Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
<|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
+ <?> "DirectiveLocation"
executableDirectiveLocation :: Parser ExecutableDirectiveLocation
executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
@@ -80,6 +82,7 @@ executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
<|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
<|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
<|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
+ <?> "ExecutableDirectiveLocation"
typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
@@ -93,6 +96,7 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
<|> Directive.EnumValue <$ symbol "ENUM_VALUE"
<|> Directive.InputObject <$ symbol "INPUT_OBJECT"
<|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
+ <?> "TypeSystemDirectiveLocation"
typeDefinition :: Description -> Parser TypeDefinition
typeDefinition description' = scalarTypeDefinition description'
@@ -154,7 +158,7 @@ objectTypeExtension = extend "type" "ObjectTypeExtension"
description :: Parser Description
description = Description
- <$> optional (blockString <|> string)
+ <$> optional stringValue
<?> "Description"
unionTypeDefinition :: Description -> Parser TypeDefinition
@@ -318,7 +322,7 @@ operationTypeDefinition = OperationTypeDefinition
operationDefinition :: Parser OperationDefinition
operationDefinition = SelectionSet <$> selectionSet
<|> operationDefinition'
- <?> "operationDefinition error"
+ <?> "OperationDefinition"
where
operationDefinition'
= OperationDefinition <$> operationType
@@ -332,21 +336,17 @@ operationType = Query <$ symbol "query"
<|> Mutation <$ symbol "mutation"
-- <?> Keep default error message
--- * SelectionSet
-
selectionSet :: Parser SelectionSet
-selectionSet = braces $ NonEmpty.some selection
+selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
selectionSetOpt :: Parser SelectionSetOpt
-selectionSetOpt = listOptIn braces selection
+selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
selection :: Parser Selection
selection = field
<|> try fragmentSpread
<|> inlineFragment
- <?> "selection error!"
-
--- * Field
+ <?> "Selection"
field :: Parser Selection
field = Field
@@ -355,25 +355,23 @@ field = Field
<*> arguments
<*> directives
<*> selectionSetOpt
+ <?> "Field"
alias :: Parser Alias
-alias = try $ name <* colon
-
--- * Arguments
+alias = try (name <* colon) <?> "Alias"
arguments :: Parser [Argument]
-arguments = listOptIn parens argument
+arguments = listOptIn parens argument <?> "Arguments"
argument :: Parser Argument
-argument = Argument <$> name <* colon <*> value
-
--- * Fragments
+argument = Argument <$> name <* colon <*> value <?> "Argument"
fragmentSpread :: Parser Selection
fragmentSpread = FragmentSpread
<$ spread
<*> fragmentName
<*> directives
+ <?> "FragmentSpread"
inlineFragment :: Parser Selection
inlineFragment = InlineFragment
@@ -381,62 +379,74 @@ inlineFragment = InlineFragment
<*> optional typeCondition
<*> directives
<*> selectionSet
+ <?> "InlineFragment"
fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = FragmentDefinition
- <$ symbol "fragment"
- <*> name
- <*> typeCondition
- <*> directives
- <*> selectionSet
+ <$ symbol "fragment"
+ <*> name
+ <*> typeCondition
+ <*> directives
+ <*> selectionSet
+ <?> "FragmentDefinition"
fragmentName :: Parser Name
-fragmentName = but (symbol "on") *> name
+fragmentName = but (symbol "on") *> name <?> "FragmentName"
typeCondition :: Parser TypeCondition
-typeCondition = symbol "on" *> name
-
--- * Input Values
+typeCondition = symbol "on" *> name <?> "TypeCondition"
value :: Parser Value
value = Variable <$> variable
<|> Float <$> try float
<|> Int <$> integer
<|> Boolean <$> booleanValue
- <|> Null <$ symbol "null"
- <|> String <$> blockString
- <|> String <$> string
+ <|> Null <$ nullValue
+ <|> String <$> stringValue
<|> Enum <$> try enumValue
<|> List <$> brackets (some value)
<|> Object <$> braces (some $ objectField value)
- <?> "value error!"
+ <?> "Value"
constValue :: Parser ConstValue
constValue = ConstFloat <$> try float
<|> ConstInt <$> integer
<|> ConstBoolean <$> booleanValue
- <|> ConstNull <$ symbol "null"
- <|> ConstString <$> blockString
- <|> ConstString <$> string
+ <|> ConstNull <$ nullValue
+ <|> ConstString <$> stringValue
<|> ConstEnum <$> try enumValue
<|> ConstList <$> brackets (some constValue)
<|> ConstObject <$> braces (some $ objectField constValue)
- <?> "value error!"
+ <?> "Value"
booleanValue :: Parser Bool
booleanValue = True <$ symbol "true"
<|> False <$ symbol "false"
+ <?> "BooleanValue"
enumValue :: Parser Name
-enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
+enumValue = but (symbol "true")
+ *> but (symbol "false")
+ *> but (symbol "null")
+ *> name
+ <?> "EnumValue"
-objectField :: Parser a -> Parser (ObjectField a)
-objectField valueParser = ObjectField <$> name <* colon <*> valueParser
+stringValue :: Parser Text
+stringValue = blockString <|> string <?> "StringValue"
+
+nullValue :: Parser Text
+nullValue = symbol "null" <?> "NullValue"
--- * Variables
+objectField :: Parser a -> Parser (ObjectField a)
+objectField valueParser = ObjectField
+ <$> name
+ <* colon
+ <*> valueParser
+ <?> "ObjectField"
variableDefinitions :: Parser [VariableDefinition]
variableDefinitions = listOptIn parens variableDefinition
+ <?> "VariableDefinitions"
variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition
@@ -447,13 +457,11 @@ variableDefinition = VariableDefinition
<?> "VariableDefinition"
variable :: Parser Name
-variable = dollar *> name
+variable = dollar *> name <?> "Variable"
defaultValue :: Parser (Maybe ConstValue)
defaultValue = optional (equals *> constValue) <?> "DefaultValue"
--- * Input Types
-
type' :: Parser Type
type' = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type'
@@ -462,21 +470,18 @@ type' = try (TypeNonNull <$> nonNullType)
nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang
- <|> NonNullTypeList <$> brackets type' <* bang
- <?> "nonNullType error!"
-
--- * Directives
+ <|> NonNullTypeList <$> brackets type' <* bang
+ <?> "NonNullType"
directives :: Parser [Directive]
-directives = many directive
+directives = many directive <?> "Directives"
directive :: Parser Directive
directive = Directive
<$ at
<*> name
<*> arguments
-
--- * Internal
+ <?> "Directive"
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn surround = option [] . surround . some