Split AST in 2

One AST is meant to be a target parser and tries to adhere as much as possible to the spec. The other is a simplified version of that AST meant for execution. Also newtypes have been replaced by type synonyms and NonEmpty lists are being used where it makes sense.
2017-01-28 14:15:14 -03:00 · 2017-01-28 14:15:14 -03:00 · 5390c4ca1e
commit 5390c4ca1e
parent 3e991adf4e
9 changed files with 281 additions and 287 deletions
--- a/Data/GraphQL/AST.hs
+++ b/Data/GraphQL/AST.hs
@ -1,11 +1,13 @@
 -- | This module defines an abstract syntax tree for the @GraphQL@ language based on
 --   <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
+--
+-- Target AST for Parser.

 module Data.GraphQL.AST where

 import Data.Int (Int32)
-import Data.String (IsString(fromString))
-import Data.Text (Text, pack)
+import Data.List.NonEmpty (NonEmpty)
+import Data.Text (Text)

 -- * Name

@ -13,116 +15,117 @@ type Name = Text

 -- * Document

-newtype Document = Document [Definition] deriving (Eq,Show)
+type Document = NonEmpty Definition
+
+-- * Operations

 data Definition = DefinitionOperation OperationDefinition
                | DefinitionFragment  FragmentDefinition
                  deriving (Eq,Show)

-data OperationDefinition = Query    Node
-                         | Mutation Node
+data OperationDefinition = OperationSelectionSet SelectionSet
+                         | OperationDefinition   OperationType
+                                                 Name
+                                                 VariableDefinitions
+                                                 Directives
+                                                 SelectionSet
                           deriving (Eq,Show)

-data Node = Node Name [VariableDefinition] [Directive] SelectionSet
-            deriving (Eq,Show)
+data OperationType = Query | Mutation deriving (Eq,Show)

-data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
-                          deriving (Eq,Show)
+-- * SelectionSet

-newtype Variable = Variable Name deriving (Eq,Show)
+type SelectionSet = NonEmpty Selection

-instance IsString Variable where
-    fromString = Variable . pack
-
-type SelectionSet = [Selection]
+type SelectionSetOpt = [Selection]

 data Selection = SelectionField          Field
               | SelectionFragmentSpread FragmentSpread
               | SelectionInlineFragment InlineFragment
                 deriving (Eq,Show)

-- | A 'SelectionSet' is primarily composed of 'Field's. A 'Field' describes one
--   discrete piece of information available to request within a 'SelectionSet'.
--
--   Some 'Field's describe complex data or relationships to other data. In
--   order to further explore this data, a 'Field' may itself contain a
--   'SelectionSet', allowing for deeply nested requests. All @GraphQL@ operations
--   must specify their 'Selection's down to 'Field's which return scalar values to
--   ensure an unambiguously shaped response.
--
--   <https://facebook.github.io/graphql/#sec-Language.Query-Document.Fields Field Specification>
-data Field = Field Alias Name [Argument] [Directive] SelectionSet
+-- * Field
+
+data Field = Field (Maybe Alias) Name Arguments Directives SelectionSetOpt
             deriving (Eq,Show)

 type Alias = Name

-- | 'Field's are conceptually functions which return values, and occasionally accept
--   'Argument's which alter their behavior. These 'Argument's often map directly to
--   function arguments within a @GraphQL@ server’s implementation.
--
--   <https://facebook.github.io/graphql/#sec-Language.Query-Document.Arguments Argument Specification>
+-- * Arguments
+
+type Arguments = [Argument]
+
 data Argument = Argument Name Value deriving (Eq,Show)

 -- * Fragments

-data FragmentSpread = FragmentSpread Name [Directive]
-                      deriving (Eq,Show)
+data FragmentSpread = FragmentSpread Name Directives deriving (Eq,Show)

