summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/AST
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2020-09-30 05:14:52 +0200
committerEugen Wissner <belka@caraus.de>2020-09-30 05:14:52 +0200
commit56b63f1c3eda70e6de5da4b6395b98a378b1e4e7 (patch)
treee6815d9e5ab30f9639f69840832a2effa9f3bcdc /src/Language/GraphQL/AST
parent466416d4b00ab48aaab36eea9623a8aaad366fa8 (diff)
downloadgraphql-56b63f1c3eda70e6de5da4b6395b98a378b1e4e7.tar.gz
Validate input object field names
Diffstat (limited to 'src/Language/GraphQL/AST')
-rw-r--r--src/Language/GraphQL/AST/Document.hs12
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs185
-rw-r--r--src/Language/GraphQL/AST/Parser.hs307
3 files changed, 258 insertions, 246 deletions
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index c870580..0b118af 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -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
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 011527a..dd464c2 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -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
-
--- | 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
+ 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
+
+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
-
-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
+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 :: 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
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index eb82f38..2695e6f 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -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
-
-operationType :: Parser OperationType
-operationType = Query <$ symbol "query"
- <|> Mutation <$ symbol "mutation"
- <|> Subscription <$ symbol "subscription"
+ 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"
<?> "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 :: 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' <- 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"
-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