blob: fc04595209bc17bab2b977c50408ff2b81387c7f (
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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.GraphQL.Parser where
import Control.Applicative ( Alternative(..)
, optional
)
import Data.GraphQL.AST
import Language.GraphQL.Lexer
import Data.List.NonEmpty (NonEmpty(..))
import Text.Megaparsec ( lookAhead
, option
, try
, (<?>)
)
document :: Parser Document
document = spaceConsumer >> lexeme (manyNE definition)
definition :: Parser Definition
definition = DefinitionOperation <$> operationDefinition
<|> DefinitionFragment <$> fragmentDefinition
<?> "definition error!"
operationDefinition :: Parser OperationDefinition
operationDefinition = OperationSelectionSet <$> selectionSet
<|> OperationDefinition <$> operationType
<*> optional name
<*> opt variableDefinitions
<*> opt directives
<*> selectionSet
<?> "operationDefinition error"
operationType :: Parser OperationType
operationType = Query <$ symbol "query"
<|> Mutation <$ symbol "mutation"
<?> "operationType error"
-- * SelectionSet
selectionSet :: Parser SelectionSet
selectionSet = braces $ manyNE selection
selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = braces $ some selection
selection :: Parser Selection
selection = SelectionField <$> field
<|> try (SelectionFragmentSpread <$> fragmentSpread)
<|> SelectionInlineFragment <$> inlineFragment
<?> "selection error!"
-- * Field
field :: Parser Field
field = Field <$> optional alias
<*> name
<*> opt arguments
<*> opt directives
<*> opt selectionSetOpt
alias :: Parser Alias
alias = try $ name <* colon
-- * Arguments
arguments :: Parser Arguments
arguments = parens $ some argument
argument :: Parser Argument
argument = Argument <$> name <* colon <*> value
-- * Fragments
fragmentSpread :: Parser FragmentSpread
fragmentSpread = FragmentSpread <$ spread
<*> fragmentName
<*> opt directives
inlineFragment :: Parser InlineFragment
inlineFragment = InlineFragment <$ spread
<*> optional typeCondition
<*> opt directives
<*> selectionSet
fragmentDefinition :: Parser FragmentDefinition
fragmentDefinition = FragmentDefinition
<$ symbol "fragment"
<*> name
<*> typeCondition
<*> opt directives
<*> selectionSet
fragmentName :: Parser FragmentName
fragmentName = but (symbol "on") *> name
typeCondition :: Parser TypeCondition
typeCondition = symbol "on" *> name
-- * Input Values
value :: Parser Value
value = ValueVariable <$> variable
<|> ValueFloat <$> try float
<|> ValueInt <$> integer
<|> ValueBoolean <$> booleanValue
<|> ValueNull <$ symbol "null"
<|> ValueString <$> string
<|> ValueString <$> blockString
<|> ValueEnum <$> try enumValue
<|> ValueList <$> listValue
<|> ValueObject <$> 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 VariableDefinitions
variableDefinitions = parens $ some variableDefinition
variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition <$> variable
<* colon
<*> type_
<*> optional defaultValue
variable :: Parser Variable
variable = dollar *> name
defaultValue :: Parser DefaultValue
defaultValue = equals *> value
-- * Input Types
type_ :: Parser Type
type_ = try (TypeNamed <$> name <* but "!")
<|> TypeList <$> brackets type_
<|> TypeNonNull <$> nonNullType
<?> "type_ error!"
nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang
<|> NonNullTypeList <$> brackets type_ <* bang
<?> "nonNullType error!"
-- * Directives
directives :: Parser Directives
directives = some directive
directive :: Parser Directive
directive = Directive
<$ at
<*> name
<*> opt arguments
-- * Internal
opt :: Monoid a => Parser a -> Parser a
opt = option mempty
-- Hack to reverse parser success
but :: Parser a -> Parser ()
but pn = False <$ lookAhead pn <|> pure True >>= \case
False -> empty
True -> pure ()
manyNE :: Alternative f => f a -> f (NonEmpty a)
manyNE p = (:|) <$> p <*> many p
|