-data InlineFragment =
-    InlineFragment TypeCondition [Directive] SelectionSet
+data InlineFragment = InlineFragment (Maybe TypeCondition) Directives SelectionSet
                      deriving (Eq,Show)

 data FragmentDefinition =
-    FragmentDefinition Name TypeCondition [Directive] SelectionSet
+  FragmentDefinition FragmentName TypeCondition Directives SelectionSet
  deriving (Eq,Show)

-type TypeCondition = NamedType
+type FragmentName = Name

-- * Values
+type TypeCondition = Name
+
+-- Input Values

-- | 'Field' and 'Directive' 'Arguments' accept input values of various literal
--   primitives; input values can be scalars, enumeration values, lists, or input
--   objects.
--
--   If not defined as constant (for example, in 'DefaultValue'), input values
--   can be specified as a 'Variable'. List and inputs objects may also contain
--   'Variable's (unless defined to be constant).
--
--   <https://facebook.github.io/graphql/#sec-Input-Values Input Value Specification>
 data Value = ValueVariable Variable
-           | ValueInt Int32
-           -- GraphQL Float is double precison
-           | ValueFloat Double
-           | ValueBoolean Bool
-           | ValueString Text
-           | ValueEnum Name
+           | ValueInt IntValue
+           | ValueFloat FloatValue
+           | ValueString StringValue
+           | ValueBoolean BooleanValue
+           | ValueNull
+           | ValueEnum EnumValue
           | ValueList ListValue
           | ValueObject ObjectValue
             deriving (Eq,Show)

-newtype ListValue = ListValue [Value] deriving (Eq,Show)
+type IntValue = Int32

-newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)
+-- GraphQL Float is double precison
+type FloatValue = Double
+
+type StringValue = Text
+
+type BooleanValue = Bool
+
+type EnumValue = Name
+
+type ListValue = [Value]
+
+type ObjectValue = [ObjectField]

 data ObjectField = ObjectField Name Value deriving (Eq,Show)

+-- * Variables
+
+type VariableDefinitions = [VariableDefinition]
+
+data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
+                          deriving (Eq,Show)
+
+type Variable = Name
+
 type DefaultValue = Value

-- * Directives
+-- * Input Types

-data Directive = Directive Name [Argument] deriving (Eq,Show)
-
-- * Type Reference
-
-data Type = TypeNamed NamedType
-          | TypeList ListType
+data Type = TypeNamed   Name
+          | TypeList    Type
          | TypeNonNull NonNullType
            deriving (Eq,Show)

-newtype NamedType = NamedType Name deriving (Eq,Show)
-
-newtype ListType = ListType Type deriving (Eq,Show)
-
-data NonNullType = NonNullTypeNamed NamedType
-                 | NonNullTypeList  ListType
+data NonNullType = NonNullTypeNamed Name
+                 | NonNullTypeList  Type
                   deriving (Eq,Show)
+
+-- * Directives
+
+type Directives = [Directive]
+
+data Directive = Directive Name [Argument] deriving (Eq,Show)
--- a/Data/GraphQL/AST/Core.hs
+++ b/Data/GraphQL/AST/Core.hs
@ -6,15 +6,17 @@ import Data.List.NonEmpty (NonEmpty)

 import Data.Text (Text)

-newtype Name = Name Text deriving (Eq,Show)
+type Name = Text

-newtype Document = Document (NonEmpty Operation) deriving (Eq,Show)
+type Document = NonEmpty Operation

 data Operation = Query    (NonEmpty Field)
               | Mutation (NonEmpty Field)
                 deriving (Eq,Show)

-data Field = Field Name [Argument] [Field] deriving (Eq,Show)
+data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show)
+
+type Alias = Name

 data Argument = Argument Name Value deriving (Eq,Show)

--- a/Data/GraphQL/Encoder.hs
+++ b/Data/GraphQL/Encoder.hs
@ -2,7 +2,9 @@
 -- | This module defines a printer for the @GraphQL@ language.
 module Data.GraphQL.Encoder where

