21 files changed, 832 insertions, 490 deletions

diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 961253f..9fce1d3 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -1,36 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
     ( graphql
     , graphqlSubs
     ) where
 
+import Control.Monad.Catch (MonadCatch)
 import qualified Data.Aeson as Aeson
-import Data.HashMap.Strict (HashMap)
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Sequence as Seq
 import Data.Text (Text)
-import Language.GraphQL.AST.Document
-import Language.GraphQL.AST.Parser
+import Language.GraphQL.AST
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
-import Language.GraphQL.Execute.Coerce
+import qualified Language.GraphQL.Validate as Validate
 import Language.GraphQL.Type.Schema
 import Text.Megaparsec (parse)
 
 -- | If the text parses correctly as a @GraphQL@ query the query is
 -- executed using the given 'Schema'.
-graphql :: Monad m
+graphql :: MonadCatch m
     => Schema m -- ^ Resolvers.
     -> Text -- ^ Text representing a @GraphQL@ request document.
-    -> m Aeson.Value -- ^ Response.
-graphql = flip graphqlSubs (mempty :: Aeson.Object)
+    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
+graphql schema = graphqlSubs schema mempty mempty
 
 -- | If the text parses correctly as a @GraphQL@ query the substitution is
 -- applied to the query and the query is then executed using to the given
 -- 'Schema'.
-graphqlSubs :: (Monad m, VariableValue a)
+graphqlSubs :: MonadCatch m
     => Schema m -- ^ Resolvers.
-    -> HashMap Name a -- ^ Variable substitution function.
+    -> Maybe Text -- ^ Operation name.
+    -> Aeson.Object -- ^ Variable substitution function.
     -> Text -- ^ Text representing a @GraphQL@ request document.
