Parse ObjectDefinition

This commit is contained in:
Eugen Wissner 2020-01-05 07:42:04 +01:00
parent d9a2937b55
commit 8efb08fda1
5 changed files with 135 additions and 27 deletions

View File

@ -9,6 +9,7 @@ and this project adheres to
## [Unreleased]
### Added
- AST for the GraphQL schema.
- Parser for the SchemaDefinition
- `Trans.argument`.
### Changed

View File

@ -5,11 +5,17 @@
module Language.GraphQL.AST.Document
( Alias
, Argument(..)
, ArgumentsDefinition(..)
, Definition(ExecutableDefinition, TypeSystemDefinition)
, Description(..)
, Directive(..)
, Document
, ExecutableDefinition(..)
, FieldDefinition(..)
, FragmentDefinition(..)
, ImplementsInterfaces(..)
, ImplementsInterfacesOpt(..)
, InputValueDefinition(..)
, Name
, NonNullType(..)
, ObjectField(..)
@ -22,6 +28,7 @@ module Language.GraphQL.AST.Document
, SelectionSetOpt
, Type(..)
, TypeCondition
, TypeDefinition(..)
, TypeSystemDefinition(..)
, Value(..)
, VariableDefinition(..)
@ -302,13 +309,27 @@ newtype ImplementsInterfaces = ImplementsInterfaces (NonEmpty NamedType)
newtype ImplementsInterfacesOpt = ImplementsInterfacesOpt [NamedType]
deriving (Eq, Show)
instance Semigroup ImplementsInterfacesOpt where
(ImplementsInterfacesOpt xs) <> (ImplementsInterfacesOpt ys) =
ImplementsInterfacesOpt $ xs <> ys
instance Monoid ImplementsInterfacesOpt where
mempty = ImplementsInterfacesOpt []
data FieldDefinition
= FieldDefinition Description Name ArgumentsDefinition Type
= FieldDefinition Description Name ArgumentsDefinition Type [Directive]
deriving (Eq, Show)
newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
deriving (Eq, Show)
instance Semigroup ArgumentsDefinition where
(ArgumentsDefinition xs) <> (ArgumentsDefinition ys) =
ArgumentsDefinition $ xs <> ys
instance Monoid ArgumentsDefinition where
mempty = ArgumentsDefinition []
data InputValueDefinition
= InputValueDefinition Description Name Type (Maybe Value) [Directive]
deriving (Eq, Show)

View File

@ -28,15 +28,8 @@ module Language.GraphQL.AST.Lexer
, unicodeBOM
) where
import Control.Applicative ( Alternative(..)
, liftA2
)
import Data.Char ( chr
, digitToInt
, isAsciiLower
, isAsciiUpper
, ord
)
import Control.Applicative (Alternative(..), liftA2)
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
import Data.Foldable (foldl')
import Data.List (dropWhileEnd)
import Data.Proxy (Proxy(..))
@ -56,10 +49,7 @@ import Text.Megaparsec ( Parsec
, takeWhile1P
, try
)
import Text.Megaparsec.Char ( char
, digitChar
, space1
)
import Text.Megaparsec.Char (char, digitChar, space1)
import qualified Text.Megaparsec.Char.Lexer as Lexer
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

View File

@ -8,6 +8,7 @@ module Language.GraphQL.AST.Parser
import Control.Applicative (Alternative(..), optional)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Control.Applicative.Combinators (sepBy)
import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Lexer
import Text.Megaparsec (lookAhead, option, try, (<?>))
@ -30,6 +31,76 @@ executableDefinition = DefinitionOperation <$> operationDefinition
typeSystemDefinition :: Parser TypeSystemDefinition
typeSystemDefinition = schemaDefinition
<|> TypeDefinition <$> typeDefinition
<?> "TypeSystemDefinition"
typeDefinition :: Parser TypeDefinition
typeDefinition = scalarTypeDefinition
<|> objectTypeDefinition
<?> "TypeDefinition"
scalarTypeDefinition :: Parser TypeDefinition
scalarTypeDefinition = ScalarTypeDefinition
<$> description
<* symbol "scalar"
<*> name
<*> opt directives
<?> "ScalarTypeDefinition"
objectTypeDefinition :: Parser TypeDefinition
objectTypeDefinition = ObjectTypeDefinition
<$> description
<* symbol "type"
<*> name
<*> opt implementsInterfacesOpt
<*> opt directives
<*> braces (many fieldDefinition)
<?> "ObjectTypeDefinition"
description :: Parser Description
description = Description
<$> optional (string <|> blockString)
<?> "Description"
{- TODO:
implementsInterfaces :: Parser ImplementsInterfaces
implementsInterfaces = ImplementsInterfaces
<$ symbol "implements"
<* optional amp
<*> name `sepBy1` amp
<?> "ImplementsInterfaces" -}
implementsInterfacesOpt :: Parser ImplementsInterfacesOpt
implementsInterfacesOpt = ImplementsInterfacesOpt
<$ symbol "implements"
<* optional amp
<*> name `sepBy` amp
<?> "ImplementsInterfaces"
inputValueDefinition :: Parser InputValueDefinition
inputValueDefinition = InputValueDefinition
<$> description
<*> name
<* colon
<*> type'
<*> defaultValue
<*> opt directives
<?> "InputValueDefinition"
argumentsDefinition :: Parser ArgumentsDefinition
argumentsDefinition = ArgumentsDefinition
<$> parens (many inputValueDefinition)
<?> "ArgumentsDefinition"
fieldDefinition :: Parser FieldDefinition
fieldDefinition = FieldDefinition
<$> description
<*> name
<*> opt argumentsDefinition
<* colon
<*> type'
<*> opt directives
<?> "FieldDefinition"
schemaDefinition :: Parser TypeSystemDefinition
schemaDefinition = SchemaDefinition
@ -157,7 +228,7 @@ value = Variable <$> variable
objectValue = braces $ some objectField
objectField :: Parser ObjectField
objectField = ObjectField <$> name <* symbol ":" <*> value
objectField = ObjectField <$> name <* colon <*> value
-- * Variables
@ -168,26 +239,27 @@ variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition
<$> variable
<* colon
<*> type_
<*> optional defaultValue
<*> type'
<*> defaultValue
<?> "VariableDefinition"
variable :: Parser Name
variable = dollar *> name
defaultValue :: Parser Value
defaultValue = equals *> value
defaultValue :: Parser (Maybe Value)
defaultValue = optional (equals *> value) <?> "DefaultValue"
-- * Input Types
type_ :: Parser Type
type_ = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type_
type' :: Parser Type
type' = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type'
<|> TypeNamed <$> name
<?> "type_ error!"
<?> "Type"
nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang
<|> NonNullTypeList <$> brackets type_ <* bang
<|> NonNullTypeList <$> brackets type' <* bang
<?> "nonNullType error!"
-- * Directives

View File

@ -45,3 +45,27 @@ spec = describe "Parser" $ do
it "parses minimal schema definition" $
parse document "" `shouldSucceedOn` [r|schema { query: Query }|]
it "parses minimal scalar definition" $
parse document "" `shouldSucceedOn` [r|scalar Time|]
it "parses ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [r|
type Person implements NamedEntity & ValuedEntity {
name: String
}
|]
it "parses a type without ImplementsInterfaces" $
parse document "" `shouldSucceedOn` [r|
type Person {
name: String
}
|]
it "parses ArgumentsDefinition in an ObjectDefinition" $
parse document "" `shouldSucceedOn` [r|
type Person {
name(first: String, last: String): String
}
|]