+import Data.Foldable (fold)
 import Data.Monoid ((<>))
+import qualified Data.List.NonEmpty as NonEmpty (toList)

 import Data.Text (Text, cons, intercalate, pack, snoc)

@ -10,24 +12,26 @@ import Data.GraphQL.AST

 -- * Document

-- TODO: Use query shorthand
 document :: Document -> Text
-document (Document defs) = (`snoc` '\n') . mconcat $ definition <$> defs
+document defs = (`snoc` '\n') . mconcat . NonEmpty.toList $ definition <$> defs

 definition :: Definition -> Text
 definition (DefinitionOperation x) = operationDefinition x
 definition (DefinitionFragment  x) = fragmentDefinition x

 operationDefinition :: OperationDefinition -> Text
-operationDefinition (Query    n) = "query "    <> node n
-operationDefinition (Mutation n) = "mutation " <> node n
+operationDefinition (OperationSelectionSet sels) = selectionSet sels
+operationDefinition (OperationDefinition Query    name vars dirs sels) =
+  "query " <> node name vars dirs sels
+operationDefinition (OperationDefinition Mutation name vars dirs sels) =
+  "mutation " <> node name vars dirs sels

-node :: Node -> Text
-node (Node name vds ds ss) =
+node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text
+node name vars dirs sels =
       name
-    <> optempty variableDefinitions vds
-    <> optempty directives ds
-    <> selectionSet ss
+    <> optempty variableDefinitions vars
+    <> optempty directives dirs
+    <> selectionSet sels

 variableDefinitions :: [VariableDefinition] -> Text
 variableDefinitions = parensCommas variableDefinition
@ -40,10 +44,13 @@ defaultValue :: DefaultValue -> Text
 defaultValue val = "=" <> value val

 variable :: Variable -> Text
-variable (Variable name) = "$" <> name
+variable var = "$" <> var

 selectionSet :: SelectionSet -> Text
-selectionSet = bracesCommas selection
+selectionSet = bracesCommas selection . NonEmpty.toList
+
+selectionSetOpt :: SelectionSetOpt -> Text
+selectionSetOpt = bracesCommas selection

 selection :: Selection -> Text
 selection (SelectionField          x) = field x
@ -51,12 +58,12 @@ selection (SelectionInlineFragment x) = inlineFragment x
 selection (SelectionFragmentSpread x) = fragmentSpread x

 field :: Field -> Text
-field (Field alias name args ds ss) =
-       optempty (`snoc` ':') alias
+field (Field alias name args dirs selso) =
+       optempty (`snoc` ':') (fold alias)
    <> name
    <> optempty arguments args
-    <> optempty directives ds
-    <> optempty selectionSet ss
+    <> optempty directives dirs
+    <> optempty selectionSetOpt selso

 arguments :: [Argument] -> Text
 arguments = parensCommas argument
@ -71,26 +78,27 @@ fragmentSpread (FragmentSpread name ds) =
    "..." <> name <> optempty directives ds

 inlineFragment :: InlineFragment -> Text
-inlineFragment (InlineFragment (NamedType tc) ds ss) =
-    "... on " <> tc
-              <> optempty directives ds
-              <> optempty selectionSet ss
+inlineFragment (InlineFragment tc dirs sels) =
+    "... on " <> fold tc
+              <> directives dirs
+              <> selectionSet sels

 fragmentDefinition :: FragmentDefinition -> Text
-fragmentDefinition (FragmentDefinition name (NamedType tc) ds ss) =
+fragmentDefinition (FragmentDefinition name tc dirs sels) =
    "fragment " <> name <> " on " <> tc
-                <> optempty directives ds
-                <> selectionSet ss
+                <> optempty directives dirs
+                <> selectionSet sels

 -- * Values

 value :: Value -> Text
 value (ValueVariable x) = variable x
-- TODO: This will be replaced with `decimal` Buidler
+-- TODO: This will be replaced with `decimal` Builder
 value (ValueInt      x) = pack $ show x
