aboutsummaryrefslogtreecommitdiff
path: root/Data/GraphQL/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Data/GraphQL/Parser.hs')
-rw-r--r--Data/GraphQL/Parser.hs336
1 files changed, 0 insertions, 336 deletions
diff --git a/Data/GraphQL/Parser.hs b/Data/GraphQL/Parser.hs
deleted file mode 100644
index 1f5b8e6..0000000
--- a/Data/GraphQL/Parser.hs
+++ /dev/null
@@ -1,336 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-module Data.GraphQL.Parser where
-
-import Prelude hiding (takeWhile)
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), pure)
-import Data.Monoid (Monoid, mempty)
-#endif
-import Control.Applicative ((<|>), empty, many, optional)
-import Control.Monad (when)
-import Data.Char (isDigit, isSpace)
-import Data.Foldable (traverse_)
-
-import Data.Text (Text, append)
-import Data.Attoparsec.Text
- ( Parser
- , (<?>)
- , anyChar
- , decimal
- , double
- , endOfLine
- , inClass
- , many1
- , manyTill
- , option
- , peekChar
- , sepBy1
- , signed
- , takeWhile
- , takeWhile1
- )
-
-import Data.GraphQL.AST
-
--- * Name
-
-name :: Parser Name
-name = tok $ append <$> takeWhile1 isA_z
- <*> takeWhile ((||) <$> isDigit <*> isA_z)
- where
- -- `isAlpha` handles many more Unicode Chars
- isA_z = inClass $ '_' : ['A'..'Z'] ++ ['a'..'z']
-
--- * Document
-
-document :: Parser Document
-document = whiteSpace
- *> (Document <$> many1 definition)
- -- Try SelectionSet when no definition
- <|> (Document . pure
- . DefinitionOperation
- . Query
- . Node mempty empty empty
- <$> selectionSet)
- <?> "document error!"
-
-definition :: Parser Definition
-definition = DefinitionOperation <$> operationDefinition
- <|> DefinitionFragment <$> fragmentDefinition
- <|> DefinitionType <$> typeDefinition
- <?> "definition error!"
-
-operationDefinition :: Parser OperationDefinition
-operationDefinition =
- Query <$ tok "query" <*> node
- <|> Mutation <$ tok "mutation" <*> node
- <?> "operationDefinition error!"
-
-node :: Parser Node
-node = Node <$> name
- <*> optempty variableDefinitions
- <*> optempty directives
- <*> selectionSet
-
-variableDefinitions :: Parser [VariableDefinition]
-variableDefinitions = parens (many1 variableDefinition)
-
-variableDefinition :: Parser VariableDefinition
-variableDefinition =
- VariableDefinition <$> variable
- <* tok ":"
- <*> type_
- <*> optional defaultValue
-
-defaultValue :: Parser DefaultValue
-defaultValue = tok "=" *> value
-
-variable :: Parser Variable
-variable = Variable <$ tok "$" <*> name
-
-selectionSet :: Parser SelectionSet
-selectionSet = braces $ many1 selection
-
-selection :: Parser Selection
-selection = SelectionField <$> field
- -- Inline first to catch `on` case
- <|> SelectionInlineFragment <$> inlineFragment
- <|> SelectionFragmentSpread <$> fragmentSpread
- <?> "selection error!"
-
-field :: Parser Field
-field = Field <$> optempty alias
- <*> name
- <*> optempty arguments
- <*> optempty directives
- <*> optempty selectionSet
-
-alias :: Parser Alias
-alias = name <* tok ":"
-
-arguments :: Parser [Argument]
-arguments = parens $ many1 argument
-
-argument :: Parser Argument
-argument = Argument <$> name <* tok ":" <*> value
-
--- * Fragments
-
-fragmentSpread :: Parser FragmentSpread
--- TODO: Make sure it fails when `... on`.
--- See https://facebook.github.io/graphql/#FragmentSpread
-fragmentSpread = FragmentSpread
- <$ tok "..."
- <*> name
- <*> optempty directives
-
--- InlineFragment tried first in order to guard against 'on' keyword
-inlineFragment :: Parser InlineFragment
-inlineFragment = InlineFragment
- <$ tok "..."
- <* tok "on"
- <*> typeCondition
- <*> optempty directives
- <*> selectionSet
-
-fragmentDefinition :: Parser FragmentDefinition
-fragmentDefinition = FragmentDefinition
- <$ tok "fragment"
- <*> name
- <* tok "on"
- <*> typeCondition
- <*> optempty directives
- <*> selectionSet
-
-typeCondition :: Parser TypeCondition
-typeCondition = namedType
-
--- * Values
-
--- This will try to pick the first type it can parse. If you are working with
--- explicit types use the `typedValue` parser.
-value :: Parser Value
-value = ValueVariable <$> variable
- -- TODO: Handle maxBound, Int32 in spec.
- <|> ValueInt <$> tok (signed decimal)
- <|> ValueFloat <$> tok (signed double)
- <|> ValueBoolean <$> booleanValue
- <|> ValueString <$> stringValue
- -- `true` and `false` have been tried before
- <|> ValueEnum <$> name
- <|> ValueList <$> listValue
- <|> ValueObject <$> objectValue
- <?> "value error!"
-
-booleanValue :: Parser Bool
-booleanValue = True <$ tok "true"
- <|> False <$ tok "false"
-
--- TODO: Escape characters. Look at `jsstring_` in aeson package.
-stringValue :: Parser StringValue
-stringValue = StringValue <$> quotes (takeWhile (/= '"'))
-
--- Notice it can be empty
-listValue :: Parser ListValue
-listValue = ListValue <$> brackets (many value)
-
--- Notice it can be empty
-objectValue :: Parser ObjectValue
-objectValue = ObjectValue <$> braces (many objectField)
-
-objectField :: Parser ObjectField
-objectField = ObjectField <$> name <* tok ":" <*> value
-
--- * Directives
-
-directives :: Parser [Directive]
-directives = many1 directive
-
-directive :: Parser Directive
-directive = Directive
- <$ tok "@"
- <*> name
- <*> optempty arguments
-
--- * Type Reference
-
-type_ :: Parser Type
-type_ = TypeList <$> listType
- <|> TypeNonNull <$> nonNullType
- <|> TypeNamed <$> namedType
- <?> "type_ error!"
-
-namedType :: Parser NamedType
-namedType = NamedType <$> name
-
-listType :: Parser ListType
-listType = ListType <$> brackets type_
-
-nonNullType :: Parser NonNullType
-nonNullType = NonNullTypeNamed <$> namedType <* tok "!"
- <|> NonNullTypeList <$> listType <* tok "!"
- <?> "nonNullType error!"
-
--- * Type Definition
-
-typeDefinition :: Parser TypeDefinition
-typeDefinition =
- TypeDefinitionObject <$> objectTypeDefinition
- <|> TypeDefinitionInterface <$> interfaceTypeDefinition
- <|> TypeDefinitionUnion <$> unionTypeDefinition
- <|> TypeDefinitionScalar <$> scalarTypeDefinition
- <|> TypeDefinitionEnum <$> enumTypeDefinition
- <|> TypeDefinitionInputObject <$> inputObjectTypeDefinition
- <|> TypeDefinitionTypeExtension <$> typeExtensionDefinition
- <?> "typeDefinition error!"
-
-objectTypeDefinition :: Parser ObjectTypeDefinition
-objectTypeDefinition = ObjectTypeDefinition
- <$ tok "type"
- <*> name
- <*> optempty interfaces
- <*> fieldDefinitions
-
-interfaces :: Parser Interfaces
-interfaces = tok "implements" *> many1 namedType
-
-fieldDefinitions :: Parser [FieldDefinition]
-fieldDefinitions = braces $ many1 fieldDefinition
-
-fieldDefinition :: Parser FieldDefinition
-fieldDefinition = FieldDefinition
- <$> name
- <*> optempty argumentsDefinition
- <* tok ":"
- <*> type_
-
-argumentsDefinition :: Parser ArgumentsDefinition
-argumentsDefinition = parens $ many1 inputValueDefinition
-
-interfaceTypeDefinition :: Parser InterfaceTypeDefinition
-interfaceTypeDefinition = InterfaceTypeDefinition
- <$ tok "interface"
- <*> name
- <*> fieldDefinitions
-
-unionTypeDefinition :: Parser UnionTypeDefinition
-unionTypeDefinition = UnionTypeDefinition
- <$ tok "union"
- <*> name
- <* tok "="
- <*> unionMembers
-
-unionMembers :: Parser [NamedType]
-unionMembers = namedType `sepBy1` tok "|"
-
-scalarTypeDefinition :: Parser ScalarTypeDefinition
-scalarTypeDefinition = ScalarTypeDefinition
- <$ tok "scalar"
- <*> name
-
-enumTypeDefinition :: Parser EnumTypeDefinition
-enumTypeDefinition = EnumTypeDefinition
- <$ tok "enum"
- <*> name
- <*> enumValueDefinitions
-
-enumValueDefinitions :: Parser [EnumValueDefinition]
-enumValueDefinitions = braces $ many1 enumValueDefinition
-
-enumValueDefinition :: Parser EnumValueDefinition
-enumValueDefinition = EnumValueDefinition <$> name
-
-inputObjectTypeDefinition :: Parser InputObjectTypeDefinition
-inputObjectTypeDefinition = InputObjectTypeDefinition
- <$ tok "input"
- <*> name
- <*> inputValueDefinitions
-
-inputValueDefinitions :: Parser [InputValueDefinition]
-inputValueDefinitions = braces $ many1 inputValueDefinition
-
-inputValueDefinition :: Parser InputValueDefinition
-inputValueDefinition = InputValueDefinition
- <$> name
- <* tok ":"
- <*> type_
- <*> optional defaultValue
-
-typeExtensionDefinition :: Parser TypeExtensionDefinition
-typeExtensionDefinition = TypeExtensionDefinition
- <$ tok "extend"
- <*> objectTypeDefinition
-
--- * Internal
-
-tok :: Parser a -> Parser a
-tok p = p <* whiteSpace
-
-parens :: Parser a -> Parser a
-parens = between "(" ")"
-
-braces :: Parser a -> Parser a
-braces = between "{" "}"
-
-quotes :: Parser a -> Parser a
-quotes = between "\"" "\""
-
-brackets :: Parser a -> Parser a
-brackets = between "[" "]"
-
-between :: Parser Text -> Parser Text -> Parser a -> Parser a
-between open close p = tok open *> p <* tok close
-
--- `empty` /= `pure mempty` for `Parser`.
-optempty :: Monoid a => Parser a -> Parser a
-optempty = option mempty
-
--- ** WhiteSpace
---
-whiteSpace :: Parser ()
-whiteSpace = peekChar >>= traverse_ (\c ->
- if isSpace c || c == ','
- then anyChar *> whiteSpace
- else when (c == '#') $ manyTill anyChar endOfLine *> whiteSpace)