-    -> m Aeson.Value -- ^ Response.
-graphqlSubs schema f
-    = either parseError (execute schema f)
-    . parse document ""
+    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
+graphqlSubs schema operationName variableValues document' =
+    case parse document "" document' of
+        Left errorBundle -> pure . formatResponse <$> parseError errorBundle
+        Right parsed ->
+            case validate parsed of
+                Seq.Empty -> fmap formatResponse
+                    <$> execute schema operationName variableValues parsed
+                errors -> pure $ pure
+                    $ HashMap.singleton "errors"
+                    $ Aeson.toJSON
+                    $ fromValidationError <$> errors
+  where
+    validate = Validate.document schema Validate.specifiedRules
+    formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
+    formatResponse (Response data'' errors') = HashMap.fromList
+        [ ("data", data'')
+        , ("errors", Aeson.toJSON $ fromError <$> errors')
+        ]
+    fromError Error{ locations = [], ..} =
+        Aeson.object [("message", Aeson.toJSON message)]
+    fromError Error{..} = Aeson.object
+        [ ("message", Aeson.toJSON message)
+        , ("locations", Aeson.listValue fromLocation locations)
+        ]
+    fromValidationError Validate.Error{..}
+        | [] <- path = Aeson.object
+            [ ("message", Aeson.toJSON message)
+            , ("locations", Aeson.listValue fromLocation locations)
+            ]
+        | otherwise = Aeson.object
+            [ ("message", Aeson.toJSON message)
+            , ("locations", Aeson.listValue fromLocation locations)
+            , ("path", Aeson.listValue fromPath path)
+            ]
+    fromPath (Validate.Segment segment) = Aeson.String segment
+    fromPath (Validate.Index index) = Aeson.toJSON index
+    fromLocation Location{..} = Aeson.object
+        [ ("line", Aeson.toJSON line)
+        , ("column", Aeson.toJSON column)
+        ]
diff --git a/src/Language/GraphQL/AST.hs b/src/Language/GraphQL/AST.hs
index aba6dfd..3d368d4 100644
--- a/src/Language/GraphQL/AST.hs
+++ b/src/Language/GraphQL/AST.hs
@@ -1,6 +1,8 @@
--- | Target AST for Parser.
+-- | Target AST for parser.
 module Language.GraphQL.AST
     ( module Language.GraphQL.AST.Document
+    , module Language.GraphQL.AST.Parser
     ) where
 
 import Language.GraphQL.AST.Document
+import Language.GraphQL.AST.Parser
diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs
deleted file mode 100644
index 0fe3e03..0000000
--- a/src/Language/GraphQL/AST/Core.hs
+++ /dev/null
@@ -1,19 +0,0 @@
--- | This is the AST meant to be executed.
-module Language.GraphQL.AST.Core
-    ( Arguments(..)
-    ) where
-
-import Data.HashMap.Strict (HashMap)
-import Language.GraphQL.AST (Name)
-import Language.GraphQL.Type.Definition
-
--- | Argument list.
-newtype Arguments = Arguments (HashMap Name Value)
-    deriving (Eq, Show)
-
-instance Semigroup Arguments where
-    (Arguments x) <> (Arguments y) = Arguments $ x <> y
-
-instance Monoid Arguments where
-    mempty = Arguments mempty
-
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 430e92a..3394bfa 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -19,6 +19,7 @@ module Language.GraphQL.AST.Document
     , FragmentDefinition(..)
     , ImplementsInterfaces(..)
     , InputValueDefinition(..)
+    , Location(..)
     , Name
     , NamedType
     , NonNullType(..)
@@ -55,6 +56,12 @@ import Language.GraphQL.AST.DirectiveLocation
 -- | Name.
 type Name = Text
 
+-- | Error location, line and column.
+data Location = Location
+    { line :: Word
+    , column :: Word
+    } deriving (Eq, Show)
+
 -- ** Document
 
 -- | GraphQL document.
@@ -62,9 +69,9 @@ type Document = NonEmpty Definition
 
 -- | All kinds of definitions that can occur in a GraphQL document.
 data Definition
-    = ExecutableDefinition ExecutableDefinition
-    | TypeSystemDefinition TypeSystemDefinition
-    | TypeSystemExtension TypeSystemExtension
+    = ExecutableDefinition ExecutableDefinition Location
+    | TypeSystemDefinition TypeSystemDefinition Location
+    | TypeSystemExtension TypeSystemExtension Location
     deriving (Eq, Show)
 
 -- | Top-level definition of a document, either an operation or a fragment.
@@ -92,9 +99,7 @@ data OperationDefinition
 -- * mutation - a write operation followed by a fetch.
 -- * subscription - a long-lived request that fetches data in response to
 -- source events.
---
--- Currently only queries and mutations are supported.
-data OperationType = Query | Mutation deriving (Eq, Show)
+data OperationType = Query | Mutation | Subscription deriving (Eq, Show)
 
 -- ** Selection Sets
 
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 7fb0677..a0dac5b 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- | This module defines a minifier and a printer for the @GraphQL@ language.
 module Language.GraphQL.AST.Encoder
@@ -49,7 +50,8 @@ document formatter defs
     | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
   where
     encodeDocument = foldr executableDefinition [] defs
-    executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc
+    executableDefinition (ExecutableDefinition x _) acc =
+        definition formatter x : acc
     executableDefinition _ acc = acc
 
 -- | Converts a t'ExecutableDefinition' into a string.
@@ -65,12 +67,14 @@ definition formatter x
 
 -- | Converts a 'OperationDefinition into a string.
 operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
-operationDefinition formatter (SelectionSet sels)
-    = selectionSet formatter sels
-operationDefinition formatter (OperationDefinition Query name vars dirs sels)
-    = "query " <> node formatter name vars dirs sels
-operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
-    = "mutation " <> node formatter name vars dirs sels
+operationDefinition formatter = \case
+    SelectionSet sels -> selectionSet formatter sels
+    OperationDefinition Query name vars dirs sels ->
+        "query " <> node formatter name vars dirs sels
+    OperationDefinition Mutation name vars dirs sels ->
+        "mutation " <> node formatter name vars dirs sels
+    OperationDefinition Subscription name vars dirs sels ->
+        "subscription " <> node formatter name vars dirs sels
 
 -- | Converts a Query or Mutation into a string.
 node :: Formatter ->
@@ -254,19 +258,20 @@ stringValue (Pretty indentation) string =
           char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
 
       tripleQuote = Builder.fromText "\"\"\""
-      start = tripleQuote <> Builder.singleton '\n'
-      end = Builder.fromLazyText (indent indentation) <> tripleQuote
+      newline = Builder.singleton '\n'
 
       strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
       lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
       encoded [] = oneLine string
       encoded [_] = oneLine string
-      encoded lines'' = start <> transformLines lines'' <> end
-      transformLines = foldr ((\line acc -> line <> Builder.singleton '\n' <> acc) . transformLine) mempty
-      transformLine line =
-        if Lazy.Text.null (Builder.toLazyText line)
-        then line
-        else Builder.fromLazyText (indent (indentation + 1)) <> line
+      encoded lines'' = tripleQuote <> newline
+        <> transformLines lines''
+        <> Builder.fromLazyText (indent indentation) <> tripleQuote
+      transformLines = foldr transformLine mempty
+      transformLine "" acc = newline <> acc
+      transformLine line' acc
+            = Builder.fromLazyText (indent (indentation + 1))
+            <> line' <> newline <> acc
 
 escape :: Char -> Builder
 escape char'
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index 0ba55e3..17d3f9c 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -168,11 +168,11 @@ blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
 
 -- | Parser for integers.
 integer :: Integral a => Parser a
-integer = Lexer.signed (pure ()) $ lexeme Lexer.decimal
+integer = Lexer.signed (pure ()) (lexeme Lexer.decimal) <?> "IntValue"
 
 -- | Parser for floating-point numbers.
 float :: Parser Double
-float = Lexer.signed (pure ()) $ lexeme Lexer.float
+float = Lexer.signed (pure ()) (lexeme Lexer.float) <?> "FloatValue"
 
 -- | Parser for names (/[_A-Za-z][_0-9A-Za-z]*/).
 name :: Parser T.Text
@@ -233,4 +233,4 @@ extend token extensionLabel parsers
     tryExtension extensionParser = try
         $ symbol "extend"
         *> symbol token
-        *> extensionParser
\ No newline at end of file
+        *> extensionParser
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index c18c36a..687d8f5 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -1,12 +1,13 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -- | @GraphQL@ document parser.
 module Language.GraphQL.AST.Parser
     ( document
     ) where
 
-import Control.Applicative (Alternative(..), optional)
+import Control.Applicative (Alternative(..), liftA2, optional)
 import Control.Applicative.Combinators (sepBy1)
 import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
@@ -19,19 +20,47 @@ import Language.GraphQL.AST.DirectiveLocation
     )
 import Language.GraphQL.AST.Document
 import Language.GraphQL.AST.Lexer
-import Text.Megaparsec (lookAhead, option, try, (<?>))
+import Text.Megaparsec
+    ( SourcePos(..)
+    , getSourcePos
+    , lookAhead
+    , option
+    , try
+    , unPos
+    , (<?>)
+    )
 
 -- | Parser for the GraphQL documents.
 document :: Parser Document
 document = unicodeBOM
-    >> spaceConsumer
-    >> lexeme (NonEmpty.some definition)
+    *> spaceConsumer
+    *> lexeme (NonEmpty.some definition)
 
 definition :: Parser Definition
-definition = ExecutableDefinition <$> executableDefinition
-    <|> TypeSystemDefinition <$> typeSystemDefinition
-    <|> TypeSystemExtension <$> typeSystemExtension
+definition = executableDefinition'
+    <|> typeSystemDefinition'
+    <|> typeSystemExtension'
     <?> "Definition"
+  where
+    executableDefinition' = do
+        location <- getLocation
+        definition' <- executableDefinition
+        pure $ ExecutableDefinition definition' location
+    typeSystemDefinition' = do
+        location <- getLocation
+        definition' <- typeSystemDefinition
+        pure $ TypeSystemDefinition definition' location
+    typeSystemExtension' = do
+        location <- getLocation
+        definition' <- typeSystemExtension
+        pure $ TypeSystemExtension definition' location
+
+getLocation :: Parser Location
+getLocation = fromSourcePosition <$> getSourcePos
+  where
+    fromSourcePosition SourcePos{..} =
+        Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
+    wordFromPosition = fromIntegral . unPos
 
 executableDefinition :: Parser ExecutableDefinition
 executableDefinition = DefinitionOperation <$> operationDefinition
@@ -40,19 +69,22 @@ executableDefinition = DefinitionOperation <$> operationDefinition
 
 typeSystemDefinition :: Parser TypeSystemDefinition
 typeSystemDefinition = schemaDefinition
-    <|> TypeDefinition <$> typeDefinition
-    <|> directiveDefinition
+    <|> typeSystemDefinitionWithDescription
     <?> "TypeSystemDefinition"
+  where
+    typeSystemDefinitionWithDescription = description
+        >>= liftA2 (<|>) typeDefinition' directiveDefinition
+    typeDefinition' description' = TypeDefinition
+        <$> typeDefinition description'
 
 typeSystemExtension :: Parser TypeSystemExtension
 typeSystemExtension = SchemaExtension <$> schemaExtension
     <|> TypeExtension <$> typeExtension
     <?> "TypeSystemExtension"
 
-directiveDefinition :: Parser TypeSystemDefinition
-directiveDefinition = DirectiveDefinition
-    <$> description
-    <* symbol "directive"
+directiveDefinition :: Description -> Parser TypeSystemDefinition
+directiveDefinition description' = DirectiveDefinition description'
+    <$ symbol "directive"
     <* at
     <*> name
     <*> argumentsDefinition
@@ -63,11 +95,13 @@ directiveDefinition = DirectiveDefinition
 directiveLocations :: Parser (NonEmpty DirectiveLocation)
 directiveLocations = optional pipe
     *> directiveLocation `NonEmpty.sepBy1` pipe
+    <?> "DirectiveLocations"
 
 directiveLocation :: Parser DirectiveLocation
 directiveLocation
     = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
     <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
+    <?> "DirectiveLocation"
 
 executableDirectiveLocation :: Parser ExecutableDirectiveLocation
 executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
@@ -77,6 +111,7 @@ executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
     <|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
     <|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
     <|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
+    <?> "ExecutableDirectiveLocation"
 
 typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
 typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
@@ -90,14 +125,15 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
     <|> Directive.EnumValue <$ symbol "ENUM_VALUE"
     <|> Directive.InputObject <$ symbol "INPUT_OBJECT"
     <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
-
-typeDefinition :: Parser TypeDefinition
-typeDefinition = scalarTypeDefinition
-    <|> objectTypeDefinition
-    <|> interfaceTypeDefinition
-    <|> unionTypeDefinition
-    <|> enumTypeDefinition
-    <|> inputObjectTypeDefinition
+    <?> "TypeSystemDirectiveLocation"
+
+typeDefinition :: Description -> Parser TypeDefinition
+typeDefinition description' = scalarTypeDefinition description'
+    <|> objectTypeDefinition description'
+    <|> interfaceTypeDefinition description'
+    <|> unionTypeDefinition description'
+    <|> enumTypeDefinition description'
+    <|> inputObjectTypeDefinition description'
     <?> "TypeDefinition"
 
 typeExtension :: Parser TypeExtension
@@ -109,10 +145,9 @@ typeExtension = scalarTypeExtension
     <|> inputObjectTypeExtension
     <?> "TypeExtension"
 
-scalarTypeDefinition :: Parser TypeDefinition
-scalarTypeDefinition = ScalarTypeDefinition
-    <$> description
-    <* symbol "scalar"
+scalarTypeDefinition :: Description -> Parser TypeDefinition
+scalarTypeDefinition description' = ScalarTypeDefinition description'
+    <$ symbol "scalar"
     <*> name
     <*> directives
     <?> "ScalarTypeDefinition"
@@ -121,10 +156,9 @@ scalarTypeExtension :: Parser TypeExtension
 scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
     $ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
 
-objectTypeDefinition :: Parser TypeDefinition
-objectTypeDefinition = ObjectTypeDefinition
-    <$> description
-    <* symbol "type"
+objectTypeDefinition :: Description -> Parser TypeDefinition
+objectTypeDefinition description' = ObjectTypeDefinition description'
+    <$ symbol "type"
     <*> name
     <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
     <*> directives
@@ -153,13 +187,12 @@ objectTypeExtension = extend "type" "ObjectTypeExtension"
 
 description :: Parser Description
 description = Description
-    <$> optional (string <|> blockString)
+    <$> optional stringValue
     <?> "Description"
 
-unionTypeDefinition :: Parser TypeDefinition
-unionTypeDefinition = UnionTypeDefinition
-    <$> description
-    <* symbol "union"
+unionTypeDefinition :: Description -> Parser TypeDefinition
+unionTypeDefinition description' = UnionTypeDefinition description'
+    <$ symbol "union"
     <*> name
     <*> directives
     <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1)
@@ -187,10 +220,9 @@ unionMemberTypes sepBy' = UnionMemberTypes
     <*> name `sepBy'` pipe
     <?> "UnionMemberTypes"
 
-interfaceTypeDefinition :: Parser TypeDefinition
-interfaceTypeDefinition = InterfaceTypeDefinition
-    <$> description
-    <* symbol "interface"
+interfaceTypeDefinition :: Description -> Parser TypeDefinition
+interfaceTypeDefinition description' = InterfaceTypeDefinition description'
+    <$ symbol "interface"
     <*> name
     <*> directives
     <*> braces (many fieldDefinition)
@@ -208,10 +240,9 @@ interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
         <$> name
         <*> NonEmpty.some directive
 
-enumTypeDefinition :: Parser TypeDefinition
-enumTypeDefinition = EnumTypeDefinition
-    <$> description
-    <* symbol "enum"
+enumTypeDefinition :: Description -> Parser TypeDefinition
+enumTypeDefinition description' = EnumTypeDefinition description'
+    <$ symbol "enum"
     <*> name
     <*> directives
     <*> listOptIn braces enumValueDefinition
@@ -229,10 +260,9 @@ enumTypeExtension = extend "enum" "EnumTypeExtension"
         <$> name
         <*> NonEmpty.some directive
 
-inputObjectTypeDefinition :: Parser TypeDefinition
-inputObjectTypeDefinition = InputObjectTypeDefinition
-    <$> description
-    <* symbol "input"
+inputObjectTypeDefinition :: Description -> Parser TypeDefinition
+inputObjectTypeDefinition description' = InputObjectTypeDefinition description'
+    <$ symbol "input"
     <*> name
     <*> directives
     <*> listOptIn braces inputValueDefinition