-- TODO: This will be replaced with `decimal` Buidler
+-- TODO: This will be replaced with `decimal` Builder
 value (ValueFloat    x) = pack $ show x
 value (ValueBoolean  x) = booleanValue x
+value ValueNull         = mempty
 value (ValueString   x) = stringValue x
 value (ValueEnum     x) = x
 value (ValueList     x) = listValue x
@ -105,10 +113,10 @@ stringValue :: Text -> Text
 stringValue = quotes

 listValue :: ListValue -> Text
-listValue (ListValue vs) = bracketsCommas value vs
+listValue = bracketsCommas value

 objectValue :: ObjectValue -> Text
-objectValue (ObjectValue ofs) = bracesCommas objectField ofs
+objectValue = bracesCommas objectField

 objectField :: ObjectField -> Text
 objectField (ObjectField name v) = name <> ":" <> value v
@ -124,18 +132,15 @@ directive (Directive name args) = "@" <> name <> optempty arguments args
 -- * Type Reference

 type_ :: Type -> Text
-type_ (TypeNamed (NamedType x)) = x
+type_ (TypeNamed   x) = x
 type_ (TypeList    x) = listType x
 type_ (TypeNonNull x) = nonNullType x

-namedType :: NamedType -> Text
-namedType (NamedType name) = name
-
-listType :: ListType -> Text
-listType (ListType ty) = brackets (type_ ty)
+listType :: Type -> Text
+listType x = brackets (type_ x)

 nonNullType :: NonNullType -> Text
-nonNullType (NonNullTypeNamed (NamedType x)) = x <> "!"
+nonNullType (NonNullTypeNamed x) = x <> "!"
 nonNullType (NonNullTypeList  x) = listType x <> "!"

 -- * Internal
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@ -21,38 +21,37 @@ import Data.GraphQL.Error
 --   errors wrapped in an /errors/ field.
 execute :: Alternative f
  => Schema.Schema f -> Schema.Subs -> Document -> f Aeson.Value
-execute (Schema resolvs) subs doc = runCollectErrs res
-  where res = Schema.resolvers resolvs $ rootFields subs doc
+execute resolvers subs doc = undefined -- resolver resolvs $ rootFields subs doc

 -- | Takes a variable substitution function and a @GraphQL@ document.
 --   If the document contains one query (and no other definitions)
 --   it applies the substitution to the query's set of selections
 --   and then returns their fields.
-rootFields :: Schema.Subs -> Document -> [Field]
-rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
-    Schema.fields $ substitute subs <$> sels
-rootFields _ _ = []
+-- rootFields :: Schema.Subs -> Document -> [Field]
+-- rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
+--     Schema.fields $ substitute subs <$> sels
+-- rootFields _ _ = []

 -- | Takes a variable substitution function and a selection. If the
 --   selection is a field it applies the substitution to the field's
 --   arguments using 'subsArg', and recursively applies the substitution to
 --   the arguments of fields nested in the primary field.
-substitute :: Schema.Subs -> Selection -> Selection
-substitute subs (SelectionField (Field alias name args directives sels)) =
-    SelectionField $ Field
-      alias
-      name
-      -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
-      (catMaybes $ subsArg subs <$> args)
-      directives
-      (substitute subs <$> sels)
-substitute _ sel = sel
+-- substitute :: Schema.Subs -> Selection -> Selection
+-- substitute subs (SelectionField (Field alias name args directives sels)) =
+--     SelectionField $ Field
+--       alias
+--       name
+--       -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
+--       (catMaybes $ subsArg subs <$> args)
+--       directives
+--       (substitute subs <$> sels)
+-- substitute _ sel = sel

 -- TODO: Support different value types
 -- | Takes a variable substitution function and an argument. If the
 --   argument's value is a variable the substitution is applied to the
 --   variable's name.
