blob: d8b467ae39a1855d12357c2a4a5e4db06ba43f08 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-- | @GraphQL@ document parser.
module Language.GraphQL.AST.Parser
( document
) where
import Control.Applicative (Alternative(..), optional)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Language.GraphQL.AST
import qualified Language.GraphQL.AST.Document as Document
import Language.GraphQL.AST.Lexer
import Text.Megaparsec (lookAhead, option, try, (<?>))
-- | Parser for the GraphQL documents.
document :: Parser Document.Document
document = unicodeBOM
>> spaceConsumer
>> lexeme (NonEmpty.some $ Document.ExecutableDefinition <$> definition)
definition :: Parser ExecutableDefinition
definition = DefinitionOperation <$> operationDefinition
<|> DefinitionFragment <$> fragmentDefinition
<?> "definition error!"
operationDefinition :: Parser OperationDefinition
operationDefinition = SelectionSet <$> selectionSet
<|> operationDefinition'
<?> "operationDefinition error"
where
operationDefinition'
= OperationDefinition <$> operationType
<*> optional name
<*> variableDefinitions
<*> directives
<*> selectionSet
operationType :: Parser OperationType
operationType = Query <$ symbol "query"
<|> Mutation <$ symbol "mutation"
<?> "operationType error"
-- * SelectionSet
selectionSet :: Parser SelectionSet
selectionSet = braces $ NonEmpty.some selection
selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = listOptIn braces selection
selection :: Parser Selection
selection = field
<|> try fragmentSpread
<|> inlineFragment
<?> "selection error!"
-- * Field
field :: Parser Selection
field = Field
<$> optional alias
<*> name
<*> arguments
<*> directives
<*> selectionSetOpt
alias :: Parser Alias
alias = try $ name <* colon
-- * Arguments
arguments :: Parser [Argument]
arguments = listOptIn parens argument
argument :: Parser Argument
argument = Argument <$> name <* colon <*> value
-- * Fragments
fragmentSpread :: Parser Selection
fragmentSpread = FragmentSpread
<$ spread
<*> fragmentName
<*> directives
inlineFragment :: Parser Selection
inlineFragment = InlineFragment
<$ spread
<*> optional typeCondition
<*> directives
<*> selectionSet
fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = FragmentDefinition
<$ symbol "fragment"
<*> name
<*> typeCondition
<*> directives
<*> selectionSet
fragmentName :: Parser Name
fragmentName = but (symbol "on") *> name
typeCondition :: Parser TypeCondition
typeCondition = symbol "on" *> name
-- * Input Values
value :: Parser Value
value = Variable <$> variable
<|> Float <$> try float
<|> Int <$> integer
<|> Boolean <$> booleanValue
<|> Null <$ symbol "null"
<|> String <$> blockString
<|> String <$> string
<|> Enum <$> try enumValue
<|> List <$> listValue
<|> Object <$> objectValue
<?> "value error!"
where
booleanValue :: Parser Bool
booleanValue = True <$ symbol "true"
<|> False <$ symbol "false"
enumValue :: Parser Name
enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
listValue :: Parser [Value]
listValue = brackets $ some value
objectValue :: Parser [ObjectField]
objectValue = braces $ some objectField
objectField :: Parser ObjectField
objectField = ObjectField <$> name <* symbol ":" <*> value
-- * Variables
variableDefinitions :: Parser [VariableDefinition]
variableDefinitions = listOptIn parens variableDefinition
variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition
<$> variable
<* colon
<*> type_
<*> optional defaultValue
variable :: Parser Name
variable = dollar *> name
defaultValue :: Parser Value
defaultValue = equals *> value
-- * Input Types
type_ :: Parser Type
type_ = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type_
<|> TypeNamed <$> name
<?> "type_ error!"
nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang
<|> NonNullTypeList <$> brackets type_ <* bang
<?> "nonNullType error!"
-- * Directives
directives :: Parser [Directive]
directives = many directive
directive :: Parser Directive
directive = Directive
<$ at
<*> name
<*> arguments
-- * Internal
listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
listOptIn surround = option [] . surround . some
-- Hack to reverse parser success
but :: Parser a -> Parser ()
but pn = False <$ lookAhead pn <|> pure True >>= \case
False -> empty
True -> pure ()
|
