OSS/graphql
1
1
Fork 1
Code Issues 4 Pull Requests Actions Releases 22 Wiki Activity

Validate input object field names

Browse Source
This commit is contained in:
Eugen Wissner
2020-09-30 05:14:52 +02:00
parent 466416d4b0
commit 56b63f1c3e
9 changed files with 640 additions and 478 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/Language/GraphQL/AST/Document.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module defines an abstract syntax tree for the @GraphQL@ language. It
@ -72,7 +73,10 @@ instance Ord Location where
| otherwise = compare thisColumn thatColumn
-- | Contains some tree node with a location.
data Node a = Node a Location deriving (Eq, Show)
data Node a = Node
{ value :: a
, location :: Location
} deriving (Eq, Show)
-- ** Document
@ -258,7 +262,7 @@ data ObjectField a = ObjectField Name a Location
-- Variables are usually passed along with the query, but not in the query
-- itself. They make queries reusable.
data VariableDefinition =
VariableDefinition Name Type (Maybe ConstValue) Location
VariableDefinition Name Type (Maybe (Node ConstValue)) Location
deriving (Eq, Show)
-- ** Type References
@ -484,8 +488,8 @@ instance Monoid ArgumentsDefinition where
-- @
--
-- The input type "Point2D" contains two value definitions: "x" and "y".
data InputValueDefinition
= InputValueDefinition Description Name Type (Maybe ConstValue) [Directive]
data InputValueDefinition = InputValueDefinition
Description Name Type (Maybe (Node ConstValue)) [Directive]
deriving (Eq, Show)
-- ** Unions

181
src/Language/GraphQL/AST/Encoder.hs
View File