-subsArg :: Schema.Subs -> Argument -> Maybe Argument
-subsArg subs (Argument n (ValueVariable (Variable v))) =
-    Argument n . ValueString <$> subs v
-subsArg _ arg = Just arg
+-- subsArg :: Schema.Subs -> Argument -> Maybe Argument
+-- subsArg subs (Argument n (ValueVariable (Variable v))) =
+--     Argument n . ValueString <$> subs v
+-- subsArg _ arg = Just arg
--- a/Data/GraphQL/Parser.hs
+++ b/Data/GraphQL/Parser.hs
@ -1,27 +1,31 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
 -- | This module defines a parser for @GraphQL@ request documents.
 module Data.GraphQL.Parser where

 import Prelude hiding (takeWhile)

-import Control.Applicative ((<|>), empty, many, optional)
+import Control.Applicative ((<|>), Alternative, empty, many, optional)
 import Control.Monad (when)
 import Data.Char (isDigit, isSpace)
 import Data.Foldable (traverse_)
+import Data.Monoid ((<>))
+import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.Scientific (floatingOrInteger)

 import Data.Text (Text, append)
+import Data.Attoparsec.Combinator (lookAhead)
 import Data.Attoparsec.Text
  ( Parser
  , (<?>)
  , anyChar
-  , scientific
  , endOfLine
  , inClass
  , many1
  , manyTill
  , option
  , peekChar
+  , scientific
  , takeWhile
  , takeWhile1
  )
@ -35,20 +39,12 @@ name = tok $ append <$> takeWhile1 isA_z
                    <*> takeWhile ((||) <$> isDigit <*> isA_z)
  where
    -- `isAlpha` handles many more Unicode Chars
-    isA_z =  inClass $ '_' : ['A'..'Z'] ++ ['a'..'z']
+    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!"
+document = whiteSpace *> manyNE definition

 definition :: Parser Definition
 definition = DefinitionOperation <$> operationDefinition
@ -56,54 +52,48 @@ definition = DefinitionOperation <$> operationDefinition
         <?> "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
+operationDefinition = OperationSelectionSet <$> selectionSet
+                  <|> OperationDefinition   <$> operationType
+                                            <*> name
+                                            <*> opt variableDefinitions
+                                            <*> opt directives
                                            <*> selectionSet
+                  <?> "operationDefinition error"

-variableDefinitions :: Parser [VariableDefinition]
-variableDefinitions = parens (many1 variableDefinition)
+operationType :: Parser OperationType
+operationType = Query    <$ tok "query"
+            <|> Mutation <$ tok "mutation"
+            <?> "operationType error"

-variableDefinition :: Parser VariableDefinition
-variableDefinition =
-    VariableDefinition <$> variable
-                       <*  tok ":"
-                       <*> type_
-                       <*> optional defaultValue
-
-defaultValue :: Parser DefaultValue
-defaultValue = tok "=" *> value
-
-variable :: Parser Variable
-variable = Variable <$ tok "$" <*> name
+-- * SelectionSet

 selectionSet :: Parser SelectionSet
-selectionSet = braces $ many1 selection
+selectionSet = braces $ manyNE selection
+
+selectionSetOpt :: Parser SelectionSetOpt
+selectionSetOpt = braces $ many1 selection

 selection :: Parser Selection
 selection = SelectionField          <$> field
-            -- Inline first to catch `on` case
-        <|> SelectionInlineFragment <$> inlineFragment
        <|> SelectionFragmentSpread <$> fragmentSpread
+        <|> SelectionInlineFragment <$> inlineFragment
        <?> "selection error!"

+-- * Field
+
 field :: Parser Field
-field = Field <$> optempty alias
+field = Field <$> optional alias
              <*> name
-              <*> optempty arguments
-              <*> optempty directives
-              <*> optempty selectionSet
+              <*> opt arguments
+              <*> opt directives
+              <*> opt selectionSetOpt

 alias :: Parser Alias
 alias = name <* tok ":"