@@ -321,7 +351,7 @@ operationTypeDefinition = OperationTypeDefinition
 operationDefinition :: Parser OperationDefinition
 operationDefinition = SelectionSet <$> selectionSet
     <|> operationDefinition'
-    <?> "operationDefinition error"
+    <?> "OperationDefinition"
   where
     operationDefinition'
         = OperationDefinition <$> operationType
@@ -333,23 +363,20 @@ operationDefinition = SelectionSet <$> selectionSet
 operationType :: Parser OperationType
 operationType = Query <$ symbol "query"
     <|> Mutation <$ symbol "mutation"
-    -- <?> Keep default error message
-
--- * SelectionSet
+    <|> Subscription <$ symbol "subscription"
+    <?> "OperationType"
 
 selectionSet :: Parser SelectionSet
-selectionSet = braces $ NonEmpty.some selection
+selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
 
 selectionSetOpt :: Parser SelectionSetOpt
-selectionSetOpt = listOptIn braces selection
+selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
 
 selection :: Parser Selection
 selection = field
     <|> try fragmentSpread
     <|> inlineFragment
-    <?> "selection error!"
-
--- * Field
+    <?> "Selection"
 
 field :: Parser Selection
 field = Field
@@ -358,25 +385,23 @@ field = Field
     <*> arguments
     <*> directives
     <*> selectionSetOpt
+    <?> "Field"
 
 alias :: Parser Alias
-alias = try $ name <* colon
-
--- * Arguments
+alias = try (name <* colon) <?> "Alias"
 
 arguments :: Parser [Argument]
-arguments = listOptIn parens argument
+arguments = listOptIn parens argument <?> "Arguments"
 
 argument :: Parser Argument
-argument = Argument <$> name <* colon <*> value
-
--- * Fragments
+argument = Argument <$> name <* colon <*> value <?> "Argument"
 
 fragmentSpread :: Parser Selection
 fragmentSpread = FragmentSpread
     <$ spread
     <*> fragmentName
     <*> directives
+    <?> "FragmentSpread"
 
 inlineFragment :: Parser Selection
 inlineFragment = InlineFragment
@@ -384,62 +409,74 @@ inlineFragment = InlineFragment
     <*> optional typeCondition
     <*> directives
     <*> selectionSet
+    <?> "InlineFragment"
 
 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
-                 <$  symbol "fragment"
-                 <*> name
-                 <*> typeCondition
-                 <*> directives
-                 <*> selectionSet
+    <$  symbol "fragment"
+    <*> name
+    <*> typeCondition
+    <*> directives
+    <*> selectionSet
+    <?> "FragmentDefinition"
 
 fragmentName :: Parser Name
-fragmentName = but (symbol "on") *> name
+fragmentName = but (symbol "on") *> name <?> "FragmentName"
 
 typeCondition :: Parser TypeCondition
-typeCondition = symbol "on" *> name
-
--- * Input Values
+typeCondition = symbol "on" *> name <?> "TypeCondition"
 
 value :: Parser Value
 value = Variable <$> variable
     <|> Float <$> try float
     <|> Int <$> integer
     <|> Boolean <$> booleanValue
-    <|> Null <$  symbol "null"
-    <|> String <$> blockString
-    <|> String <$> string
+    <|> Null <$  nullValue
+    <|> String <$> stringValue
     <|> Enum <$> try enumValue
     <|> List <$> brackets (some value)
     <|> Object <$> braces (some $ objectField value)
-    <?> "value error!"
+    <?> "Value"
 
 constValue :: Parser ConstValue
 constValue = ConstFloat <$> try float
     <|> ConstInt <$> integer
     <|> ConstBoolean <$> booleanValue
-    <|> ConstNull <$  symbol "null"
-    <|> ConstString <$> blockString
-    <|> ConstString <$> string
+    <|> ConstNull <$ nullValue
+    <|> ConstString <$> stringValue
     <|> ConstEnum <$> try enumValue
     <|> ConstList <$> brackets (some constValue)
     <|> ConstObject <$> braces (some $ objectField constValue)
-    <?> "value error!"
+    <?> "Value"
 
 booleanValue :: Parser Bool
 booleanValue = True  <$ symbol "true"
     <|> False <$ symbol "false"
+    <?> "BooleanValue"
 
 enumValue :: Parser Name
-enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
+enumValue = but (symbol "true")
+    *> but (symbol "false")
+    *> but (symbol "null")
+    *> name
+    <?> "EnumValue"
 
-objectField :: Parser a -> Parser (ObjectField a)
-objectField valueParser = ObjectField <$> name <* colon <*> valueParser
+stringValue :: Parser Text
+stringValue = blockString <|> string <?> "StringValue"
 
--- * Variables
+nullValue :: Parser Text
+nullValue = symbol "null" <?> "NullValue"
+
+objectField :: Parser a -> Parser (ObjectField a)
+objectField valueParser = ObjectField
+    <$> name
+    <* colon
+    <*> valueParser
+    <?> "ObjectField"
 
 variableDefinitions :: Parser [VariableDefinition]
 variableDefinitions = listOptIn parens variableDefinition
+    <?> "VariableDefinitions"
 
 variableDefinition :: Parser VariableDefinition
 variableDefinition = VariableDefinition
@@ -450,13 +487,11 @@ variableDefinition = VariableDefinition
     <?> "VariableDefinition"
 
 variable :: Parser Name
-variable = dollar *> name
+variable = dollar *> name <?> "Variable"
 
 defaultValue :: Parser (Maybe ConstValue)
 defaultValue = optional (equals *> constValue) <?> "DefaultValue"
 
--- * Input Types
-
 type' :: Parser Type
 type' = try (TypeNonNull <$> nonNullType)
     <|> TypeList <$> brackets type'
@@ -465,21 +500,18 @@ type' = try (TypeNonNull <$> nonNullType)
 
 nonNullType :: Parser NonNullType
 nonNullType = NonNullTypeNamed <$> name <* bang
-          <|> NonNullTypeList  <$> brackets type'  <* bang
-          <?> "nonNullType error!"
-
--- * Directives
+    <|> NonNullTypeList  <$> brackets type'  <* bang
+    <?> "NonNullType"
 
 directives :: Parser [Directive]
-directives = many directive
+directives = many directive <?> "Directives"
 
 directive :: Parser Directive
 directive = Directive
     <$  at
     <*> name
     <*> arguments
-
--- * Internal
+    <?> "Directive"
 
 listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
 listOptIn surround = option [] . surround . some
diff --git a/src/Language/GraphQL/Error.hs b/src/Language/GraphQL/Error.hs
index 59719b0..9df69de 100644
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -5,20 +7,29 @@
 module Language.GraphQL.Error
     ( parseError
     , CollectErrsT
+    , Error(..)
     , Resolution(..)
+    , ResolverException(..)
+    , Response(..)
+    , ResponseEventStream
     , addErr
     , addErrMsg
     , runCollectErrs
     , singleError
     ) where
 
+import Conduit
+import Control.Exception (Exception(..))
 import Control.Monad.Trans.State (StateT, modify, runStateT)
-import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
+import Data.Sequence (Seq(..), (|>))
+import qualified Data.Sequence as Seq
 import Data.Text (Text)