@ -25,7 +25,7 @@ import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat)
import Language.GraphQL.AST.Document
import qualified Language.GraphQL.AST.Document as Full
-- | Instructs the encoder whether the GraphQL document should be minified or
-- pretty printed.
@ -44,77 +44,78 @@ minified :: Formatter
minified = Minified
-- | Converts a Document' into a string.
document :: Formatter -> Document -> Lazy.Text
document :: Formatter -> Full.Document -> Lazy.Text
document formatter defs
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
where
encodeDocument = foldr executableDefinition [] defs
executableDefinition (ExecutableDefinition executableDefinition') acc =
executableDefinition (Full.ExecutableDefinition executableDefinition') acc =
definition formatter executableDefinition' : acc
executableDefinition _ acc = acc
-- | Converts a t'ExecutableDefinition' into a string.
definition :: Formatter -> ExecutableDefinition -> Lazy.Text
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
definition formatter x
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x
where
encodeDefinition (DefinitionOperation operation)
encodeDefinition (Full.DefinitionOperation operation)
= operationDefinition formatter operation
encodeDefinition (DefinitionFragment fragment)
encodeDefinition (Full.DefinitionFragment fragment)
= fragmentDefinition formatter fragment
-- | Converts a 'OperationDefinition into a string.
operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
operationDefinition formatter = \case
SelectionSet sels _ -> selectionSet formatter sels
OperationDefinition Query name vars dirs sels _ ->
"query " <> node formatter name vars dirs sels
OperationDefinition Mutation name vars dirs sels _ ->
"mutation " <> node formatter name vars dirs sels
OperationDefinition Subscription name vars dirs sels _ ->
"subscription " <> node formatter name vars dirs sels
Full.SelectionSet sels _ -> selectionSet formatter sels
Full.OperationDefinition Full.Query name vars dirs sels _ ->
"query " <> root name vars dirs sels
Full.OperationDefinition Full.Mutation name vars dirs sels _ ->
"mutation " <> root name vars dirs sels
Full.OperationDefinition Full.Subscription name vars dirs sels _ ->
"subscription " <> root name vars dirs sels
where
-- | Converts a Query or Mutation into a string.
root :: Maybe Full.Name ->
[Full.VariableDefinition] ->
[Full.Directive] ->
Full.SelectionSet ->
Lazy.Text
root name vars dirs sels
= Lazy.Text.fromStrict (fold name)
<> optempty (variableDefinitions formatter) vars
<> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels
-- | Converts a Query or Mutation into a string.
node :: Formatter ->
Maybe Name ->
[VariableDefinition] ->
[Directive] ->
SelectionSet ->
Lazy.Text
node formatter name vars dirs sels
= Lazy.Text.fromStrict (fold name)
<> optempty (variableDefinitions formatter) vars
<> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty
<> selectionSet formatter sels
variableDefinitions :: Formatter -> [VariableDefinition] -> Lazy.Text
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
variableDefinitions formatter
= parensCommas formatter $ variableDefinition formatter
variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text
variableDefinition formatter (VariableDefinition var ty defaultValue' _)
= variable var
variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
variableDefinition formatter variableDefinition' =
let Full.VariableDefinition variableName variableType defaultValue' _ =
variableDefinition'
in variable variableName
<> eitherFormat formatter ": " ":"
<> type' ty
<> maybe mempty (defaultValue formatter) defaultValue'
<> type' variableType
<> maybe mempty (defaultValue formatter) (Full.value <$> defaultValue')
defaultValue :: Formatter -> ConstValue -> Lazy.Text
defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
defaultValue formatter val
= eitherFormat formatter " = " "="
<> value formatter (fromConstValue val)
variable :: Name -> Lazy.Text
variable :: Full.Name -> Lazy.Text
variable var = "$" <> Lazy.Text.fromStrict var
selectionSet :: Formatter -> SelectionSet -> Lazy.Text
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
selectionSet formatter
= bracesList formatter (selection formatter)
. NonEmpty.toList
selectionSetOpt :: Formatter -> SelectionSetOpt -> Lazy.Text
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
selectionSetOpt formatter = bracesList formatter $ selection formatter
indentSymbol :: Lazy.Text
@ -123,14 +124,14 @@ indentSymbol = " "
indent :: (Integral a) => a -> Lazy.Text
indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
selection :: Formatter -> Selection -> Lazy.Text
selection :: Formatter -> Full.Selection -> Lazy.Text
selection formatter = Lazy.Text.append indent' . encodeSelection
where
encodeSelection (FieldSelection fieldSelection) =
encodeSelection (Full.FieldSelection fieldSelection) =
field incrementIndent fieldSelection
encodeSelection (InlineFragmentSelection fragmentSelection) =
encodeSelection (Full.InlineFragmentSelection fragmentSelection) =
inlineFragment incrementIndent fragmentSelection
encodeSelection (FragmentSpreadSelection fragmentSelection) =
encodeSelection (Full.FragmentSpreadSelection fragmentSelection) =
fragmentSpread incrementIndent fragmentSelection
incrementIndent
| Pretty indentation <- formatter = Pretty $ indentation + 1
@ -143,8 +144,8 @@ colon :: Formatter -> Lazy.Text
colon formatter = eitherFormat formatter ": " ":"
-- | Converts Field into a string.
field :: Formatter -> Field -> Lazy.Text
field formatter (Field alias name args dirs set _)
field :: Formatter -> Full.Field -> Lazy.Text
field formatter (Full.Field alias name args dirs set _)
= optempty prependAlias (fold alias)
<> Lazy.Text.fromStrict name
<> optempty (arguments formatter) args
@ -155,32 +156,32 @@ field formatter (Field alias name args dirs set _)
selectionSetOpt' = (eitherFormat formatter " " "" <>)
. selectionSetOpt formatter
arguments :: Formatter -> [Argument] -> Lazy.Text
arguments :: Formatter -> [Full.Argument] -> Lazy.Text
arguments formatter = parensCommas formatter $ argument formatter
argument :: Formatter -> Argument -> Lazy.Text
argument formatter (Argument name (Node value' _) _)
argument :: Formatter -> Full.Argument -> Lazy.Text
argument formatter (Full.Argument name value' _)
= Lazy.Text.fromStrict name
<> colon formatter
<> value formatter value'
<> value formatter (Full.value value')
-- * Fragments
fragmentSpread :: Formatter -> FragmentSpread -> Lazy.Text
fragmentSpread formatter (FragmentSpread name directives' _)
fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread formatter (Full.FragmentSpread name directives' _)
= "..." <> Lazy.Text.fromStrict name
<> optempty (directives formatter) directives'
inlineFragment :: Formatter -> InlineFragment -> Lazy.Text
inlineFragment formatter (InlineFragment typeCondition directives' selections _)
inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
inlineFragment formatter (Full.InlineFragment typeCondition directives' selections _)
= "... on "
<> Lazy.Text.fromStrict (fold typeCondition)
<> directives formatter directives'
<> eitherFormat formatter " " mempty
<> selectionSet formatter selections
fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _)
= "fragment " <> Lazy.Text.fromStrict name
<> " on " <> Lazy.Text.fromStrict tc
<> optempty (directives formatter) dirs
@ -190,38 +191,38 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)
-- * Miscellaneous
-- | Converts a 'Directive' into a string.
directive :: Formatter -> Directive -> Lazy.Text
directive formatter (Directive name args _)
directive :: Formatter -> Full.Directive -> Lazy.Text
directive formatter (Full.Directive name args _)
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
directives :: Formatter -> [Directive] -> Lazy.Text
directives :: Formatter -> [Full.Directive] -> Lazy.Text
directives Minified = spaces (directive Minified)
directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
-- | Converts a 'Value' into a string.
value :: Formatter -> Value -> Lazy.Text
value _ (Variable x) = variable x
value _ (Int x) = Builder.toLazyText $ decimal x
value _ (Float x) = Builder.toLazyText $ realFloat x
value _ (Boolean x) = booleanValue x
value _ Null = "null"
value formatter (String string) = stringValue formatter string
value _ (Enum x) = Lazy.Text.fromStrict x
value formatter (List x) = listValue formatter x
value formatter (Object x) = objectValue formatter x
value :: Formatter -> Full.Value -> Lazy.Text
value _ (Full.Variable x) = variable x
value _ (Full.Int x) = Builder.toLazyText $ decimal x
value _ (Full.Float x) = Builder.toLazyText $ realFloat x
value _ (Full.Boolean x) = booleanValue x
value _ Full.Null = "null"
value formatter (Full.String string) = stringValue formatter string
value _ (Full.Enum x) = Lazy.Text.fromStrict x
value formatter (Full.List x) = listValue formatter x
value formatter (Full.Object x) = objectValue formatter x
fromConstValue :: ConstValue -> Value
fromConstValue (ConstInt x) = Int x
fromConstValue (ConstFloat x) = Float x
fromConstValue (ConstBoolean x) = Boolean x
fromConstValue ConstNull = Null
fromConstValue (ConstString string) = String string
fromConstValue (ConstEnum x) = Enum x
fromConstValue (ConstList x) = List $ fromConstValue <$> x
fromConstValue (ConstObject x) = Object $ fromConstObjectField <$> x
fromConstValue :: Full.ConstValue -> Full.Value
fromConstValue (Full.ConstInt x) = Full.Int x
fromConstValue (Full.ConstFloat x) = Full.Float x
fromConstValue (Full.ConstBoolean x) = Full.Boolean x
fromConstValue Full.ConstNull = Full.Null
fromConstValue (Full.ConstString string) = Full.String string
fromConstValue (Full.ConstEnum x) = Full.Enum x
fromConstValue (Full.ConstList x) = Full.List $ fromConstValue <$> x
fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x
where
fromConstObjectField (ObjectField key value' location) =
ObjectField key (fromConstValue value') location
fromConstObjectField (Full.ObjectField key value' location) =
Full.ObjectField key (fromConstValue value') location
booleanValue :: Bool -> Lazy.Text
booleanValue True = "true"
@ -278,10 +279,10 @@ escape char'
where
unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord)
listValue :: Formatter -> [Value] -> Lazy.Text
listValue :: Formatter -> [Full.Value] -> Lazy.Text
listValue formatter = bracketsCommas formatter $ value formatter
objectValue :: Formatter -> [ObjectField Value] -> Lazy.Text
objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
objectValue formatter = intercalate $ objectField formatter
where
intercalate f
@ -289,22 +290,22 @@ objectValue formatter = intercalate $ objectField formatter
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
. fmap f
objectField :: Formatter -> ObjectField Value -> Lazy.Text
objectField formatter (ObjectField name value' _) =
objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text
objectField formatter (Full.ObjectField name value' _) =
Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
-- | Converts a 'Type' a type into a string.
type' :: Type -> Lazy.Text
type' (TypeNamed x) = Lazy.Text.fromStrict x
type' (TypeList x) = listType x
type' (TypeNonNull x) = nonNullType x
type' :: Full.Type -> Lazy.Text
type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
type' (Full.TypeList x) = listType x
type' (Full.TypeNonNull x) = nonNullType x
listType :: Type -> Lazy.Text
listType :: Full.Type -> Lazy.Text
listType x = brackets (type' x)
nonNullType :: NonNullType -> Lazy.Text
nonNullType (NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
nonNullType (NonNullTypeList x) = listType x <> "!"
nonNullType :: Full.NonNullType -> Lazy.Text
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
-- * Internal

303
src/Language/GraphQL/AST/Parser.hs
View File

@ -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