-arguments :: Parser [Argument]
+-- * Arguments
+
+arguments :: Parser Arguments
 arguments = parens $ many1 argument

 argument :: Parser Argument
@ -112,98 +102,103 @@ 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
+fragmentSpread = FragmentSpread <$  tok "..."
+                                <*> fragmentName
+                                <*> opt directives

-- InlineFragment tried first in order to guard against 'on' keyword
 inlineFragment :: Parser InlineFragment
-inlineFragment = InlineFragment
-    <$  tok "..."
-    <*  tok "on"
-    <*> typeCondition
-    <*> optempty directives
+inlineFragment = InlineFragment <$  tok "..."
+                                <*> optional typeCondition
+                                <*> opt directives
                                <*> selectionSet

 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
                 <$  tok "fragment"
                 <*> name
-    <*  tok "on"
                 <*> typeCondition
-    <*> optempty directives
+                 <*> opt directives
                 <*> selectionSet

+fragmentName :: Parser FragmentName
+fragmentName = but (tok "on") *> name
+
 typeCondition :: Parser TypeCondition
-typeCondition = namedType
+typeCondition = tok "on" *> name

-- * Values
+-- * Input 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.
    <|> tok (either ValueFloat ValueInt . floatingOrInteger <$> scientific)
    <|> ValueBoolean  <$> booleanValue
+    <|> ValueNull     <$  tok "null"
    <|> ValueString   <$> stringValue
-    -- `true` and `false` have been tried before
-    <|> ValueEnum     <$> name
+    <|> ValueEnum     <$> enumValue
    <|> ValueList     <$> listValue
    <|> ValueObject   <$> objectValue
    <?> "value error!"
-
-booleanValue :: Parser Bool
-booleanValue = True  <$ tok "true"
+  where
+    booleanValue :: Parser Bool
+    booleanValue = True  <$ tok "true"
               <|> False <$ tok "false"

-- TODO: Escape characters. Look at `jsstring_` in aeson package.
-stringValue :: Parser Text
-stringValue = quotes (takeWhile (/= '"'))
+    -- TODO: Escape characters. Look at `jsstring_` in aeson package.
+    stringValue :: Parser Text
+    stringValue = quotes (takeWhile (/= '"'))

-- Notice it can be empty
-listValue :: Parser ListValue
-listValue = ListValue <$> brackets (many value)
+    enumValue :: Parser Name
+    enumValue = but (tok "true") *> but (tok "false") *> but (tok "null") *> name

-- Notice it can be empty
-objectValue :: Parser ObjectValue
-objectValue = ObjectValue <$> braces (many objectField)
+    listValue :: Parser [Value]
+    listValue = brackets $ many1 value
+
+    objectValue :: Parser [ObjectField]
+    objectValue = braces $ many1 objectField

 objectField :: Parser ObjectField
 objectField = ObjectField <$> name <* tok ":" <*> value

+-- * Variables
+
+variableDefinitions :: Parser VariableDefinitions
+variableDefinitions = parens $ many1 variableDefinition
+
+variableDefinition :: Parser VariableDefinition
+variableDefinition = VariableDefinition <$> variable
+                                        <*  tok ":"
+                                        <*> type_
+                                        <*> optional defaultValue
+
+variable :: Parser Variable
+variable = tok "$" *> name
+
+defaultValue :: Parser DefaultValue
+defaultValue = tok "=" *> value
+
+-- * Input Types
+
+type_ :: Parser Type
+type_ = TypeNamed   <$> name
+    <|> TypeList    <$> brackets type_
+    <|> TypeNonNull <$> nonNullType
+    <?> "type_ error!"
+
+nonNullType :: Parser NonNullType
+nonNullType = NonNullTypeNamed <$> name <* tok "!"
+          <|> NonNullTypeList  <$> brackets type_  <* tok "!"
+          <?> "nonNullType error!"
+
 -- * Directives

-directives :: Parser [Directive]
+directives :: Parser Directives
 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!"