-import Data.Void (Void)
-import Language.GraphQL.AST.Document (Name)
+import qualified Data.Text as Text
+import Language.GraphQL.AST (Location(..), Name)
+import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Type.Schema
+import Prelude hiding (null)
 import Text.Megaparsec
     ( ParseErrorBundle(..)
     , PosState(..)
@@ -31,59 +42,85 @@ import Text.Megaparsec
 
 -- | Executor context.
 data Resolution m = Resolution
-    { errors :: [Aeson.Value]
+    { errors :: Seq Error
     , types :: HashMap Name (Type m)
     }
 
 -- | Wraps a parse error into a list of errors.
-parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
+parseError :: (Applicative f, Serialize a)
+    => ParseErrorBundle Text Void
+    -> f (Response a)
 parseError ParseErrorBundle{..}  =
-    pure $ Aeson.object [("errors", Aeson.toJSON $ fst $ foldl go ([], bundlePosState) bundleErrors)]
+    pure $ Response null $ fst
+        $ foldl go (Seq.empty, bundlePosState) bundleErrors
   where
-    errorObject s SourcePos{..} = Aeson.object
-        [ ("message", Aeson.toJSON $ init $ parseErrorTextPretty s)
-        , ("line", Aeson.toJSON $ unPos sourceLine)
-        , ("column", Aeson.toJSON $ unPos sourceColumn)
-        ]
+    errorObject s SourcePos{..} = Error
+        { message = Text.pack $ init $ parseErrorTextPretty s
+        , locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
+        }
+    unPos' = fromIntegral . unPos
     go (result, state) x =
         let (_, newState) = reachOffset (errorOffset x) state
             sourcePosition = pstateSourcePos newState
-         in (errorObject x sourcePosition : result, newState)
+         in (result |> errorObject x sourcePosition, newState)
 
 -- | A wrapper to pass error messages around.
 type CollectErrsT m = StateT (Resolution m) m
 
 -- | Adds an error to the list of errors.
-addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
+addErr :: Monad m => Error -> CollectErrsT m ()
 addErr v = modify appender
   where
-    appender resolution@Resolution{..} = resolution{ errors = v : errors }
+    appender :: Monad m => Resolution m -> Resolution m
+    appender resolution@Resolution{..} = resolution{ errors = errors |> v }
 
-makeErrorMessage :: Text -> Aeson.Value
-makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
+makeErrorMessage :: Text -> Error
+makeErrorMessage s = Error s []
 
 -- | Constructs a response object containing only the error with the given
---   message.
-singleError :: Text -> Aeson.Value
-singleError message = Aeson.object
-    [ ("errors", Aeson.toJSON [makeErrorMessage message])
-    ]
+-- message.
+singleError :: Serialize a => Text -> Response a
+singleError message = Response null $ Seq.singleton $ makeErrorMessage message
 
 -- | Convenience function for just wrapping an error message.
-addErrMsg :: Monad m => Text -> CollectErrsT m ()
-addErrMsg = addErr . makeErrorMessage
+addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
+addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
+
+-- | @GraphQL@ error.
+data Error = Error
+    { message :: Text
+    , locations :: [Location]
+    } deriving (Eq, Show)
+
+-- | The server\'s response describes the result of executing the requested
+-- operation if successful, and describes any errors encountered during the
+-- request.
+data Response a = Response
+    { data' :: a
+    , errors :: Seq Error
+    } deriving (Eq, Show)
+
+-- | Each event in the underlying Source Stream triggers execution of the
+-- subscription selection set. The results of the execution generate a Response
+-- Stream.
+type ResponseEventStream m a = ConduitT () (Response a) m ()
+
+-- | Only exceptions that inherit from 'ResolverException' a cought by the
+-- executor.
+data ResolverException = forall e. Exception e => ResolverException e
+
+instance Show ResolverException where
+    show (ResolverException e) = show e
+
+instance Exception ResolverException
 
 -- | Runs the given query computation, but collects the errors into an error
---   list, which is then sent back with the data.
-runCollectErrs :: Monad m
+-- list, which is then sent back with the data.
+runCollectErrs :: (Monad m, Serialize a)
     => HashMap Name (Type m)
-    -> CollectErrsT m Aeson.Value
-    -> m Aeson.Value
+    -> CollectErrsT m a
+    -> m (Response a)
 runCollectErrs types' res = do
-    (dat, Resolution{..}) <- runStateT res $ Resolution{ errors = [], types = types' }
-    if null errors
-       then return $ Aeson.object [("data", dat)]
-       else return $ Aeson.object
-           [ ("data", dat)
-           , ("errors", Aeson.toJSON $ reverse errors)
-           ]
+    (dat, Resolution{..}) <- runStateT res
+        $ Resolution{ errors = Seq.empty, types = types' }
+    pure $ Response dat errors
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 45bace0..2b615f4 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -1,71 +1,63 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
     ( execute
-    , executeWithName
+    , module Language.GraphQL.Execute.Coerce
     ) where
 
-import qualified Data.Aeson as Aeson
+import Control.Monad.Catch (MonadCatch)
 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
 import Data.Sequence (Seq(..))
 import Data.Text (Text)
 import Language.GraphQL.AST.Document (Document, Name)
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.Execution
 import qualified Language.GraphQL.Execute.Transform as Transform
+import qualified Language.GraphQL.Execute.Subscribe as Subscribe
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 
 -- | The substitution is applied to the document, and the resolvers are applied
--- to the resulting fields.
---
--- Returns the result of the query against the schema wrapped in a /data/
--- field, or errors wrapped in an /errors/ field.
-execute :: (Monad m, VariableValue a)
-    => Schema m -- ^ Resolvers.
-    -> HashMap.HashMap Name a -- ^ Variable substitution function.
-    -> Document -- @GraphQL@ document.
-    -> m Aeson.Value
-execute schema = executeRequest schema Nothing
-
--- | The substitution is applied to the document, and the resolvers are applied
 -- to the resulting fields. The operation name can be used if the document
 -- defines multiple root operations.
 --
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
-executeWithName :: (Monad m, VariableValue a)
-    => Schema m -- ^ Resolvers
-    -> Text -- ^ Operation name.
-    -> HashMap.HashMap Name a -- ^ Variable substitution function.
-    -> Document -- ^ @GraphQL@ Document.
-    -> m Aeson.Value
-executeWithName schema operationName =
-    executeRequest schema (Just operationName)
-
-executeRequest :: (Monad m, VariableValue a)
-    => Schema m
-    -> Maybe Text
-    -> HashMap.HashMap Name a
-    -> Document
-    -> m Aeson.Value
-executeRequest schema operationName subs document =
+execute :: (MonadCatch m, VariableValue a, Serialize b)
+    => Schema m -- ^ Resolvers.
+    -> Maybe Text -- ^ Operation name.
+    -> HashMap Name a -- ^ Variable substitution function.
+    -> Document -- @GraphQL@ document.
+    -> m (Either (ResponseEventStream m b) (Response b))
+execute schema operationName subs document =
     case Transform.document schema operationName subs document of
-        Left queryError -> pure $ singleError $ Transform.queryError queryError
-        Right (Transform.Document types' rootObjectType operation)
-          | (Transform.Query _ fields) <- operation ->
-              executeOperation types' rootObjectType fields
-          | (Transform.Mutation _ fields) <- operation ->
-              executeOperation types' rootObjectType fields
+        Left queryError -> pure
+            $ Right
+            $ singleError
+            $ Transform.queryError queryError
+        Right transformed -> executeRequest transformed
+
+executeRequest :: (MonadCatch m, Serialize a)
+    => Transform.Document m
+    -> m (Either (ResponseEventStream m a) (Response a))
+executeRequest (Transform.Document types' rootObjectType operation)
+    | (Transform.Query _ fields) <- operation =
+        Right <$> executeOperation types' rootObjectType fields
+    | (Transform.Mutation _ fields) <- operation =
+        Right <$> executeOperation types' rootObjectType fields
+    | (Transform.Subscription _ fields) <- operation
+        = either (Right . singleError) Left
+        <$> Subscribe.subscribe types' rootObjectType fields
 
 -- This is actually executeMutation, but we don't distinguish between queries
 -- and mutations yet.
-executeOperation :: Monad m
+executeOperation :: (MonadCatch m, Serialize a)
     => HashMap Name (Type m)
     -> Out.ObjectType m
     -> Seq (Transform.Selection m)
-    -> m Aeson.Value
+    -> m (Response a)
 executeOperation types' objectType fields =
     runCollectErrs types' $ executeSelectionSet Definition.Null objectType fields
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 0c10419..d8d5b13 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -3,11 +3,13 @@
 {-# LANGUAGE ViewPatterns #-}
 
 module Language.GraphQL.Execute.Execution
-    ( executeSelectionSet
+    ( coerceArgumentValues
+    , collectFields
+    , executeSelectionSet
     ) where
 
+import Control.Monad.Catch (Exception(..), MonadCatch(..))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except (runExceptT)
 import Control.Monad.Trans.Reader (runReaderT)
 import Control.Monad.Trans.State (gets)
 import Data.List.NonEmpty (NonEmpty(..))
@@ -17,28 +19,35 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq(..))
-import Data.Text (Text)
+import qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
-import Language.GraphQL.AST.Core
 import Language.GraphQL.Error
 import Language.GraphQL.Execute.Coerce
 import qualified Language.GraphQL.Execute.Transform as Transform
-import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Type.Internal
 import Language.GraphQL.Type.Schema
 import Prelude hiding (null)
 
-resolveFieldValue :: Monad m
+resolveFieldValue :: MonadCatch m
     => Type.Value
     -> Type.Subs
-    -> ActionT m a
-    -> m (Either Text a)
-resolveFieldValue result args =
-    flip runReaderT (Context {arguments = Arguments args, values = result})
-    . runExceptT
-    . runActionT
+    -> Type.Resolve m
+    -> CollectErrsT m Type.Value
+resolveFieldValue result args resolver =
+    catch (lift $ runReaderT resolver context) handleFieldError
+  where
+    handleFieldError :: MonadCatch m
+        => ResolverException
+        -> CollectErrsT m Type.Value
+    handleFieldError e =
+        addErr (Error (Text.pack $ displayException e) []) >> pure Type.Null
+    context = Type.Context
+        { Type.arguments = Type.Arguments args
+        , Type.values = result
+        }
 
 collectFields :: Monad m
     => Out.ObjectType m
@@ -98,23 +107,27 @@ instanceOf objectType (AbstractUnionType unionType) =
   where
     go unionMemberType acc = acc || objectType == unionMemberType
 
-executeField :: (Monad m, Serialize a)
+executeField :: (MonadCatch m, Serialize a)
     => Out.Resolver m
     -> Type.Value
     -> NonEmpty (Transform.Field m)
     -> CollectErrsT m a
-executeField (Out.Resolver fieldDefinition resolver) prev fields = do
-    let Out.Field _ fieldType argumentDefinitions = fieldDefinition
-    let (Transform.Field _ _ arguments' _ :| []) = fields
-    case coerceArgumentValues argumentDefinitions arguments' of
-        Nothing -> errmsg "Argument coercing failed."
-        Just argumentValues -> do
-            answer <- lift $ resolveFieldValue prev argumentValues resolver
-            case answer of
-                Right result -> completeValue fieldType fields result
-                Left errorMessage -> errmsg errorMessage
+executeField fieldResolver prev fields
+    | Out.ValueResolver fieldDefinition resolver <- fieldResolver =
+        executeField' fieldDefinition resolver
+    | Out.EventStreamResolver fieldDefinition resolver _ <- fieldResolver =
+        executeField' fieldDefinition resolver
+  where
+    executeField' fieldDefinition resolver = do
+        let Out.Field _ fieldType argumentDefinitions = fieldDefinition
+        let (Transform.Field _ _ arguments' _ :| []) = fields
+        case coerceArgumentValues argumentDefinitions arguments' of
+            Nothing -> addErrMsg "Argument coercing failed."
+            Just argumentValues -> do
+                answer <- resolveFieldValue prev argumentValues resolver
+                completeValue fieldType fields answer
 
-completeValue :: (Monad m, Serialize a)
+completeValue :: (MonadCatch m, Serialize a)
     => Out.Type m
     -> NonEmpty (Transform.Field m)
     -> Type.Value
@@ -135,7 +148,7 @@ completeValue outputType@(Out.EnumBaseType enumType) _ (Type.Enum enum) =
     let Type.EnumType _ _ enumMembers = enumType
      in if HashMap.member enum enumMembers
         then coerceResult outputType $ Enum enum
-        else errmsg "Value completion failed."
+        else addErrMsg "Value completion failed."
 completeValue (Out.ObjectBaseType objectType) fields result =
     executeSelectionSet result objectType $ mergeSelectionSets fields
 completeValue (Out.InterfaceBaseType interfaceType) fields result
@@ -145,7 +158,7 @@ completeValue (Out.InterfaceBaseType interfaceType) fields result
         case concreteType of
             Just objectType -> executeSelectionSet result objectType
                 $ mergeSelectionSets fields
-            Nothing -> errmsg "Value completion failed."
+            Nothing -> addErrMsg "Value completion failed."
 completeValue (Out.UnionBaseType unionType) fields result
     | Type.Object objectMap <- result = do
         let abstractType = AbstractUnionType unionType
@@ -153,30 +166,29 @@ completeValue (Out.UnionBaseType unionType) fields result
         case concreteType of
             Just objectType -> executeSelectionSet result objectType
                 $ mergeSelectionSets fields
-            Nothing -> errmsg "Value completion failed."
-completeValue _ _ _ = errmsg "Value completion failed."
+            Nothing -> addErrMsg "Value completion failed."
+completeValue _ _ _ = addErrMsg "Value completion failed."
 
-mergeSelectionSets :: Monad m => NonEmpty (Transform.Field m) -> Seq (Transform.Selection m)
+mergeSelectionSets :: MonadCatch m
+    => NonEmpty (Transform.Field m)
+    -> Seq (Transform.Selection m)
 mergeSelectionSets = foldr forEach mempty
   where
     forEach (Transform.Field _ _ _ fieldSelectionSet) selectionSet =
         selectionSet <> fieldSelectionSet
 
-errmsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
-errmsg errorMessage = addErrMsg errorMessage >> pure null
-
-coerceResult :: (Monad m, Serialize a)
+coerceResult :: (MonadCatch m, Serialize a)
     => Out.Type m
     -> Output a
     -> CollectErrsT m a
 coerceResult outputType result
     | Just serialized <- serialize outputType result = pure serialized
-    | otherwise = errmsg "Result coercion failed."
+    | otherwise = addErrMsg "Result coercion failed."
 
 -- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
 -- each field to each 'Transform.Selection'. Resolves into a value containing
 -- the resolved 'Transform.Selection', or a null value and error information.
-executeSelectionSet :: (Monad m, Serialize a)
+executeSelectionSet :: (MonadCatch m, Serialize a)
     => Type.Value
     -> Out.ObjectType m
     -> Seq (Transform.Selection m)
diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs
new file mode 100644
index 0000000..0bd274f
--- /dev/null
+++ b/src/Language/GraphQL/Execute/Subscribe.hs
@@ -0,0 +1,97 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.Execute.Subscribe
+    ( subscribe
+    ) where
+
+import Conduit
+import Control.Monad.Catch (Exception(..), MonadCatch(..))
+import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Map.Strict as Map
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Sequence (Seq(..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Language.GraphQL.AST (Name)
+import Language.GraphQL.Execute.Coerce
+import Language.GraphQL.Execute.Execution
+import qualified Language.GraphQL.Execute.Transform as Transform
+import Language.GraphQL.Error
+import qualified Language.GraphQL.Type.Definition as Definition
+import qualified Language.GraphQL.Type as Type
+import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Type.Schema
+
+-- This is actually executeMutation, but we don't distinguish between queries
+-- and mutations yet.
+subscribe :: (MonadCatch m, Serialize a)
+    => HashMap Name (Type m)
+    -> Out.ObjectType m
+    -> Seq (Transform.Selection m)
+    -> m (Either Text (ResponseEventStream m a))
+subscribe types' objectType fields = do
+    sourceStream <- createSourceEventStream types' objectType fields
+    traverse (mapSourceToResponseEvent types' objectType fields) sourceStream
+
+mapSourceToResponseEvent :: (MonadCatch m, Serialize a)
+    => HashMap Name (Type m)
+    -> Out.ObjectType m
+    -> Seq (Transform.Selection m)
+    -> Out.SourceEventStream m
+    -> m (ResponseEventStream m a)
+mapSourceToResponseEvent types' subscriptionType fields sourceStream = pure
+    $ sourceStream
+    .| mapMC (executeSubscriptionEvent types' subscriptionType fields)
+
+createSourceEventStream :: MonadCatch m
+    => HashMap Name (Type m)
+    -> Out.ObjectType m
+    -> Seq (Transform.Selection m)
+    -> m (Either Text (Out.SourceEventStream m))
+createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes) fields
+    | [fieldGroup] <- Map.elems groupedFieldSet
+    , Transform.Field _ fieldName arguments' _ <- NonEmpty.head fieldGroup
+    , resolverT <- fieldTypes HashMap.! fieldName
+    , Out.EventStreamResolver fieldDefinition _ resolver <- resolverT
+    , Out.Field _ _fieldType argumentDefinitions <- fieldDefinition =
+        case coerceArgumentValues argumentDefinitions arguments' of
+            Nothing -> pure $ Left "Argument coercion failed."
+            Just argumentValues ->
+                resolveFieldEventStream Type.Null argumentValues resolver
+    | otherwise = pure $ Left "Subscription contains more than one field."
+  where
+    groupedFieldSet = collectFields subscriptionType fields
+
+resolveFieldEventStream :: MonadCatch m
+    => Type.Value
+    -> Type.Subs
+    -> Out.Subscribe m
+    -> m (Either Text (Out.SourceEventStream m))
+resolveFieldEventStream result args resolver =
+    catch (Right <$> runReaderT resolver context) handleEventStreamError
+  where
+    handleEventStreamError :: MonadCatch m
+        => ResolverException
+        -> m (Either Text (Out.SourceEventStream m))
+    handleEventStreamError = pure . Left . Text.pack . displayException
+    context = Type.Context
+        { Type.arguments = Type.Arguments args
+        , Type.values = result
+        }
+
+-- This is actually executeMutation, but we don't distinguish between queries
+-- and mutations yet.
+executeSubscriptionEvent :: (MonadCatch m, Serialize a)
+    => HashMap Name (Type m)
+    -> Out.ObjectType m
+    -> Seq (Transform.Selection m)
+    -> Definition.Value
+    -> m (Response a)
+executeSubscriptionEvent types' objectType fields initialValue =
+    runCollectErrs types' $ executeSelectionSet initialValue objectType fields
diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs
index 733ac8c..76d1fe7 100644
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@@ -44,12 +44,11 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.AST (Name)
-import Language.GraphQL.AST.Core
 import qualified Language.GraphQL.Execute.Coerce as Coerce
-import Language.GraphQL.Type.Directive (Directive(..))
-import qualified Language.GraphQL.Type.Directive as Directive
+import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
+import Language.GraphQL.Type.Internal
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 
@@ -78,6 +77,7 @@ data Selection m
 data Operation m
     = Query (Maybe Text) (Seq (Selection m))
     | Mutation (Maybe Text) (Seq (Selection m))
+    | Subscription (Maybe Text) (Seq (Selection m))
 
 -- | Single GraphQL field.
 data Field m = Field
@@ -239,6 +239,10 @@ document schema operationName subs ast = do
             | Just mutationType <- mutation schema ->
                 pure $ Document referencedTypes mutationType
                     $ operation chosenOperation replacement
+        OperationDefinition Full.Subscription _ _ _ _
+            | Just subscriptionType <- subscription schema ->
+                pure $ Document referencedTypes subscriptionType
+                    $ operation chosenOperation replacement
         _ -> Left UnsupportedRootOperation
 
 defragment
@@ -251,10 +255,10 @@ defragment ast =
      in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations
   where
     defragment' definition (operations, fragments')
-        | (Full.ExecutableDefinition executable) <- definition
+        | (Full.ExecutableDefinition executable _) <- definition
         , (Full.DefinitionOperation operation') <- executable =
             (transform operation' : operations, fragments')
-        | (Full.ExecutableDefinition executable) <- definition
+        | (Full.ExecutableDefinition executable _) <- definition
         , (Full.DefinitionFragment fragment) <- executable
         , (Full.FragmentDefinition name _ _ _) <- fragment =
             (operations, HashMap.insert name fragment fragments')
@@ -276,6 +280,8 @@ operation operationDefinition replacement
         Query name <$> appendSelection sels
     transform (OperationDefinition Full.Mutation name _ _ sels) =
         Mutation name <$> appendSelection sels
+    transform (OperationDefinition Full.Subscription name _ _ sels) =
+        Subscription name <$> appendSelection sels
 
 -- * Selection
 
@@ -286,7 +292,7 @@ selection (Full.Field alias name arguments' directives' selections) =
     maybe (Left mempty) (Right . SelectionField) <$> do
         fieldArguments <- foldM go HashMap.empty arguments'
         fieldSelections <- appendSelection selections
-        fieldDirectives <- Directive.selection <$> directives directives'
+        fieldDirectives <- Definition.selection <$> directives directives'
         let field' = Field alias name fieldArguments fieldSelections
         pure $ field' <$ fieldDirectives
   where
@@ -295,7 +301,7 @@ selection (Full.Field alias name arguments' directives' selections) =
 
 selection (Full.FragmentSpread name directives') =
     maybe (Left mempty) (Right . SelectionFragment) <$> do
-        spreadDirectives <- Directive.selection <$> directives directives'
+        spreadDirectives <- Definition.selection <$> directives directives'
         fragments' <- gets fragments
 
         fragmentDefinitions' <- gets fragmentDefinitions
@@ -309,7 +315,7 @@ selection (Full.FragmentSpread name directives') =
                         _ -> lift $ pure  Nothing
                 | otherwise -> lift $ pure  Nothing
 selection (Full.InlineFragment type' directives' selections) = do
-    fragmentDirectives <- Directive.selection <$> directives directives'
+    fragmentDirectives <- Definition.selection <$> directives directives'
     case fragmentDirectives of
         Nothing -> pure $ Left mempty
         _ -> do
@@ -337,11 +343,11 @@ appendSelection = foldM go mempty
     append acc (Left list) = list >< acc
     append acc (Right one) = one <| acc
 
-directives :: [Full.Directive] ->  State (Replacement m) [Directive]
+directives :: [Full.Directive] ->  State (Replacement m) [Definition.Directive]
 directives = traverse directive
   where
     directive (Full.Directive directiveName directiveArguments)
-        = Directive directiveName . Arguments
+        = Definition.Directive directiveName . Type.Arguments
         <$> foldM go HashMap.empty directiveArguments
     go arguments (Full.Argument name value') = do
         substitutedValue <- value value'
diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs
deleted file mode 100644
index fa7718a..0000000
--- a/src/Language/GraphQL/Trans.hs
+++ /dev/null
@@ -1,67 +0,0 @@
--- | Monad transformer stack used by the @GraphQL@ resolvers.
-module Language.GraphQL.Trans
-    ( argument
-    , ActionT(..)
-    , Context(..)
-    ) where
-
-import Control.Applicative (Alternative(..))
-import Control.Monad (MonadPlus(..))
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad.Trans.Except (ExceptT)
-import Control.Monad.Trans.Reader (ReaderT, asks)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import Language.GraphQL.AST (Name)
-import Language.GraphQL.AST.Core
-import Language.GraphQL.Type.Definition
-import Prelude hiding (lookup)
-
--- | Resolution context holds resolver arguments.
-data Context = Context
-    { arguments :: Arguments
-    , values :: Value
-    }
-
--- | Monad transformer stack used by the resolvers to provide error handling
---   and resolution context (resolver arguments).
-newtype ActionT m a = ActionT
-    { runActionT :: ExceptT Text (ReaderT Context m) a
-    }
-
-instance Functor m => Functor (ActionT m) where
-    fmap f = ActionT . fmap f . runActionT
-
-instance Monad m => Applicative (ActionT m) where
-    pure = ActionT . pure
-    (ActionT f) <*> (ActionT x) = ActionT $ f <*> x
-
-instance Monad m => Monad (ActionT m) where
-    return = pure
-    (ActionT action) >>= f = ActionT $ action >>= runActionT . f
-
-instance MonadTrans ActionT where
-    lift = ActionT . lift . lift
-
-instance MonadIO m => MonadIO (ActionT m) where
-    liftIO = lift . liftIO
-
-instance Monad m => Alternative (ActionT m) where
-    empty = ActionT empty
-    (ActionT x) <|> (ActionT y) = ActionT $ x <|> y
-
-instance Monad m => MonadPlus (ActionT m) where
-    mzero = empty
-    mplus = (<|>)
-
--- | Retrieves an argument by its name. If the argument with this name couldn't
---   be found, returns 'Null' (i.e. the argument is assumed to
---   be optional then).
-argument :: Monad m => Name -> ActionT m Value
-argument argumentName = do
-    argumentValue <- ActionT $ lift $ asks $ lookup . arguments
-    pure $ fromMaybe Null argumentValue
-  where
-    lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs
index 5dfd622..e84fc03 100644
--- a/src/Language/GraphQL/Type.hs
+++ b/src/Language/GraphQL/Type.hs
@@ -1,11 +1,21 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
 -- | Reexports non-conflicting type system and schema definitions.
 module Language.GraphQL.Type
     ( In.InputField(..)
     , In.InputObjectType(..)
+    , Out.Context(..)
     , Out.Field(..)
     , Out.InterfaceType(..)
     , Out.ObjectType(..)
+    , Out.Resolve
+    , Out.Resolver(..)
+    , Out.SourceEventStream
+    , Out.Subscribe
     , Out.UnionType(..)
+    , Out.argument
     , module Language.GraphQL.Type.Definition
     , module Language.GraphQL.Type.Schema
     ) where
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
index 1379018..476fb3a 100644
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@@ -2,7 +2,9 @@
 
 -- | Types that can be used as both input and output types.
 module Language.GraphQL.Type.Definition
-    ( EnumType(..)
+    ( Arguments(..)
+    , Directive(..)
+    , EnumType(..)
     , EnumValue(..)
     , ScalarType(..)
     , Subs
@@ -11,14 +13,16 @@ module Language.GraphQL.Type.Definition
     , float
     , id
     , int
+    , selection
     , string
     ) where
 
 import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
 import Data.String (IsString(..))
 import Data.Text (Text)
-import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.AST (Name)
 import Prelude hiding (id)
 
 -- | Represents accordingly typed GraphQL values.
@@ -40,6 +44,16 @@ instance IsString Value where
 -- and the value is the variable value.
 type Subs = HashMap Name Value
 
+-- | Argument list.
+newtype Arguments = Arguments (HashMap Name Value)
+    deriving (Eq, Show)
+
+instance Semigroup Arguments where
+    (Arguments x) <> (Arguments y) = Arguments $ x <> y
+
+instance Monoid Arguments where
+    mempty = Arguments mempty
+
 -- | Scalar type definition.
 --
 -- The leaf values of any request and input values to arguments are Scalars (or
@@ -113,3 +127,49 @@ id = ScalarType "ID" (Just description)
         \JSON response as a String; however, it is not intended to be \
         \human-readable. When expected as an input type, any string (such as \
         \`\"4\"`) or integer (such as `4`) input value will be accepted as an ID."
+
+-- | Directive.
+data Directive = Directive Name Arguments
+    deriving (Eq, Show)
+
+-- | Directive processing status.
+data Status
+    = Skip -- ^ Skip the selection and stop directive processing
+    | Include Directive -- ^ The directive was processed, try other handlers
+    | Continue Directive -- ^ Directive handler mismatch, try other handlers
+
+-- | Takes a list of directives, handles supported directives and excludes them
+--   from the result. If the selection should be skipped, returns 'Nothing'.
+selection :: [Directive] -> Maybe [Directive]
+selection = foldr go (Just [])
+  where
+    go directive' directives' =
+        case (skip . include) (Continue directive') of
+            (Include _) -> directives'
+            Skip -> Nothing
+            (Continue x) -> (x :) <$> directives'
+
+handle :: (Directive -> Status) -> Status -> Status
+handle _ Skip = Skip
+handle handler (Continue directive) = handler directive
+handle handler (Include directive) = handler directive
+
+-- * Directive implementations
+
+skip :: Status -> Status
+skip = handle skip'
+  where
+    skip' directive'@(Directive "skip" (Arguments arguments)) =
+        case HashMap.lookup "if" arguments of
+            (Just (Boolean True)) -> Skip
+            _ -> Include directive'
+    skip' directive' = Continue directive'
+
+include :: Status -> Status
+include = handle include'
+  where
+    include' directive'@(Directive "include" (Arguments arguments)) =
+        case HashMap.lookup "if" arguments of
+            (Just (Boolean True)) -> Include directive'
+            _ -> Skip
+    include' directive' = Continue directive'
diff --git a/src/Language/GraphQL/Type/Directive.hs b/src/Language/GraphQL/Type/Directive.hs
deleted file mode 100644
index 017132c..0000000
--- a/src/Language/GraphQL/Type/Directive.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Language.GraphQL.Type.Directive
-    ( Directive(..)
-    , selection
-    ) where
-
-import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL.AST (Name)
-import Language.GraphQL.AST.Core
-import Language.GraphQL.Type.Definition
-
--- | Directive.
-data Directive = Directive Name Arguments
-    deriving (Eq, Show)
-
--- | Directive processing status.
-data Status
-    = Skip -- ^ Skip the selection and stop directive processing
-    | Include Directive -- ^ The directive was processed, try other handlers
-    | Continue Directive -- ^ Directive handler mismatch, try other handlers
-
--- | Takes a list of directives, handles supported directives and excludes them
---   from the result. If the selection should be skipped, returns 'Nothing'.
-selection :: [Directive] -> Maybe [Directive]
-selection = foldr go (Just [])
-  where
-    go directive' directives' =
-        case (skip . include) (Continue directive') of
-            (Include _) -> directives'
-            Skip -> Nothing
-            (Continue x) -> (x :) <$> directives'
-
-handle :: (Directive -> Status) -> Status -> Status
-handle _ Skip = Skip
-handle handler (Continue directive) = handler directive
-handle handler (Include directive) = handler directive
-
--- * Directive implementations
-
-skip :: Status -> Status
-skip = handle skip'
-  where
-    skip' directive'@(Directive "skip" (Arguments arguments)) =
-        case HashMap.lookup "if" arguments of
-            (Just (Boolean True)) -> Skip
-            _ -> Include directive'
-    skip' directive' = Continue directive'
-
-include :: Status -> Status
-include = handle include'
-  where
-    include' directive'@(Directive "include" (Arguments arguments)) =
-        case HashMap.lookup "if" arguments of
-            (Just (Boolean True)) -> Include directive'
-            _ -> Skip
-    include' directive' = Continue directive'
diff --git a/src/Language/GraphQL/Type/Internal.hs b/src/Language/GraphQL/Type/Internal.hs
new file mode 100644
index 0000000..9121d13
--- /dev/null
+++ b/src/Language/GraphQL/Type/Internal.hs
@@ -0,0 +1,91 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE ExplicitForAll #-}
+
+module Language.GraphQL.Type.Internal
+    ( AbstractType(..)
+    , CompositeType(..)
+    , collectReferencedTypes
+    ) where
+
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL.AST (Name)
+import qualified Language.GraphQL.Type.Definition as Definition
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Type.Schema
+
+-- | These types may describe the parent context of a selection set.
+data CompositeType m
+    = CompositeUnionType (Out.UnionType m)
+    | CompositeObjectType (Out.ObjectType m)
+    | CompositeInterfaceType (Out.InterfaceType m)
+    deriving Eq
+
+-- | These types may describe the parent context of a selection set.
+data AbstractType m
+    = AbstractUnionType (Out.UnionType m)
+    | AbstractInterfaceType (Out.InterfaceType m)
+    deriving Eq
+
+-- | Traverses the schema and finds all referenced types.
+collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m)
+collectReferencedTypes schema =
+    let queryTypes = traverseObjectType (query schema) HashMap.empty
+     in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
+  where
+    collect traverser typeName element foundTypes
+        | HashMap.member typeName foundTypes = foundTypes
+        | otherwise = traverser $ HashMap.insert typeName element foundTypes
+    visitFields (Out.Field _ outputType arguments) foundTypes
+        = traverseOutputType outputType
+        $ foldr visitArguments foundTypes arguments
+    visitArguments (In.Argument _ inputType _) = traverseInputType inputType
+    visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
+    getField (Out.ValueResolver field _) = field
+    getField (Out.EventStreamResolver field _ _) = field
+    traverseInputType (In.InputObjectBaseType objectType) =
+        let (In.InputObjectType typeName _ inputFields) = objectType
+            element = InputObjectType objectType
+            traverser = flip (foldr visitInputFields) inputFields
+         in collect traverser typeName element
+    traverseInputType (In.ListBaseType listType) =
+        traverseInputType listType
+    traverseInputType (In.ScalarBaseType scalarType) =
+        let (Definition.ScalarType typeName _) = scalarType
+         in collect Prelude.id typeName (ScalarType scalarType)
+    traverseInputType (In.EnumBaseType enumType) =
+        let (Definition.EnumType typeName _ _) = enumType
+         in collect Prelude.id typeName (EnumType enumType)
+    traverseOutputType (Out.ObjectBaseType objectType) =
+        traverseObjectType objectType
+    traverseOutputType (Out.InterfaceBaseType interfaceType) =
+        traverseInterfaceType interfaceType
+    traverseOutputType (Out.UnionBaseType unionType) =
+        let (Out.UnionType typeName _ types) = unionType
+            traverser = flip (foldr traverseObjectType) types
+         in collect traverser typeName (UnionType unionType)
+    traverseOutputType (Out.ListBaseType listType) =
+        traverseOutputType listType
+    traverseOutputType (Out.ScalarBaseType scalarType) =
+        let (Definition.ScalarType typeName _) = scalarType
+         in collect Prelude.id typeName (ScalarType scalarType)
+    traverseOutputType (Out.EnumBaseType enumType) =
+        let (Definition.EnumType typeName _ _) = enumType
+         in collect Prelude.id typeName (EnumType enumType)
+    traverseObjectType objectType foundTypes =
+        let (Out.ObjectType typeName _ interfaces fields) = objectType
+            element = ObjectType objectType
+            traverser = polymorphicTraverser interfaces (getField <$> fields)
+         in collect traverser typeName element foundTypes
+    traverseInterfaceType interfaceType foundTypes =
+        let (Out.InterfaceType typeName _ interfaces fields) = interfaceType
+            element = InterfaceType interfaceType
+            traverser = polymorphicTraverser interfaces fields
+         in collect traverser typeName element foundTypes
+    polymorphicTraverser interfaces fields
+        = flip (foldr visitFields) fields
+        . flip (foldr traverseInterfaceType) interfaces
diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs
index 856c4f8..89bbf1d 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@@ -1,18 +1,28 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
--- | Output types and values.
+-- | Output types and values, monad transformer stack used by the @GraphQL@
+-- resolvers.
 --
 -- This module is intended to be imported qualified, to avoid name clashes
 -- with 'Language.GraphQL.Type.In'.
 module Language.GraphQL.Type.Out
-    ( Field(..)
+    ( Context(..)
+    , Field(..)
     , InterfaceType(..)
     , ObjectType(..)
+    , Resolve
+    , Subscribe
     , Resolver(..)
+    , SourceEventStream
     , Type(..)
     , UnionType(..)
+    , argument
     , isNonNullType
     , pattern EnumBaseType
     , pattern InterfaceBaseType
@@ -22,26 +32,20 @@ module Language.GraphQL.Type.Out
     , pattern UnionBaseType
     ) where
 
+import Conduit
+import Control.Monad.Trans.Reader (ReaderT, asks)
 import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Language.GraphQL.AST (Name)
-import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 
--- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
--- information (if an error has occurred). @m@ is an arbitrary monad, usually
--- 'IO'.
---
--- Resolving a field can result in a leaf value or an object, which is
--- represented as a list of nested resolvers, used to resolve the fields of that
--- object.
-data Resolver m = Resolver (Field m) (ActionT m Value)
-
 -- | Object type definition.
 --
---   Almost all of the GraphQL types you define will be object types. Object
---   types have a name, but most importantly describe their fields.
+-- Almost all of the GraphQL types you define will be object types. Object
+-- types have a name, but most importantly describe their fields.
 data ObjectType m = ObjectType
     Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
 
@@ -166,3 +170,43 @@ isNonNullType (NonNullInterfaceType _) = True
 isNonNullType (NonNullUnionType _) = True
 isNonNullType (NonNullListType _) = True
 isNonNullType _ = False
+
+-- | Resolution context holds resolver arguments and the root value.
+data Context = Context
+    { arguments :: Arguments
+    , values :: Value
+    }
+
+-- | Monad transformer stack used by the resolvers for determining the resolved
+-- value of a field.
+type Resolve m = ReaderT Context m Value
+
+-- | Monad transformer stack used by the resolvers for determining the resolved
+-- event stream of a subscription field.
+type Subscribe m = ReaderT Context m (SourceEventStream m)
+
+-- | A source stream represents the sequence of events, each of which will
+-- trigger a GraphQL execution corresponding to that event.
+type SourceEventStream m = ConduitT () Value m ()
+
+-- | 'Resolver' associates some function(s) with each 'Field'. 'ValueResolver'
+-- resolves a 'Field' into a 'Value'. 'EventStreamResolver' resolves
+-- additionally a 'Field' into a 'SourceEventStream' if it is the field of a
+-- root subscription type.
+--
+-- The resolvers aren't part of the 'Field' itself because not all fields
+-- have resolvers (interface fields don't have an implementation).
+data Resolver m
+    = ValueResolver (Field m) (Resolve m)
+    | EventStreamResolver (Field m) (Resolve m) (Subscribe m)
+
+-- | Retrieves an argument by its name. If the argument with this name couldn't
+-- be found, returns 'Null' (i.e. the argument is assumed to
+-- be optional then).
+argument :: Monad m => Name -> Resolve m
+argument argumentName = do
+    argumentValue <- asks $ lookupArgument . arguments
+    pure $ fromMaybe Null argumentValue
+  where
+    lookupArgument (Arguments argumentMap) =
+        HashMap.lookup argumentName argumentMap
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
index 4d7b9eb..c5cc6fd 100644
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -1,18 +1,10 @@
-{-# LANGUAGE ExplicitForAll #-}
-
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Type.Schema
-    ( AbstractType(..)
-    , CompositeType(..)
-    , Schema(..)
+    ( Schema(..)
     , Type(..)
-    , collectReferencedTypes
     ) where
 
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL.AST.Document (Name)
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
@@ -27,19 +19,6 @@ data Type m
     | UnionType (Out.UnionType m)
     deriving Eq
 
--- | These types may describe the parent context of a selection set.
-data CompositeType m
-    = CompositeUnionType (Out.UnionType m)
-    | CompositeObjectType (Out.ObjectType m)
-    | CompositeInterfaceType (Out.InterfaceType m)
-    deriving Eq
-
--- | These types may describe the parent context of a selection set.
-data AbstractType m
-    = AbstractUnionType (Out.UnionType m)
-    | AbstractInterfaceType (Out.InterfaceType m)
-    deriving Eq
-
 -- | A Schema is created by supplying the root types of each type of operation,
 --   query and mutation (optional). A schema definition is then supplied to the
 --   validator and executor.
@@ -50,63 +29,5 @@ data AbstractType m
 data Schema m = Schema
     { query :: Out.ObjectType m
     , mutation :: Maybe (Out.ObjectType m)
+    , subscription :: Maybe (Out.ObjectType m)
     }
-
--- | Traverses the schema and finds all referenced types.
-collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m)
-collectReferencedTypes schema =
-    let queryTypes = traverseObjectType (query schema) HashMap.empty
-     in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
-  where
-    collect traverser typeName element foundTypes
-        | HashMap.member typeName foundTypes = foundTypes
-        | otherwise = traverser $ HashMap.insert typeName element foundTypes
-    visitFields (Out.Field _ outputType arguments) foundTypes
-        = traverseOutputType outputType
-        $ foldr visitArguments foundTypes arguments
-    visitArguments (In.Argument _ inputType _) = traverseInputType inputType
-    visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
-    traverseInputType (In.InputObjectBaseType objectType) =
-        let (In.InputObjectType typeName _ inputFields) = objectType
-            element = InputObjectType objectType
-            traverser = flip (foldr visitInputFields) inputFields
-         in collect traverser typeName element
-    traverseInputType (In.ListBaseType listType) =
-        traverseInputType listType
-    traverseInputType (In.ScalarBaseType scalarType) =
-        let (Definition.ScalarType typeName _) = scalarType
-         in collect Prelude.id typeName (ScalarType scalarType)
-    traverseInputType (In.EnumBaseType enumType) =
-        let (Definition.EnumType typeName _ _) = enumType
-         in collect Prelude.id typeName (EnumType enumType)
-    traverseOutputType (Out.ObjectBaseType objectType) =
-        traverseObjectType objectType
-    traverseOutputType (Out.InterfaceBaseType interfaceType) =
-        traverseInterfaceType interfaceType
-    traverseOutputType (Out.UnionBaseType unionType) =
-        let (Out.UnionType typeName _ types) = unionType
-            traverser = flip (foldr traverseObjectType) types
-         in collect traverser typeName (UnionType unionType)
-    traverseOutputType (Out.ListBaseType listType) =
-        traverseOutputType listType
-    traverseOutputType (Out.ScalarBaseType scalarType) =
-        let (Definition.ScalarType typeName _) = scalarType
-         in collect Prelude.id typeName (ScalarType scalarType)
-    traverseOutputType (Out.EnumBaseType enumType) =
-        let (Definition.EnumType typeName _ _) = enumType
-         in collect Prelude.id typeName (EnumType enumType)
-    traverseObjectType objectType foundTypes =
-        let (Out.ObjectType typeName _ interfaces resolvers) = objectType
-            element = ObjectType objectType
-            fields = extractObjectField <$> resolvers
-            traverser = polymorphicTraverser interfaces fields
-         in collect traverser typeName element foundTypes
-    traverseInterfaceType interfaceType foundTypes =
-        let (Out.InterfaceType typeName _ interfaces fields) = interfaceType
-            element = InterfaceType interfaceType
-            traverser = polymorphicTraverser interfaces fields
-         in collect traverser typeName element foundTypes
-    polymorphicTraverser interfaces fields
-        = flip (foldr visitFields) fields
-        . flip (foldr traverseInterfaceType) interfaces
-    extractObjectField (Out.Resolver field _) = field
diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs
new file mode 100644
index 0000000..5768615
--- /dev/null
+++ b/src/Language/GraphQL/Validate.hs
@@ -0,0 +1,97 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- | GraphQL validator.
+module Language.GraphQL.Validate
+    ( Error(..)
+    , Path(..)
+    , document
+    , module Language.GraphQL.Validate.Rules
+    ) where
+
+import Control.Monad.Trans.Reader (Reader, asks, runReader)
+import Data.Foldable (foldrM)
+import Data.Sequence (Seq(..), (><), (|>))
+import qualified Data.Sequence as Seq
+import Data.Text (Text)
+import Language.GraphQL.AST.Document
+import Language.GraphQL.Type.Schema
+import Language.GraphQL.Validate.Rules
+
+data Context m = Context
+    { ast :: Document
+    , schema :: Schema m
+    , rules :: [Rule]
+    }
+
+type ValidateT m = Reader (Context m) (Seq Error)
+
+-- | If an error can be associated to a particular field in the GraphQL result,
+-- it must contain an entry with the key path that details the path of the
+-- response field which experienced the error. This allows clients to identify
+-- whether a null result is intentional or caused by a runtime error.
+data Path
+    = Segment Text -- ^ Field name.
+    | Index Int -- ^ List index if a field returned a list.
+    deriving (Eq, Show)
+
+-- | Validation error.
+data Error = Error
+    { message :: String
+    , locations :: [Location]
+    , path :: [Path]
+    } deriving (Eq, Show)
+
+-- | Validates a document and returns a list of found errors. If the returned
+-- list is empty, the document is valid.
+document :: forall m. Schema m -> [Rule] -> Document -> Seq Error
+document schema' rules' document' =
+    runReader (foldrM go Seq.empty document') context
+  where
+    context = Context
+        { ast = document'
+        , schema = schema'
+        , rules = rules'
+        }
+    go definition' accumulator = (accumulator ><) <$> definition definition'
+
+definition :: forall m. Definition -> ValidateT m
+definition = \case
+    definition'@(ExecutableDefinition executableDefinition' _) -> do
+        applied <- applyRules definition'
+        children <- executableDefinition executableDefinition'
+        pure $ children >< applied
+    definition' -> applyRules definition'
+  where
+    applyRules definition' = foldr (ruleFilter definition') Seq.empty
+        <$> asks rules
+    ruleFilter definition' (DefinitionRule rule) accumulator
+        | Just message' <- rule definition' =
+            accumulator |> Error
+                { message = message'
+                , locations = [definitionLocation definition']
+                , path = []
+                }
+        | otherwise = accumulator
+    definitionLocation (ExecutableDefinition _ location) = location
+    definitionLocation (TypeSystemDefinition _ location) = location
+    definitionLocation (TypeSystemExtension _ location) = location
+
+executableDefinition :: forall m. ExecutableDefinition -> ValidateT m
+executableDefinition (DefinitionOperation definition') =
+    operationDefinition definition'
+executableDefinition (DefinitionFragment definition') =
+    fragmentDefinition definition'
+
+operationDefinition :: forall m. OperationDefinition -> ValidateT m
+operationDefinition (SelectionSet _operation) =
+    pure Seq.empty
+operationDefinition (OperationDefinition _type _name _variables _directives _selection) =
+    pure Seq.empty
+
+fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m
+fragmentDefinition _fragment = pure Seq.empty
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
new file mode 100644
index 0000000..a3314e7
--- /dev/null
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -0,0 +1,31 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
+-- | This module contains default rules defined in the GraphQL specification.
+module Language.GraphQL.Validate.Rules
+    ( Rule(..)
+    , executableDefinitionsRule
+    , specifiedRules
+    ) where
+
+import Language.GraphQL.AST.Document
+
+-- | 'Rule' assigns a function to each AST node that can be validated. If the
+-- validation fails, the function should return an error message, or 'Nothing'
+-- otherwise.
+newtype Rule
+    = DefinitionRule (Definition -> Maybe String)
+
+-- | Default reules given in the specification.
+specifiedRules :: [Rule]
+specifiedRules =
+    [ executableDefinitionsRule
+    ]
+
+-- | Definition must be OperationDefinition or FragmentDefinition.
+executableDefinitionsRule :: Rule
+executableDefinitionsRule = DefinitionRule go
+  where
+    go (ExecutableDefinition _definition _) = Nothing
+    go _ = Just "Definition must be OperationDefinition or FragmentDefinition."