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] ## [Unreleased]
### Added ### Added
- AST for the GraphQL schema. - AST for the GraphQL schema.
- Parser for the SchemaDefinition
- `Trans.argument`. - `Trans.argument`.
### Changed ### Changed

View File

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

View File

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

View File

@ -8,6 +8,7 @@ module Language.GraphQL.AST.Parser
import Control.Applicative (Alternative(..), optional) import Control.Applicative (Alternative(..), optional)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Control.Applicative.Combinators (sepBy)
import Language.GraphQL.AST.Document import Language.GraphQL.AST.Document
import Language.GraphQL.AST.Lexer import Language.GraphQL.AST.Lexer
import Text.Megaparsec (lookAhead, option, try, (<?>)) import Text.Megaparsec (lookAhead, option, try, (<?>))
@ -30,6 +31,76 @@ executableDefinition = DefinitionOperation <$> operationDefinition
typeSystemDefinition :: Parser TypeSystemDefinition typeSystemDefinition :: Parser TypeSystemDefinition
typeSystemDefinition = schemaDefinition 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 :: Parser TypeSystemDefinition
schemaDefinition = SchemaDefinition schemaDefinition = SchemaDefinition
@ -157,7 +228,7 @@ value = Variable <$> variable
objectValue = braces $ some objectField objectValue = braces $ some objectField
objectField :: Parser ObjectField objectField :: Parser ObjectField
objectField = ObjectField <$> name <* symbol ":" <*> value objectField = ObjectField <$> name <* colon <*> value
-- * Variables -- * Variables
@ -168,26 +239,27 @@ variableDefinition :: Parser VariableDefinition
variableDefinition = VariableDefinition variableDefinition = VariableDefinition
<$> variable <$> variable
<* colon <* colon
<*> type_ <*> type'
<*> optional defaultValue <*> defaultValue
<?> "VariableDefinition"
variable :: Parser Name variable :: Parser Name
variable = dollar *> name variable = dollar *> name
defaultValue :: Parser Value defaultValue :: Parser (Maybe Value)
defaultValue = equals *> value defaultValue = optional (equals *> value) <?> "DefaultValue"
-- * Input Types -- * Input Types
type_ :: Parser Type type' :: Parser Type
type_ = try (TypeNonNull <$> nonNullType) type' = try (TypeNonNull <$> nonNullType)
<|> TypeList <$> brackets type_ <|> TypeList <$> brackets type'
<|> TypeNamed <$> name <|> TypeNamed <$> name
<?> "type_ error!" <?> "Type"
nonNullType :: Parser NonNullType nonNullType :: Parser NonNullType
nonNullType = NonNullTypeNamed <$> name <* bang nonNullType = NonNullTypeNamed <$> name <* bang
<|> NonNullTypeList <$> brackets type_ <* bang <|> NonNullTypeList <$> brackets type' <* bang
<?> "nonNullType error!" <?> "nonNullType error!"
-- * Directives -- * Directives

View File

@ -45,3 +45,27 @@ spec = describe "Parser" $ do
it "parses minimal schema definition" $ it "parses minimal schema definition" $
parse document "" `shouldSucceedOn` [r|schema { query: Query }|] 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
}
|]