+        <*> opt arguments

 -- * Internal

@ -225,12 +220,18 @@ 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
+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

-- ** WhiteSpace
--
 whiteSpace :: Parser ()
 whiteSpace = peekChar >>= traverse_ (\c ->
    if isSpace c || c == ','
--- a/Data/GraphQL/Schema.hs
+++ b/Data/GraphQL/Schema.hs
@ -3,7 +3,7 @@
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 --   functions for defining and manipulating Schemas.
 module Data.GraphQL.Schema
-  ( Schema(..)
+  ( Schema
  , Resolver
  , Subs
  , object
@ -15,31 +15,31 @@ module Data.GraphQL.Schema
  , enum
  , enumA
  , resolvers
-  , fields
  -- * AST Reexports
  , Field
  , Argument(..)
  , Value(..)
  ) where

-import Data.Bifunctor (first)
-import Data.Monoid (Alt(Alt,getAlt))
 import Control.Applicative (Alternative((<|>), empty))
-import Data.Maybe (catMaybes)
+import Data.Bifunctor (first)
 import Data.Foldable (fold)
+import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (fromMaybe)
+import Data.Monoid (Alt(Alt,getAlt))

 import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
-import qualified Data.Text as T (null, unwords)
+import qualified Data.Text as T (unwords)

-import Data.GraphQL.AST
+import Data.GraphQL.AST.Core
 import Data.GraphQL.Error

 -- | A GraphQL schema.
 --   @f@ is usually expected to be an instance of 'Alternative'.
-data Schema f = Schema [Resolver f]
+type Schema f = NonEmpty (Resolver f)

 -- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information
 --   (or 'empty'). @f@ is usually expected to be an instance of 'Alternative'.
@ -48,8 +48,7 @@ type Resolver f = Field -> CollectErrsT f Aeson.Object
 -- | Variable substitution function.
 type Subs = Text -> Maybe Text

-- | Create a named 'Resolver' from a list of 'Resolver's.
-object :: Alternative f => Text -> [Resolver f] -> Resolver f
+object :: Alternative f => Name -> [Resolver f] -> Resolver f
 object name resolvs = objectA name $ \case
      [] -> resolvs
      _  -> empty
@ -57,9 +56,8 @@ object name resolvs = objectA name $ \case
 -- | Like 'object' but also taking 'Argument's.
 objectA
  :: Alternative f
-  => Text -> ([Argument] -> [Resolver f]) -> Resolver f
-objectA name f fld@(Field _ _ args _ sels) =
-    withField name (resolvers (f args) $ fields sels) fld
+  => Name -> ([Argument] -> [Resolver f]) -> Resolver f
+objectA name f fld@(Field _ _ args sels) = withField name (resolvers (f args) sels) fld

 -- | A scalar represents a primitive value, like a string or an integer.
 scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f
@ -70,11 +68,10 @@ scalar name s = scalarA name $ \case
 -- | Like 'scalar' but also taking 'Argument's.
 scalarA
  :: (Alternative f, Aeson.ToJSON a)
-  => Text -> ([Argument] -> f a) -> Resolver f
-scalarA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld
+  => Name -> ([Argument] -> f a) -> Resolver f
+scalarA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld
 scalarA _ _ _ = empty

-- | Like 'object' but taking lists of 'Resolver's instead of a single list.
 array :: Alternative f => Text -> [[Resolver f]] -> Resolver f
 array name resolvs = arrayA name $ \case
    [] -> resolvs
@ -84,8 +81,8 @@ array name resolvs = arrayA name $ \case
 arrayA
  :: Alternative f
  => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f
-arrayA name f fld@(Field _ _ args _ sels) =
-     withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ f args) fld
+arrayA name f fld@(Field _ _ args sels) =
+     withField name (joinErrs $ traverse (`resolvers` sels) $ f args) fld

 -- | Represents one of a finite set of possible values.
 --   Used in place of a 'scalar' when the possible responses are easily enumerable.
@ -96,19 +93,19 @@ enum name enums = enumA name $ \case

 -- | Like 'enum' but also taking 'Argument's.
 enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f
-enumA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld
+enumA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld
 enumA _ _ _ = empty

 -- | Helper function to facilitate 'Argument' handling.
 withField
  :: (Alternative f, Aeson.ToJSON a)
-  => Text -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value)
-withField name f (Field alias name' _ _ _) =
+  => Name -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value)
+withField name f (Field alias name' _ _) =
     if name == name'
        then fmap (first $ HashMap.singleton aliasOrName . Aeson.toJSON) f
        else empty
     where
-       aliasOrName = if T.null alias then name' else alias
+       aliasOrName = fromMaybe name' alias

 -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
 --   'Resolver' to each 'Field'. Resolves into a value containing the
@ -118,18 +115,8 @@ resolvers resolvs =
    fmap (first Aeson.toJSON . fold)
  . traverse (\fld -> getAlt (foldMap (Alt . ($ fld)) resolvs) <|> errmsg fld)
  where
-    errmsg (Field alias name _ _ _) = addErrMsg msg $ (errWrap . pure) val
+    errmsg (Field alias name _ _) = addErrMsg msg $ (errWrap . pure) val
       where
         val = HashMap.singleton aliasOrName Aeson.Null
         msg = T.unwords ["field", name, "not resolved."]
-         aliasOrName = if T.null alias then name else alias
-
-- | Checks whether the given 'Selection' contains a 'Field' and
--   returns the 'Field' if so, else returns 'Nothing'.
-field :: Selection -> Maybe Field
-field (SelectionField x) = Just x
-field _ = Nothing
-
-- | Returns a list of the 'Field's contained in the given 'SelectionSet'.
-fields :: SelectionSet -> [Field]
-fields = catMaybes . fmap field
+         aliasOrName = fromMaybe name alias
--- a/graphql.cabal
+++ b/graphql.cabal
@ -25,11 +25,12 @@ library
  ghc-options:         -Wall
  exposed-modules:     Data.GraphQL
                       Data.GraphQL.AST
-                       Data.GraphQL.Encoder
+                       Data.GraphQL.AST.Core
                       Data.GraphQL.Execute
+                       Data.GraphQL.Encoder
+                       Data.GraphQL.Error
                       Data.GraphQL.Schema
                       Data.GraphQL.Parser
-                       Data.GraphQL.Error
  build-depends:       aeson >= 0.7.0.3,
                       attoparsec >= 0.10.4.0,
                       base >= 4.7 && < 5,
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -1,15 +1,11 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Schema where

 import Control.Applicative (Alternative, empty)
+import Data.List.NonEmpty (NonEmpty((:|)))

-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>))
-import Data.Traversable (traverse)
-#endif
-import Data.GraphQL.Schema
+import Data.GraphQL.Schema (Schema, Resolver, Argument(..), Value(..))
 import qualified Data.GraphQL.Schema as Schema

 import Test.StarWars.Data
@ -18,7 +14,7 @@ import Test.StarWars.Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js

 schema :: Alternative f => Schema f
-schema = Schema [hero, human, droid]
+schema = hero :| [human, droid]

 hero :: Alternative f => Resolver f
 hero = Schema.objectA "hero" $ \case
--- a/tests/tasty.hs
+++ b/tests/tasty.hs
@ -18,10 +18,10 @@ import qualified Test.StarWars.QueryTests as SW
 import Paths_graphql (getDataFileName)

 main :: IO ()
-main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< ksTest
+main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< kitchenTest

-ksTest :: IO TestTree
-ksTest = testCase "Kitchen Sink"
+kitchenTest :: IO TestTree
+kitchenTest = testCase "Kitchen Sink"
     <$> (assertEqual "Encode" <$> expected <*> actual)
  where
    expected = Text.readFile