Label parsers with help info

Fixes #36.
This commit is contained in:
Eugen Wissner 2020-07-10 08:43:47 +02:00
parent 28781586a5
commit 04a58be3f8
3 changed files with 57 additions and 50 deletions

View File

@ -11,6 +11,8 @@ and this project adheres to
- Location of a parse error is returned in a singleton array with key - Location of a parse error is returned in a singleton array with key
`locations`. `locations`.
- Parsing comments in the front of definitions. - 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 ## Added
- `AST` reexports `AST.Parser`. - `AST` reexports `AST.Parser`.

View File

@ -168,11 +168,11 @@ blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
-- | Parser for integers. -- | Parser for integers.
integer :: Integral a => Parser a 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. -- | Parser for floating-point numbers.
float :: Parser Double 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]*/). -- | Parser for names (/[_A-Za-z][_0-9A-Za-z]*/).
name :: Parser T.Text name :: Parser T.Text

View File

@ -66,11 +66,13 @@ directiveDefinition description' = DirectiveDefinition description'
directiveLocations :: Parser (NonEmpty DirectiveLocation) directiveLocations :: Parser (NonEmpty DirectiveLocation)
directiveLocations = optional pipe directiveLocations = optional pipe
*> directiveLocation `NonEmpty.sepBy1` pipe *> directiveLocation `NonEmpty.sepBy1` pipe
<?> "DirectiveLocations"
directiveLocation :: Parser DirectiveLocation directiveLocation :: Parser DirectiveLocation
directiveLocation directiveLocation
= Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
<|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
<?> "DirectiveLocation"
executableDirectiveLocation :: Parser ExecutableDirectiveLocation executableDirectiveLocation :: Parser ExecutableDirectiveLocation
executableDirectiveLocation = Directive.Query <$ symbol "QUERY" executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
@ -80,6 +82,7 @@ executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
<|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION" <|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
<|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD" <|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
<|> Directive.InlineFragment <$ "INLINE_FRAGMENT" <|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
<?> "ExecutableDirectiveLocation"
typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA" typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
@ -93,6 +96,7 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
<|> Directive.EnumValue <$ symbol "ENUM_VALUE" <|> Directive.EnumValue <$ symbol "ENUM_VALUE"
<|> Directive.InputObject <$ symbol "INPUT_OBJECT" <|> Directive.InputObject <$ symbol "INPUT_OBJECT"
<|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION" <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
<?> "TypeSystemDirectiveLocation"
typeDefinition :: Description -> Parser TypeDefinition typeDefinition :: Description -> Parser TypeDefinition
typeDefinition description' = scalarTypeDefinition description' typeDefinition description' = scalarTypeDefinition description'
@ -154,7 +158,7 @@ objectTypeExtension = extend "type" "ObjectTypeExtension"
description :: Parser Description description :: Parser Description
description = Description description = Description
<$> optional (blockString <|> string) <$> optional stringValue
<?> "Description" <?> "Description"
unionTypeDefinition :: Description -> Parser TypeDefinition unionTypeDefinition :: Description -> Parser TypeDefinition
@ -318,7 +322,7 @@ operationTypeDefinition = OperationTypeDefinition
operationDefinition :: Parser OperationDefinition operationDefinition :: Parser OperationDefinition
operationDefinition = SelectionSet <$> selectionSet operationDefinition = SelectionSet <$> selectionSet
<|> operationDefinition' <|> operationDefinition'
<?> "operationDefinition error" <?> "OperationDefinition"
where where
operationDefinition' operationDefinition'
= OperationDefinition <$> operationType = OperationDefinition <$> operationType
@ -332,21 +336,17 @@ operationType = Query <$ symbol "query"
<|> Mutation <$ symbol "mutation" <|> Mutation <$ symbol "mutation"
-- <?> Keep default error message -- <?> Keep default error message
-- * SelectionSet
selectionSet :: Parser SelectionSet selectionSet :: Parser SelectionSet
selectionSet = braces $ NonEmpty.some selection selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
selectionSetOpt :: Parser SelectionSetOpt selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = listOptIn braces selection selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
selection :: Parser Selection selection :: Parser Selection
selection = field selection = field
<|> try fragmentSpread <|> try fragmentSpread
<|> inlineFragment <|> inlineFragment
<?> "selection error!" <?> "Selection"
-- * Field
field :: Parser Selection field :: Parser Selection
field = Field field = Field
@ -355,25 +355,23 @@ field = Field
<*> arguments <*> arguments
<*> directives <*> directives
<*> selectionSetOpt <*> selectionSetOpt
<?> "Field"
alias :: Parser Alias alias :: Parser Alias
alias = try $ name <* colon alias = try (name <* colon) <?> "Alias"
-- * Arguments
arguments :: Parser [Argument] arguments :: Parser [Argument]
arguments = listOptIn parens argument arguments = listOptIn parens argument <?> "Arguments"
argument :: Parser Argument argument :: Parser Argument
argument = Argument <$> name <* colon <*> value argument = Argument <$> name <* colon <*> value <?> "Argument"
-- * Fragments
fragmentSpread :: Parser Selection fragmentSpread :: Parser Selection
fragmentSpread = FragmentSpread fragmentSpread = FragmentSpread
<$ spread <$ spread
<*> fragmentName <*> fragmentName
<*> directives <*> directives
<?> "FragmentSpread"
inlineFragment :: Parser Selection inlineFragment :: Parser Selection
inlineFragment = InlineFragment inlineFragment = InlineFragment
@ -381,62 +379,74 @@ inlineFragment = InlineFragment
<*> optional typeCondition <*> optional typeCondition
<*> directives <*> directives
<*> selectionSet <*> selectionSet
<?> "InlineFragment"
fragmentDefinition :: Parser FragmentDefinition fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = FragmentDefinition fragmentDefinition = FragmentDefinition
<$ symbol "fragment" <$ symbol "fragment"
<*> name <*> name
<*> typeCondition <*> typeCondition
<*> directives <*> directives
<*> selectionSet <*> selectionSet
<?> "FragmentDefinition"
fragmentName :: Parser Name fragmentName :: Parser Name
fragmentName = but (symbol "on") *> name fragmentName = but (symbol "on") *> name <?> "FragmentName"
typeCondition :: Parser TypeCondition typeCondition :: Parser TypeCondition
typeCondition = symbol "on" *> name typeCondition = symbol "on" *> name <?> "TypeCondition"
-- * Input Values
value :: Parser Value value :: Parser Value
value = Variable <$> variable value = Variable <$> variable
<|> Float <$> try float <|> Float <$> try float
<|> Int <$> integer <|> Int <$> integer
<|> Boolean <$> booleanValue <|> Boolean <$> booleanValue
<|> Null <$ symbol "null" <|> Null <$ nullValue
<|> String <$> blockString <|> String <$> stringValue
<|> String <$> string
<|> Enum <$> try enumValue <|> Enum <$> try enumValue
<|> List <$> brackets (some value) <|> List <$> brackets (some value)
<|> Object <$> braces (some $ objectField value) <|> Object <$> braces (some $ objectField value)
<?> "value error!" <?> "Value"
constValue :: Parser ConstValue constValue :: Parser ConstValue
constValue = ConstFloat <$> try float constValue = ConstFloat <$> try float
<|> ConstInt <$> integer <|> ConstInt <$> integer
<|> ConstBoolean <$> booleanValue <|> ConstBoolean <$> booleanValue
<|> ConstNull <$ symbol "null" <|> ConstNull <$ nullValue
<|> ConstString <$> blockString <|> ConstString <$> stringValue
<|> ConstString <$> string
<|> ConstEnum <$> try enumValue <|> ConstEnum <$> try enumValue
<|> ConstList <$> brackets (some constValue) <|> ConstList <$> brackets (some constValue)
<|> ConstObject <$> braces (some $ objectField constValue) <|> ConstObject <$> braces (some $ objectField constValue)
<?> "value error!" <?> "Value"
booleanValue :: Parser Bool booleanValue :: Parser Bool
booleanValue = True <$ symbol "true" booleanValue = True <$ symbol "true"
<|> False <$ symbol "false" <|> False <$ symbol "false"
<?> "BooleanValue"
enumValue :: Parser Name 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"
stringValue :: Parser Text
stringValue = blockString <|> string <?> "StringValue"
nullValue :: Parser Text
nullValue = symbol "null" <?> "NullValue"
objectField :: Parser a -> Parser (ObjectField a) objectField :: Parser a -> Parser (ObjectField a)
objectField valueParser = ObjectField <$> name <* colon <*> valueParser objectField valueParser = ObjectField
<$> name
-- * Variables <* colon
<*> valueParser
<?> "ObjectField"
variableDefinitions :: Parser [VariableDefinition] variableDefinitions :: Parser [VariableDefinition]
variableDefinitions = listOptIn parens variableDefinition variableDefinitions = listOptIn parens variableDefinition
<?> "VariableDefinitions"
variableDefinition :: Parser VariableDefinition variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition variableDefinition = VariableDefinition
@ -447,13 +457,11 @@ variableDefinition = VariableDefinition
<?> "VariableDefinition" <?> "VariableDefinition"
variable :: Parser Name variable :: Parser Name
variable = dollar *> name variable = dollar *> name <?> "Variable"
defaultValue :: Parser (Maybe ConstValue) defaultValue :: Parser (Maybe ConstValue)
defaultValue = optional (equals *> constValue) <?> "DefaultValue" defaultValue = optional (equals *> constValue) <?> "DefaultValue"
-- * Input Types
type' :: Parser Type type' :: Parser Type
type' = try (TypeNonNull <$> nonNullType) type' = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type' <|> TypeList <$> brackets type'
@ -462,21 +470,18 @@ type' = try (TypeNonNull <$> nonNullType)
nonNullType :: Parser NonNullType nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang nonNullType = NonNullTypeNamed <$> name <* bang
<|> NonNullTypeList <$> brackets type' <* bang <|> NonNullTypeList <$> brackets type' <* bang
<?> "nonNullType error!" <?> "NonNullType"
-- * Directives
directives :: Parser [Directive] directives :: Parser [Directive]
directives = many directive directives = many directive <?> "Directives"
directive :: Parser Directive directive :: Parser Directive
directive = Directive directive = Directive
<$ at <$ at
<*> name <*> name
<*> arguments <*> arguments
<?> "Directive"
-- * Internal
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a] listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn surround = option [] . surround . some listOptIn surround = option [] . surround . some