Parse SchemaDefinition

src/Language/GraphQL/AST/Document.hs

@@ -5,7 +5,7 @@
 module Language.GraphQL.AST.Document
     ( Alias
     , Argument(..)
-    , Definition(ExecutableDefinition)
+    , Definition(ExecutableDefinition, TypeSystemDefinition)
     , Directive(..)
     , Document
     , ExecutableDefinition(..)
@@ -15,11 +15,14 @@ module Language.GraphQL.AST.Document
     , ObjectField(..)
     , OperationDefinition(..)
     , OperationType(..)
+    , OperationTypeDefinition(..)
+    , OperationTypeDefinitions
     , Selection(..)
     , SelectionSet
     , SelectionSetOpt
     , Type(..)
     , TypeCondition
+    , TypeSystemDefinition(..)
     , Value(..)
     , VariableDefinition(..)
     ) where
@@ -228,7 +231,7 @@ data Directive = Directive Name [Argument] deriving (Eq, Show)
 -- * Type System
 
 data TypeSystemDefinition
-    = SchemaDefinition [Directive] RootOperationTypeDefinitions
+    = SchemaDefinition [Directive] OperationTypeDefinitions
     | TypeDefinition TypeDefinition
     | DirectiveDefinition
         Description Name ArgumentsDefinition DirectiveLocation
@@ -243,14 +246,14 @@ data TypeSystemExtension
 
 -- ** Schema
 
-type RootOperationTypeDefinitions = NonEmpty RootOperationTypeDefinition
+type OperationTypeDefinitions = NonEmpty OperationTypeDefinition
 
-data RootOperationTypeDefinition
+data OperationTypeDefinition
-    = RootOperationTypeDefinition OperationType NamedType
+    = OperationTypeDefinition OperationType NamedType
     deriving (Eq, Show)
 
 data SchemaExtension
-    = SchemaOperationExtension [Directive] RootOperationTypeDefinitions
+    = SchemaOperationExtension [Directive] OperationTypeDefinitions
     | SchemaDirectiveExtension (NonEmpty Directive)
     deriving (Eq, Show)
 

src/Language/GraphQL/AST/Parser.hs

@@ -8,21 +8,44 @@ module Language.GraphQL.AST.Parser
 
 import Control.Applicative (Alternative(..), optional)
 import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
-import Language.GraphQL.AST
+import Language.GraphQL.AST.Document
-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 :: Parser Document
 document = unicodeBOM
     >> spaceConsumer
-    >> lexeme (NonEmpty.some $ Document.ExecutableDefinition <$> definition)
+    >> lexeme (NonEmpty.some definition)
 
-definition :: Parser ExecutableDefinition
+definition :: Parser Definition
-definition = DefinitionOperation <$> operationDefinition
+definition = ExecutableDefinition <$> executableDefinition
-         <|> DefinitionFragment  <$> fragmentDefinition
+    <|> TypeSystemDefinition <$> typeSystemDefinition
-         <?> "definition error!"
+    <?> "Definition"
+
+executableDefinition :: Parser ExecutableDefinition
+executableDefinition = DefinitionOperation <$> operationDefinition
+    <|> DefinitionFragment  <$> fragmentDefinition
+    <?> "ExecutableDefinition"
+
+typeSystemDefinition :: Parser TypeSystemDefinition
+typeSystemDefinition = schemaDefinition
+
+schemaDefinition :: Parser TypeSystemDefinition
+schemaDefinition = SchemaDefinition
+    <$ symbol "schema"
+    <*> opt directives
+    <*> operationTypeDefinitions
+    <?> "SchemaDefinition"
+
+operationTypeDefinitions :: Parser OperationTypeDefinitions
+operationTypeDefinitions  = braces $ manyNE operationTypeDefinition
+
+operationTypeDefinition :: Parser OperationTypeDefinition
+operationTypeDefinition = OperationTypeDefinition
+    <$> operationType <* colon
+    <*> name
+    <?> "OperationTypeDefinition"
 
 operationDefinition :: Parser OperationDefinition
 operationDefinition = SelectionSet <$> selectionSet
@@ -39,7 +62,7 @@ operationDefinition = SelectionSet <$> selectionSet
 operationType :: Parser OperationType
 operationType = Query <$ symbol "query"
     <|> Mutation <$ symbol "mutation"
-    <?> "operationType error"
+    -- <?> Keep default error message
 
 -- * SelectionSet
 

tests/Language/GraphQL/AST/ParserSpec.hs

@@ -42,3 +42,6 @@ spec = describe "Parser" $ do
             mutation auth{
                 test(username: """username""", password: """password""")
             }|]
+
+    it "parses minimal schema definition" $
+        parse document "" `shouldSucceedOn` [r|schema { query: Query }|]