Release 0.9.0.0

Draft the Validation API
Return a stream as well from graphql* functions
2020-07-24 21:34:31 +02:00 · 2020-07-20 21:29:12 +02:00 · 2020-07-19 07:36:06 +02:00 · 2020-07-17 07:05:03 +02:00 · 2020-07-15 19:15:31 +02:00 · 2020-07-14 19:37:56 +02:00
41 changed files with 1620 additions and 797 deletions
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@ -0,0 +1,63 @@
+name: Haskell CI
+
+on:
+  push: ~
+  pull_request:
+    branches: [master]
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+
+    steps:
+    - uses: actions/checkout@v2
+    - uses: actions/setup-haskell@v1
+      with:
+        enable-stack: true
+        stack-no-global: true
+        stack-version: latest
+
+    - name: Cache
+      uses: actions/cache@v2
+      with:
+        path: |
+          ~/.stack
+          stack.yaml.lock
+        key: ${{ runner.os }}-test-${{ hashFiles('**/stack.yaml') }}
+        restore-keys: ${{ runner.os }}-test-
+
+    - name: Install dependencies
+      run: stack --no-terminal test --only-snapshot
+    - name: Run tests
+      run: stack --no-terminal test --pedantic
+    - name: Build the documentation
+      run: |
+        stack --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
+        stack --no-terminal haddock --no-haddock-deps
+
+  lint:
+    runs-on: ubuntu-latest
+
+    steps:
+    - uses: actions/checkout@v2
+    - uses: actions/setup-haskell@v1
+      with:
+        enable-stack: true
+        stack-no-global: true
+        stack-version: latest
+
+    - name: Cache
+      uses: actions/cache@v2
+      with:
+        path: |
+          ~/.stack
+          stack.yaml.lock
+        key: ${{ runner.os }}-lint-${{ hashFiles('**/stack.yaml') }}
+        restore-keys: ${{ runner.os }}-lint-
+
+    - name: Build HLint
+      run: stack --no-terminal build hlint
+    - name: Install HLint
+      run: stack --no-terminal install hlint
+    - name: Lint
+      run: stack --no-terminal exec hlint -- src tests docs
--- a/.gitignore
+++ b/.gitignore
@ -8,7 +8,8 @@
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.project.local
-/graphql.cabal

 # GHC
 *.hi
+*.o
+/docs/tutorial/tutorial
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -6,6 +6,62 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).

+## [Unreleased]
+## Fixed
+- Location of a parse error is returned in a singleton array with key
+  `locations`.
+- Parsing comments in the front of definitions.
+- Some missing labels were added to the parsers, some labels were fixed to
+  refer to the AST nodes being parsed. 
+
+## Added
+- `AST` reexports `AST.Parser`.
+- `AST.Document.Location` is a token location as a line and column pair.
+- `Execute` reexports `Execute.Coerce`.
+- `Error.Error` is an error representation with a message and source location.
+- `Error.Response` represents a result of running a GraphQL query.
+- `Type.Schema` exports `Type` which lists all types possible in the schema.
+- Parsing subscriptions (the execution always fails yet).
+- `Error.ResponseEventStream`, `Type.Out.Resolve`, `Type.Out.Subscribe` and
+  `Type.Out.SourceEventStream` define subscription resolvers.
+- `Error.ResolverException` is an exception that can be thrown by (field value
+  and event stream) resolvers to signalize an error. Other exceptions will
+  escape.
+- `Test.Hspec.GraphQL` contains some test helpers.
+- `Validate` contains the validator and standard rules.
+
+## Changed
+- `Type.Out.Resolver`: Interface fields don't have resolvers, object fields
+  have value resolvers, root subscription type resolvers need an additional
+  resolver that creates an event stream. `Resolver` represents these differences
+  now and pairs a field with the function(s). Resolvers don't have `ExceptT`,
+  errors are handled with `MonadThrow`/`MonadCatch`.
+- All code from `Trans` is moved to `Type.Out` and exported by `Type` and
+  `Type.Out`.
+- `AST.Core` contained only `Arguments` which was moved to `Type.Definition`.
+  `AST` provides now only functionality related to parsing and encoding, as it
+  should be.
+- `Execute.execute` takes an additional argument, a possible operation name
+  and returns either a stream or the response.
+- `Error` module was changed to work with dedicated types for errors and the
+  response instead of JSON.
+- `graphqlSubs` takes an additional argument, the operation name. The type of
+  variable names is changed back to JSON since it is a common format and it
+  saves additional conversions. Custom format still can be used with the
+  underlying functions (in the `Execute` module). The function returns either a
+  a stream or the resolved value.
+- `graphql` returns either a stream or the resolved value.
+- The constraint of the base monad was changed to `MonadCatch` (and it implies
+  `MonadThrow`).
+
+## Removed
+- `Trans.ActionT` is an unneeded layer of complexity. `Type.Out.Resolver`
+  represents possible resolver configurations.
+- `Type.Out.Resolver`: It . Resolvers are a
+  part of the fields and are called `Trans.ResolverT`.
+- `Execute.executeWithName`. `Execute.execute` takes the operation name and
+   completely replaces `executeWithName`.
+
 ## [0.8.0.0] - 2020-06-20
 ### Fixed
 - The parser rejects variables when parsing defaultValue (DefaultValue). The
@ -267,6 +323,7 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.

+[Unreleased]: https://github.com/caraus-ecms/graphql/compare/v0.8.0.0...HEAD
 [0.8.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.7.0.0...v0.8.0.0
 [0.7.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...v0.7.0.0
 [0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
--- a/README.md
+++ b/README.md
@ -1,7 +1,7 @@
 # Haskell GraphQL

 [![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql)
-[![Build Status](https://semaphoreci.com/api/v1/belka-ew/graphql/branches/master/badge.svg)](https://semaphoreci.com/belka-ew/graphql)
+[![Build Status](https://github.com/caraus-ecms/graphql/workflows/Haskell%20CI/badge.svg)](https://github.com/caraus-ecms/graphql/actions?query=workflow%3A%22Haskell+CI%22)
 [![License](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](https://raw.githubusercontent.com/caraus-ecms/graphql/master/LICENSE)

 GraphQL implementation in Haskell.
@ -13,9 +13,9 @@ be built on top of it.

 ## State of the work

-For now this only provides a parser and a printer for the GraphQL query
-language and allows to execute queries and mutations without the schema
-validation step. But the idea is to be a Haskell port of
+For now this only provides a parser and a printer for the GraphQL query language
+and allows to execute queries and mutations using the given schema, but without
+the validation step. But the idea is to be a Haskell port of
 [`graphql-js`](https://github.com/graphql/graphql-js).

 For the list of currently missing features see issues marked as
--- a/docs/tutorial/tutorial.lhs
+++ b/docs/tutorial/tutorial.lhs
@ -5,11 +5,13 @@ title: GraphQL Haskell Tutorial

 == Getting started ==

-Welcome to graphql-haskell!
+Welcome to GraphQL!

-We have written a small tutorial to help you (and ourselves) understand the graphql package.
+We have written a small tutorial to help you (and ourselves) understand the
+graphql package.

-Since this file is a literate haskell file, we start by importing some dependencies.
+Since this file is a literate haskell file, we start by importing some
+dependencies.

 > {-# LANGUAGE OverloadedStrings #-}
 > module Main where
@ -23,75 +25,76 @@ Since this file is a literate haskell file, we start by importing some dependenc
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
-> import Language.GraphQL.Trans
 > import Language.GraphQL.Type
 > import qualified Language.GraphQL.Type.Out as Out
 >
 > import Prelude hiding (putStrLn)

+
 === First example ===

-Now, as our first example, we are going to look at the
-example from [graphql.js](https://github.com/graphql/graphql-js).
+Now, as our first example, we are going to look at the example from
+[graphql.js](https://github.com/graphql/graphql-js).

 First we build a GraphQL schema.

 > schema1 :: Schema IO
-> schema1 = Schema queryType Nothing
+> schema1 = Schema
+>   { query = queryType , mutation = Nothing , subscription = Nothing }
 >
 > queryType :: ObjectType IO
 > queryType = ObjectType "Query" Nothing []
 >   $ HashMap.singleton "hello"
->   $ Out.Resolver helloField hello
+>   $ ValueResolver helloField hello
 >
 > helloField :: Field IO
 > helloField = Field Nothing (Out.NamedScalarType string) mempty
 >
-> hello :: ActionT IO Value
+> hello :: Resolve IO
 > hello = pure $ String "it's me"

-This defines a simple schema with one type and one field, that resolves to a fixed value.
+This defines a simple schema with one type and one field, that resolves to a
+fixed value.

 Next we define our query.

 > query1 :: Text
 > query1 = "{ hello }"

-
 To run the query, we call the `graphql` with the schema and the query.

 > main1 :: IO ()
-> main1 = graphql schema1 query1 >>= putStrLn . encode
+> main1 = graphql schema1 query1
+>   >>= either (const $ pure ()) (putStrLn . encode)

-This runs the query by fetching the one field defined,
-returning
+This runs the query by fetching the one field defined, returning

 ```{"data" : {"hello":"it's me"}}```


-
 === Monadic actions ===

 For this example, we're going to be using time.

 > schema2 :: Schema IO
-> schema2 = Schema queryType2 Nothing
+> schema2 = Schema
+>   { query = queryType2, mutation = Nothing, subscription = Nothing }
 >
 > queryType2 :: ObjectType IO
 > queryType2 = ObjectType "Query" Nothing []
 >   $ HashMap.singleton "time"
->   $ Out.Resolver timeField time
+>   $ ValueResolver timeField time
 >
 > timeField :: Field IO
 > timeField = Field Nothing (Out.NamedScalarType string) mempty
 >
-> time :: ActionT IO Value
+> time :: Resolve IO
 > time = do
 >   t <- liftIO getCurrentTime
 >   pure $ String $ Text.pack $ show t

-This defines a simple schema with one type and one field,
-which resolves to the current time.
+This defines a simple schema with one type and one field, which resolves to the
+current time.

 Next we define our query.

@ -99,76 +102,51 @@ Next we define our query.
 > query2 = "{ time }"
 >
 > main2 :: IO ()
-> main2 = graphql schema2 query2 >>= putStrLn . encode
+> main2 = graphql schema2 query2
+>   >>= either (const $ pure ()) (putStrLn . encode)

 This runs the query, returning the current time

 ```{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}```


-=== Errors ===
-
-Errors are handled according to the spec,
-with fields that cause erros being resolved to `null`,
-and an error being added to the error list.
-
-An example of this is the following query:
-
-> queryShouldFail :: Text
-> queryShouldFail = "{ boyhowdy }"
-
-Since there is no `boyhowdy` field in our schema, it will not resolve,
-and the query will fail, as we can see in the following example.
-
-> mainShouldFail :: IO ()
-> mainShouldFail = do
->   success <- graphql schema1 query1
->   putStrLn $ encode success
->   putStrLn "This will fail"
->   failure <- graphql schema1 queryShouldFail
->   putStrLn $ encode failure
->
-
-This outputs:
-
-```
-{"data": {"hello": "it's me"}}
-This will fail
-{"data": {"boyhowdy": null}, "errors":[{"message": "the field boyhowdy did not resolve."}]}
-```
-
 === Combining resolvers ===

 Now that we have two resolvers, we can define a schema which uses them both.

 > schema3 :: Schema IO
-> schema3 = Schema queryType3 Nothing
+> schema3 = Schema
+>   { query = queryType3, mutation = Nothing, subscription = Nothing }
 >
 > queryType3 :: ObjectType IO
 > queryType3 = ObjectType "Query" Nothing [] $ HashMap.fromList
->   [ ("hello", Out.Resolver helloField hello)
->   , ("time", Out.Resolver timeField time)
+>   [ ("hello", ValueResolver helloField hello)
+>   , ("time", ValueResolver timeField time)
 >   ]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
-> main3 = graphql schema3 query3 >>= putStrLn . encode
+> main3 = graphql schema3 query3
+>   >>= either (const $ pure ()) (putStrLn . encode)

 This queries for both time and hello, returning

 ```{ "data": {"hello":"it's me","time":"2016-03-08 23:29:11.62108 UTC"}}```

-Notice that we can name our queries, as we did with `timeAndHello`. Since we have only been using single queries, we can use the shorthand `{ time hello}`, as we have been doing in the previous examples.
+Notice that we can name our queries, as we did with `timeAndHello`. Since we
+have only been using single queries, we can use the shorthand `{ time hello }`,
+as we have been doing in the previous examples.

 In GraphQL there can only be one operation per query.


 == Further examples ==

-More examples on queries and a more complex schema can be found in the test directory,
-in the [Test.StarWars](../../tests/Test/StarWars) module. This includes a more complex schema, and more complex queries.
+More examples on queries and a more complex schema can be found in the test
+directory, in the [Test.StarWars](../../tests/Test/StarWars) module. This
+includes a more complex schema, and more complex queries.

 > main :: IO ()
-> main = main1 >> main2 >> mainShouldFail >> main3
+> main = main1 >> main2 >> main3
--- a/graphql.cabal
+++ b/graphql.cabal
@ -0,0 +1,121 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: ba234bcfff46df053a3466359e32682c4592b88894911ecbe78bd00fa00929b5
+
+name:           graphql
+version:        0.8.0.0
+synopsis:       Haskell GraphQL implementation
+description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
+category:       Language
+homepage:       https://github.com/caraus-ecms/graphql#readme
+bug-reports:    https://github.com/caraus-ecms/graphql/issues
+author:         Danny Navarro <j@dannynavarro.net>,
+                Matthías Páll Gissurarson <mpg@mpg.is>,
+                Sólrún Halla Einarsdóttir <she@mpg.is>
+maintainer:     belka@caraus.de
+copyright:      (c) 2019-2020 Eugen Wissner,
+                (c) 2015-2017 J. Daniel Navarro
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    CHANGELOG.md
+    README.md
+    LICENSE
+    docs/tutorial/tutorial.lhs
+data-files:
+    tests/data/kitchen-sink.graphql
+    tests/data/kitchen-sink.min.graphql
+
+source-repository head
+  type: git
+  location: https://github.com/caraus-ecms/graphql
+
+library
+  exposed-modules:
+      Language.GraphQL
+      Language.GraphQL.AST
+      Language.GraphQL.AST.DirectiveLocation
+      Language.GraphQL.AST.Document
+      Language.GraphQL.AST.Encoder
+      Language.GraphQL.AST.Lexer
+      Language.GraphQL.AST.Parser
+      Language.GraphQL.Error
+      Language.GraphQL.Execute
+      Language.GraphQL.Execute.Coerce
+      Language.GraphQL.Type
+      Language.GraphQL.Type.In
+      Language.GraphQL.Type.Out
+      Language.GraphQL.Type.Schema
+      Language.GraphQL.Validate
+      Test.Hspec.GraphQL
+  other-modules:
+      Language.GraphQL.Execute.Execution
+      Language.GraphQL.Execute.Subscribe
+      Language.GraphQL.Execute.Transform
+      Language.GraphQL.Type.Definition
+      Language.GraphQL.Type.Internal
+      Language.GraphQL.Validate.Rules
+  hs-source-dirs:
+      src
+  build-depends:
+      aeson
+    , base >=4.7 && <5
+    , conduit
+    , containers
+    , exceptions
+    , hspec-expectations
+    , megaparsec
+    , parser-combinators
+    , scientific
+    , text
+    , transformers
+    , unordered-containers
+  default-language: Haskell2010
+
+test-suite tasty
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Language.GraphQL.AST.EncoderSpec
+      Language.GraphQL.AST.LexerSpec
+      Language.GraphQL.AST.ParserSpec
+      Language.GraphQL.ErrorSpec
+      Language.GraphQL.Execute.CoerceSpec
+      Language.GraphQL.ExecuteSpec
+      Language.GraphQL.Type.OutSpec
+      Language.GraphQL.ValidateSpec
+      Test.DirectiveSpec
+      Test.FragmentSpec
+      Test.KitchenSinkSpec
+      Test.RootOperationSpec
+      Test.StarWars.Data
+      Test.StarWars.QuerySpec
+      Test.StarWars.Schema
+      Paths_graphql
+  hs-source-dirs:
+      tests
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      QuickCheck
+    , aeson
+    , base >=4.7 && <5
+    , conduit
+    , containers
+    , exceptions
+    , graphql
+    , hspec
+    , hspec-expectations
+    , hspec-megaparsec
+    , megaparsec
+    , parser-combinators
+    , raw-strings-qq
+    , scientific
+    , text
+    , transformers
+    , unordered-containers
+  default-language: Haskell2010
--- a/package.yaml
+++ b/package.yaml
@ -1,5 +1,5 @@
 name:                graphql
-version:             0.8.0.0
+version:             0.9.0.0
 synopsis:            Haskell GraphQL implementation
 description:
  This package provides a rudimentary parser for the
@ -28,23 +28,26 @@ data-files:
 dependencies:
 - aeson
 - base >= 4.7 && < 5
+- conduit
 - containers
+- exceptions
+- hspec-expectations
 - megaparsec
 - parser-combinators
 - scientific
 - text
 - transformers
 - unordered-containers
- vector

 library:
  source-dirs: src
  other-modules:
  - Language.GraphQL.Execute.Execution
+  - Language.GraphQL.Execute.Subscribe
  - Language.GraphQL.Execute.Transform
  - Language.GraphQL.Type.Definition
-  - Language.GraphQL.Type.Directive
-  - Language.GraphQL.Type.Schema
+  - Language.GraphQL.Type.Internal
+  - Language.GraphQL.Validate.Rules

 tests:
  tasty:
@ -57,7 +60,6 @@ tests:
    dependencies:
    - graphql
    - hspec
-    - hspec-expectations
    - hspec-megaparsec
    - QuickCheck
    - raw-strings-qq
--- a/semaphoreci.sh
+++ b/semaphoreci.sh
@ -1,40 +0,0 @@
-#!/bin/bash
-
-STACK=$SEMAPHORE_CACHE_DIR/stack
-export STACK_ROOT=$SEMAPHORE_CACHE_DIR/.stack
-
-setup() {
-	if [ ! -e "$STACK" ]
-	then
-		curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C $SEMAPHORE_CACHE_DIR '*/stack'
-	fi
-	if [ -e "$SEMAPHORE_CACHE_DIR/graphql.cabal" ]
-	then
-		cp -a $SEMAPHORE_CACHE_DIR/graphql.cabal graphql.cabal
-	fi
-	$STACK --no-terminal setup
-	cp -a graphql.cabal $SEMAPHORE_CACHE_DIR/graphql.cabal
-}
-
-setup_test() {
-	$STACK --no-terminal test --only-snapshot
-}
-
-test() {
-	$STACK --no-terminal test --pedantic
-}
-
-test_docs() {
-	$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
-	$STACK --no-terminal haddock --no-haddock-deps
-}
-
-setup_lint() {
-	$STACK --no-terminal install hlint
-}
-
-lint() {
-	$STACK --no-terminal exec hlint -- src tests
-}
-
-$1
--- 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)
+        ]
--- 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
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@ -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
-
--- 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

--- 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'
--- 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
+        *> extensionParser
--- 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"
+    <?> "TypeSystemDirectiveLocation"

-typeDefinition :: Parser TypeDefinition
-typeDefinition = scalarTypeDefinition
-    <|> objectTypeDefinition
-    <|> interfaceTypeDefinition
-    <|> unionTypeDefinition
-    <|> enumTypeDefinition
-    <|> inputObjectTypeDefinition
+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"
+
+stringValue :: Parser Text
+stringValue = blockString <|> string <?> "StringValue"
+
+nullValue :: Parser Text
+nullValue = symbol "null" <?> "NullValue"

 objectField :: Parser a -> Parser (ObjectField a)
-objectField valueParser = ObjectField <$> name <* colon <*> valueParser
-
-- * Variables
+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
--- 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
--- 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
--- 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)
--- a/src/Language/GraphQL/Execute/Subscribe.hs
+++ 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
--- 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'
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@ -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
--- 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
--- 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'
--- a/src/Language/GraphQL/Type/Directive.hs
+++ b/src/Language/GraphQL/Type/Directive.hs
@ -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'
--- a/src/Language/GraphQL/Type/Internal.hs
+++ 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
--- 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
--- 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
--- a/src/Language/GraphQL/Validate.hs
+++ 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
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ 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."
--- a/src/Test/Hspec/GraphQL.hs
+++ b/src/Test/Hspec/GraphQL.hs
@ -0,0 +1,40 @@
+{- 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 #-}
+
+-- | Test helpers.
+module Test.Hspec.GraphQL
+    ( shouldResolve
+    , shouldResolveTo
+    ) where
+
+import qualified Data.Aeson as Aeson
+import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text)
+import Language.GraphQL.Error
+import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)
+
+-- | Asserts that a query resolves to some value.
+shouldResolveTo
+    :: Either (ResponseEventStream IO Aeson.Value) Aeson.Object
+    -> Aeson.Object
+    -> Expectation
+shouldResolveTo (Right actual) expected = actual `shouldBe` expected
+shouldResolveTo _ _ = expectationFailure
+    "the query is expected to resolve to a value, but it resolved to an event stream"
+
+-- | Asserts that the response doesn't contain any errors.
+shouldResolve
+    :: (Text -> IO (Either (ResponseEventStream IO Aeson.Value) Aeson.Object))
+    -> Text
+    -> Expectation
+shouldResolve executor query = do
+    actual <- executor query
+    case actual of
+        Right response ->
+            response `shouldNotSatisfy` HashMap.member "errors"
+        _ -> expectationFailure
+            "the query is expected to resolve to a value, but it resolved to an event stream"
--- a/stack.yaml
+++ b/stack.yaml
@ -1,4 +1,4 @@
-resolver: lts-16.1
+resolver: lts-16.6

 packages:
 - .
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -129,10 +129,11 @@ spec = describe "Parser" $ do

    it "parses schema extension with an operation type and directive" $
        let newDirective = Directive "newDirective" []
-            testSchemaExtension = TypeSystemExtension
-                $ SchemaExtension
+            schemaExtension = SchemaExtension
                $ SchemaOperationExtension [newDirective]
                $ OperationTypeDefinition Query "Query" :| []
+            testSchemaExtension = TypeSystemExtension schemaExtension
+                $ Location 1 1
            query = [r|extend schema @newDirective { query: Query }|]
         in parse document "" query `shouldParse` (testSchemaExtension :| [])

@ -149,3 +150,22 @@ spec = describe "Parser" $ do
              title
            }
        |]
+
+    it "parses documents beginning with a comment" $
+        parse document "" `shouldSucceedOn` [r|
+            """
+            Query
+            """
+            type Query {
+                queryField: String
+            }
+        |]
+
+    it "parses subscriptions" $
+        parse document "" `shouldSucceedOn` [r|
+            subscription NewMessages {
+              newMessage(roomId: 123) {
+                sender
+              }
+            }
+        |]
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@ -4,6 +4,7 @@ module Language.GraphQL.ErrorSpec
    ) where

 import qualified Data.Aeson as Aeson
+import qualified Data.Sequence as Seq
 import Language.GraphQL.Error
 import Test.Hspec ( Spec
                  , describe
@ -14,11 +15,6 @@ import Test.Hspec ( Spec
 spec :: Spec
 spec = describe "singleError" $
    it "constructs an error with the given message" $
-        let expected = Aeson.object
-                [
-                    ("errors", Aeson.toJSON
-                        [ Aeson.object [("message", "Message.")]
-                        ]
-                    )
-                ]
+        let errors'' = Seq.singleton $ Error "Message." []
+            expected = Response Aeson.Null errors''
         in singleError "Message." `shouldBe` expected
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@ -1,11 +1,16 @@
+{- 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 OverloadedStrings #-}
 module Language.GraphQL.ExecuteSpec
    ( spec
    ) where

+import Control.Exception (SomeException)
 import Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
-import Data.Functor.Identity (Identity(..))
+import Data.Conduit
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL.AST (Name)
@ -14,62 +19,95 @@ import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Out as Out
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.Megaparsec (parse)

-schema :: Schema Identity
-schema = Schema {query = queryType, mutation = Nothing}
+schema :: Schema (Either SomeException)
+schema = Schema
+    { query = queryType
+    , mutation = Nothing
+    , subscription = Just subscriptionType
+    }

-queryType :: Out.ObjectType Identity
+queryType :: Out.ObjectType (Either SomeException)
 queryType = Out.ObjectType "Query" Nothing []
-    $ HashMap.singleton "philosopher"
-    $ Out.Resolver philosopherField
-    $ pure
-    $ Type.Object mempty
+    $ HashMap.singleton "philosopher" 
+    $ ValueResolver philosopherField
+    $ pure $ Type.Object mempty
  where
    philosopherField =
        Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty

-philosopherType :: Out.ObjectType Identity
+philosopherType :: Out.ObjectType (Either SomeException)
 philosopherType = Out.ObjectType "Philosopher" Nothing []
    $ HashMap.fromList resolvers
  where
    resolvers =
-        [ ("firstName", firstNameResolver)
-        , ("lastName", lastNameResolver)
+        [ ("firstName", ValueResolver firstNameField firstNameResolver)
+        , ("lastName", ValueResolver lastNameField lastNameResolver)
        ]
-    firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
-    lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
-    firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
-    lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+    firstNameField =
+        Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+    firstNameResolver = pure $ Type.String "Friedrich"
+    lastNameField
+        = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+    lastNameResolver = pure $ Type.String "Nietzsche"
+
+subscriptionType :: Out.ObjectType (Either SomeException)
+subscriptionType = Out.ObjectType "Subscription" Nothing []
+    $ HashMap.singleton "newQuote"
+    $ EventStreamResolver quoteField (pure $ Type.Object mempty)
+    $ pure $ yield $ Type.Object mempty
+  where
+    quoteField =
+        Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
+
+quoteType :: Out.ObjectType (Either SomeException)
+quoteType = Out.ObjectType "Quote" Nothing []
+    $ HashMap.singleton "quote"
+    $ ValueResolver quoteField
+    $ pure "Naturam expelles furca, tamen usque recurret."
+  where
+    quoteField =
+        Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty

 spec :: Spec
 spec =
    describe "execute" $ do
-        it "skips unknown fields" $
-            let expected = Aeson.object
-                    [ "data" .= Aeson.object
+        context "Query" $ do
+            it "skips unknown fields" $
+                let data'' = Aeson.object
                        [ "philosopher" .= Aeson.object
                            [ "firstName" .= ("Friedrich" :: String)
                            ]
                        ]
-                    ]
-                execute' = execute schema (mempty :: HashMap Name Aeson.Value)
-                actual = runIdentity
-                    $ either parseError execute'
-                    $ parse document "" "{ philosopher { firstName surname } }"
-             in actual `shouldBe` expected
-        it "merges selections" $
-            let expected = Aeson.object
-                    [ "data" .= Aeson.object
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    Right (Right actual) = either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher { firstName surname } }"
+                in actual `shouldBe` expected
+            it "merges selections" $
+                let data'' = Aeson.object
                        [ "philosopher" .= Aeson.object
                            [ "firstName" .= ("Friedrich" :: String)
                            , "lastName" .= ("Nietzsche" :: String)
                            ]
                        ]
-                    ]
-                execute' = execute schema (mempty :: HashMap Name Aeson.Value)
-                actual = runIdentity
-                    $ either parseError execute'
-                    $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
-             in actual `shouldBe` expected
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    Right (Right actual) = either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
+                in actual `shouldBe` expected
+        context "Subscription" $
+            it "subscribes" $
+                let data'' = Aeson.object
+                        [ "newQuote" .= Aeson.object
+                            [ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
+                            ]
+                        ]
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    Right (Left stream) = either (pure . parseError) execute'
+                        $ parse document "" "subscription { newQuote { quote } }"
+                    Right (Just actual) = runConduit $ stream .| await
+                in actual `shouldBe` expected
--- a/tests/Language/GraphQL/ValidateSpec.hs
+++ b/tests/Language/GraphQL/ValidateSpec.hs
@ -0,0 +1,171 @@
+{- 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 OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Language.GraphQL.ValidateSpec
+    ( spec
+    ) where
+
+import Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
+import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text)
+import qualified Language.GraphQL.AST as AST
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Validate
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.Megaparsec (parse)
+import Text.RawString.QQ (r)
+
+schema :: Schema IO
+schema = Schema
+    { query = queryType
+    , mutation = Nothing
+    , subscription = Nothing
+    } 
+
+queryType :: ObjectType IO
+queryType = ObjectType "Query" Nothing []
+    $ HashMap.singleton "dog" dogResolver
+  where
+    dogField = Field Nothing (Out.NamedObjectType dogType) mempty
+    dogResolver = ValueResolver dogField $ pure Null
+
+dogCommandType :: EnumType
+dogCommandType = EnumType "DogCommand" Nothing $ HashMap.fromList
+    [ ("SIT", EnumValue Nothing)
+    , ("DOWN", EnumValue Nothing)
+    , ("HEEL", EnumValue Nothing)
+    ]
+
+dogType :: ObjectType IO
+dogType = ObjectType "Dog" Nothing [petType] $ HashMap.fromList
+    [ ("name", nameResolver)
+    , ("nickname", nicknameResolver)
+    , ("barkVolume", barkVolumeResolver)
+    , ("doesKnowCommand", doesKnowCommandResolver)
+    , ("isHousetrained", isHousetrainedResolver)
+    , ("owner", ownerResolver)
+    ]
+  where
+    nameField = Field Nothing (Out.NonNullScalarType string) mempty
+    nameResolver = ValueResolver nameField $ pure "Name"
+    nicknameField = Field Nothing (Out.NamedScalarType string) mempty
+    nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
+    barkVolumeField = Field Nothing (Out.NamedScalarType int) mempty
+    barkVolumeResolver = ValueResolver barkVolumeField $ pure $ Int 3
+    doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
+        $ HashMap.singleton "dogCommand"
+        $ In.Argument Nothing (In.NonNullEnumType dogCommandType) Nothing
+    doesKnowCommandResolver = ValueResolver doesKnowCommandField
+        $ pure $ Boolean True
+    isHousetrainedField = Field Nothing (Out.NonNullScalarType boolean)
+        $ HashMap.singleton "atOtherHomes"
+        $ In.Argument Nothing (In.NamedScalarType boolean) Nothing
+    isHousetrainedResolver = ValueResolver isHousetrainedField
+        $ pure $ Boolean True
+    ownerField = Field Nothing (Out.NamedObjectType humanType) mempty
+    ownerResolver = ValueResolver ownerField $ pure Null
+
+sentientType :: InterfaceType IO
+sentientType = InterfaceType "Sentient" Nothing []
+    $ HashMap.singleton "name"
+    $ Field Nothing (Out.NonNullScalarType string) mempty
+
+petType :: InterfaceType IO
+petType = InterfaceType "Pet" Nothing []
+    $ HashMap.singleton "name"
+    $ Field Nothing (Out.NonNullScalarType string) mempty
+{-
+alienType :: ObjectType IO
+alienType = ObjectType "Alien" Nothing [sentientType] $ HashMap.fromList
+    [ ("name", nameResolver)
+    , ("homePlanet", homePlanetResolver)
+    ]
+  where
+    nameField = Field Nothing (Out.NonNullScalarType string) mempty
+    nameResolver = ValueResolver nameField $ pure "Name"
+    homePlanetField =
+        Field Nothing (Out.NamedScalarType string) mempty
+    homePlanetResolver = ValueResolver homePlanetField $ pure "Home planet"
+-}
+humanType :: ObjectType IO
+humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList
+    [ ("name", nameResolver)
+    , ("pets", petsResolver)
+    ]
+  where
+    nameField = Field Nothing (Out.NonNullScalarType string) mempty
+    nameResolver = ValueResolver nameField $ pure "Name"
+    petsField =
+        Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty
+    petsResolver = ValueResolver petsField $ pure $ List []
+{-
+catCommandType :: EnumType
+catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
+    [ ("JUMP", EnumValue Nothing)
+    ]
+
+catType :: ObjectType IO
+catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList
+    [ ("name", nameResolver)
+    , ("nickname", nicknameResolver)
+    , ("doesKnowCommand", doesKnowCommandResolver)
+    , ("meowVolume", meowVolumeResolver)
+    ]
+  where
+    nameField = Field Nothing (Out.NonNullScalarType string) mempty
+    nameResolver = ValueResolver nameField $ pure "Name"
+    nicknameField = Field Nothing (Out.NamedScalarType string) mempty
+    nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
+    doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
+        $ HashMap.singleton "catCommand"
+        $ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing
+    doesKnowCommandResolver = ValueResolver doesKnowCommandField
+        $ pure $ Boolean True
+    meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty
+    meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 2
+
+catOrDogType :: UnionType IO
+catOrDogType = UnionType "CatOrDog" Nothing [catType, dogType]
+
+dogOrHumanType :: UnionType IO
+dogOrHumanType = UnionType "DogOrHuman" Nothing [dogType, humanType]
+
+humanOrAlienType :: UnionType IO
+humanOrAlienType = UnionType "HumanOrAlien" Nothing [humanType, alienType]
+-}
+validate :: Text -> Seq Error
+validate queryString =
+    case parse AST.document "" queryString of
+        Left _ -> Seq.empty
+        Right ast -> document schema specifiedRules ast
+
+spec :: Spec
+spec =
+    describe "document" $
+        it "rejects type definitions" $
+            let queryString = [r|
+              query getDogName {
+                dog {
+                  name
+                  color
+                }
+              }
+
+              extend type Dog {
+                color: String
+              }
+            |]
+                expected = Error
+                    { message =
+                        "Definition must be OperationDefinition or FragmentDefinition."
+                    , locations = [AST.Location 9 15]
+                    , path = []
+                    }
+             in validate queryString `shouldBe` Seq.singleton expected
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@ -1,3 +1,7 @@
+{- 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 OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.DirectiveSpec
@ -10,21 +14,21 @@ import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec.GraphQL
 import Text.RawString.QQ (r)

 experimentalResolver :: Schema IO
-experimentalResolver = Schema { query = queryType, mutation = Nothing }
+experimentalResolver = Schema
+    { query = queryType, mutation = Nothing, subscription = Nothing }
  where
-    resolver = pure $ Int 5
    queryType = Out.ObjectType "Query" Nothing []
        $ HashMap.singleton "experimentalField"
-        $ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty) resolver
+        $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+        $ pure $ Int 5

-emptyObject :: Aeson.Value
-emptyObject = object
-    [ "data" .= object []
-    ]
+emptyObject :: Aeson.Object
+emptyObject = HashMap.singleton "data" $ object []

 spec :: Spec
 spec =
@ -37,7 +41,7 @@ spec =
            |]

            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldBe` emptyObject
+            actual `shouldResolveTo` emptyObject

        it "should not skip fields if @skip is false" $ do
            let sourceQuery = [r|
@ -45,14 +49,12 @@ spec =
                experimentalField @skip(if: false)
              }
            |]
-                expected = object
-                    [ "data" .= object
+                expected = HashMap.singleton "data"
+                    $ object
                        [ "experimentalField" .= (5 :: Int)
                        ]
-                    ]
-
            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldBe` expected
+            actual `shouldResolveTo` expected

        it "should skip fields if @include is false" $ do
            let sourceQuery = [r|
@ -62,7 +64,7 @@ spec =
            |]

            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldBe` emptyObject
+            actual `shouldResolveTo` emptyObject

        it "should be able to @skip a fragment spread" $ do
            let sourceQuery = [r|
@ -76,7 +78,7 @@ spec =
            |]

            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldBe` emptyObject
+            actual `shouldResolveTo` emptyObject

        it "should be able to @skip an inline fragment" $ do
            let sourceQuery = [r|
@ -88,4 +90,4 @@ spec =
            |]

            actual <- graphql experimentalResolver sourceQuery
-            actual `shouldBe` emptyObject
+            actual `shouldResolveTo` emptyObject
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@ -1,23 +1,22 @@
+{- 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 OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.FragmentSpec
    ( spec
    ) where

-import Data.Aeson (object, (.=))
+import Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
-import Test.Hspec
-    ( Spec
-    , describe
-    , it
-    , shouldBe
-    , shouldNotSatisfy
-    )
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec.GraphQL
 import Text.RawString.QQ (r)

 size :: (Text, Value)
@ -46,33 +45,33 @@ inlineQuery = [r|{
  }
 }|]

-hasErrors :: Aeson.Value -> Bool
-hasErrors (Aeson.Object object') = HashMap.member "errors" object'
-hasErrors _ = True
-
 shirtType :: Out.ObjectType IO
 shirtType = Out.ObjectType "Shirt" Nothing []
    $ HashMap.fromList
-        [ ("size", Out.Resolver sizeFieldType $ pure $ snd size)
-        , ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference)
+        [ ("size", sizeFieldType)
+        , ("circumference", circumferenceFieldType)
        ]

 hatType :: Out.ObjectType IO
 hatType = Out.ObjectType "Hat" Nothing []
    $ HashMap.fromList
-        [ ("size", Out.Resolver sizeFieldType $ pure $ snd size)
-        , ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference)
+        [ ("size", sizeFieldType)
+        , ("circumference", circumferenceFieldType)
        ]

-circumferenceFieldType :: Out.Field IO
-circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty
+circumferenceFieldType :: Out.Resolver IO
+circumferenceFieldType
+    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+    $ pure $ snd circumference

-sizeFieldType :: Out.Field IO
-sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+sizeFieldType :: Out.Resolver IO
+sizeFieldType
+    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+    $ pure $ snd size

 toSchema :: Text -> (Text, Value) -> Schema IO
 toSchema t (_, resolve) = Schema
-    { query = queryType, mutation = Nothing }
+    { query = queryType, mutation = Nothing, subscription = Nothing }
  where
    unionMember = if t == "Hat" then hatType else shirtType
    typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
@ -83,8 +82,8 @@ toSchema t (_, resolve) = Schema
            "size" -> shirtType
            _ -> Out.ObjectType "Query" Nothing []
                $ HashMap.fromList
-                    [ ("garment", Out.Resolver garmentField $ pure resolve)
-                    , ("__typename", Out.Resolver typeNameField $ pure $ String "Shirt")
+                    [ ("garment", ValueResolver garmentField (pure resolve))
+                    , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
                    ]

 spec :: Spec
@ -92,25 +91,23 @@ spec = do
    describe "Inline fragment executor" $ do
        it "chooses the first selection if the type matches" $ do
            actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
-            let expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
+            let expected = HashMap.singleton "data"
+                    $ Aeson.object
+                        [ "garment" .= Aeson.object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
-                    ]
-             in actual `shouldBe` expected
+             in actual `shouldResolveTo` expected

        it "chooses the last selection if the type matches" $ do
            actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
-            let expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
+            let expected = HashMap.singleton "data"
+                    $ Aeson.object
+                        [ "garment" .= Aeson.object
                            [ "size" .= ("L" :: Text)
                            ]
                        ]
-                    ]
-             in actual `shouldBe` expected
+             in actual `shouldResolveTo` expected

        it "embeds inline fragments without type" $ do
            let sourceQuery = [r|{
@ -124,15 +121,14 @@ spec = do
                resolvers = ("garment", Object $ HashMap.fromList [circumference,  size])

            actual <- graphql (toSchema "garment" resolvers) sourceQuery
-            let expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
+            let expected = HashMap.singleton "data"
+                    $ Aeson.object
+                        [ "garment" .= Aeson.object
                            [ "circumference" .= (60 :: Int)
                            , "size" .= ("L" :: Text)
                            ]
                        ]
-                    ]
-             in actual `shouldBe` expected
+             in actual `shouldResolveTo` expected

        it "evaluates fragments on Query" $ do
            let sourceQuery = [r|{
@ -140,9 +136,7 @@ spec = do
                size
              }
            }|]
-
-            actual <- graphql (toSchema "size" size) sourceQuery
-            actual `shouldNotSatisfy` hasErrors
+             in graphql (toSchema "size" size) `shouldResolve` sourceQuery

    describe "Fragment spread executor" $ do
        it "evaluates fragment spreads" $ do
@ -157,12 +151,11 @@ spec = do
            |]

            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            let expected = object
-                    [ "data" .= object
+            let expected = HashMap.singleton "data"
+                    $ Aeson.object
                        [ "circumference" .= (60 :: Int)
                        ]
-                    ]
-             in actual `shouldBe` expected
+             in actual `shouldResolveTo` expected

        it "evaluates nested fragments" $ do
            let sourceQuery = [r|
@ -182,19 +175,16 @@ spec = do
            |]

            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
-            let expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
+            let expected = HashMap.singleton "data"
+                    $ Aeson.object
+                        [ "garment" .= Aeson.object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
-                    ]
-             in actual `shouldBe` expected
+             in actual `shouldResolveTo` expected

        it "rejects recursive fragments" $ do
-            let expected = object
-                    [ "data" .= object []
-                    ]
+            let expected = HashMap.singleton "data" $ Aeson.object []
                sourceQuery = [r|
              {
                ...circumferenceFragment
@ -206,7 +196,7 @@ spec = do
            |]

            actual <- graphql (toSchema "circumference" circumference) sourceQuery
-            actual `shouldBe` expected
+            actual `shouldResolveTo` expected

        it "considers type condition" $ do
            let sourceQuery = [r|
@ -223,12 +213,11 @@ spec = do
                size
              }
            |]
-                expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
+                expected = HashMap.singleton "data"
+                    $ Aeson.object
+                        [ "garment" .= Aeson.object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
-                    ]
            actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
-            actual `shouldBe` expected
+            actual `shouldResolveTo` expected
--- a/tests/Test/RootOperationSpec.hs
+++ b/tests/Test/RootOperationSpec.hs
@ -1,3 +1,7 @@
+{- 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 OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.RootOperationSpec
@ -7,30 +11,34 @@ module Test.RootOperationSpec
 import Data.Aeson ((.=), object)
 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, describe, it)
 import Text.RawString.QQ (r)
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.Out as Out
+import Test.Hspec.GraphQL

 hatType :: Out.ObjectType IO
 hatType = Out.ObjectType "Hat" Nothing []
    $ HashMap.singleton "circumference"
-    $ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+    $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
    $ pure $ Int 60

 schema :: Schema IO
 schema = Schema
-    (Out.ObjectType "Query" Nothing [] hatField)
-    (Just $ Out.ObjectType "Mutation" Nothing [] incrementField)
+    { query = Out.ObjectType "Query" Nothing [] hatFieldResolver
+    , mutation = Just $ Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
+    , subscription = Nothing
+    }
  where
    garment = pure $ Object $ HashMap.fromList
        [ ("circumference", Int 60)
        ]
-    incrementField = HashMap.singleton "incrementCircumference"
-        $ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+    incrementFieldResolver = HashMap.singleton "incrementCircumference"
+        $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
        $ pure $ Int 61
-    hatField = HashMap.singleton "garment"
-        $ Out.Resolver (Out.Field Nothing (Out.NamedObjectType hatType) mempty) garment
+    hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty
+    hatFieldResolver =
+        HashMap.singleton "garment" $ ValueResolver hatField garment

 spec :: Spec
 spec =
@ -43,15 +51,14 @@ spec =
                }
              }
            |]
-                expected = object
-                    [ "data" .= object
+                expected = HashMap.singleton "data"
+                    $ object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
-                    ]
            actual <- graphql schema querySource
-            actual `shouldBe` expected
+            actual `shouldResolveTo` expected

        it "chooses Mutation" $ do
            let querySource = [r|
@ -59,10 +66,9 @@ spec =
                incrementCircumference
              }
            |]
-                expected = object
-                    [ "data" .= object
+                expected = HashMap.singleton "data"
+                    $ object
                        [ "incrementCircumference" .= (61 :: Int)
                        ]
-                    ]
            actual <- graphql schema querySource
-            actual `shouldBe` expected
+            actual `shouldResolveTo` expected
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data
    ( Character
+    , StarWarsException(..)
    , appearsIn
    , artoo
    , getDroid
@ -16,12 +17,13 @@ module Test.StarWars.Data
    , typeName
    ) where

-import Data.Functor.Identity (Identity)
+import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException)
 import Control.Applicative (Alternative(..), liftA2)
-import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
-import Language.GraphQL.Trans
+import Data.Typeable (cast)
+import Language.GraphQL.Error
+import Language.GraphQL.Type

 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@ -66,8 +68,20 @@ appearsIn :: Character -> [Int]
 appearsIn (Left  x) = _appearsIn . _droidChar $ x
 appearsIn (Right x) = _appearsIn . _humanChar $ x

-secretBackstory :: ActionT Identity Text
-secretBackstory = ActionT $ throwE "secretBackstory is secret."
+data StarWarsException = SecretBackstory | InvalidArguments
+
+instance Show StarWarsException where
+    show SecretBackstory = "secretBackstory is secret."
+    show InvalidArguments = "Invalid arguments."
+
+instance Exception StarWarsException where
+    toException = toException . ResolverException
+    fromException e = do
+        ResolverException resolverException <- fromException e
+        cast resolverException
+
+secretBackstory :: Resolve (Either SomeException)
+secretBackstory = throwM SecretBackstory

 typeName :: Character -> Text
 typeName = either (const "Droid") (const "Human")
@ -161,10 +175,10 @@ getHero :: Int -> Character
 getHero 5 = luke
 getHero _ = artoo

-getHuman :: Alternative f => ID -> f Character
+getHuman :: ID -> Maybe Character
 getHuman = fmap Right . getHuman'

-getHuman' :: Alternative f => ID -> f Human
+getHuman' :: ID -> Maybe Human
 getHuman' "1000" = pure luke'
 getHuman' "1001" = pure vader
 getHuman' "1002" = pure han
@ -172,10 +186,10 @@ getHuman' "1003" = pure leia
 getHuman' "1004" = pure tarkin
 getHuman' _      = empty

-getDroid :: Alternative f => ID -> f Character
+getDroid :: ID -> Maybe Character
 getDroid = fmap Left . getDroid'

-getDroid' :: Alternative f => ID -> f Droid
+getDroid' :: ID -> Maybe Droid
 getDroid' "2000" = pure threepio
 getDroid' "2001" = pure artoo'
 getDroid' _      = empty
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@ -6,7 +6,6 @@ module Test.StarWars.QuerySpec

 import qualified Data.Aeson as Aeson
 import Data.Aeson ((.=))
-import Data.Functor.Identity (Identity(..))
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL
@ -357,8 +356,11 @@ spec = describe "Star Wars Query Tests" $ do
    alderaan = "homePlanet" .= ("Alderaan" :: Text)

 testQuery :: Text -> Aeson.Value -> Expectation
-testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
+testQuery q expected =
+    let Right (Right actual) = graphql schema q
+     in Aeson.Object actual `shouldBe` expected

 testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected =
-    runIdentity (graphqlSubs schema f q) `shouldBe` expected
+    let Right (Right actual) = graphqlSubs schema Nothing f q
+     in Aeson.Object actual `shouldBe` expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -4,14 +4,11 @@ module Test.StarWars.Schema
    ( schema
    ) where

+import Control.Monad.Catch (MonadThrow(..), SomeException)
 import Control.Monad.Trans.Reader (asks)
-import Control.Monad.Trans.Except (throwE)
-import Control.Monad.Trans.Class (lift)
-import Data.Functor.Identity (Identity)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
-import Language.GraphQL.Trans
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
@ -20,69 +17,97 @@ import Prelude hiding (id)

 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js

-schema :: Schema Identity
-schema = Schema { query = queryType, mutation = Nothing }
+schema :: Schema (Either SomeException)
+schema = Schema
+    { query = queryType
+    , mutation = Nothing
+    , subscription = Nothing
+    }
  where
    queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
-        [ ("hero", Out.Resolver heroField hero)
-        , ("human", Out.Resolver humanField human)
-        , ("droid", Out.Resolver droidField droid)
+        [ ("hero", heroFieldResolver)
+        , ("human", humanFieldResolver)
+        , ("droid", droidFieldResolver)
        ]
    heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
        $ HashMap.singleton "episode"
        $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+    heroFieldResolver = ValueResolver heroField hero
    humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
        $ HashMap.singleton "id"
        $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+    humanFieldResolver = ValueResolver humanField human
    droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
+    droidFieldResolver = ValueResolver droidField droid

-heroObject :: Out.ObjectType Identity
+heroObject :: Out.ObjectType (Either SomeException)
 heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
-    [ ("id", Out.Resolver idFieldType (idField "id"))
-    , ("name", Out.Resolver nameFieldType (idField "name"))
-    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
-    , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
-    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
-    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    [ ("id", idFieldType)
+    , ("name", nameFieldType)
+    , ("friends", friendsFieldType)
+    , ("appearsIn", appearsInField)
+    , ("homePlanet", homePlanetFieldType)
+    , ("secretBackstory", secretBackstoryFieldType)
+    , ("__typename", typenameFieldType)
    ]
  where
-    homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+    homePlanetFieldType
+      = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+      $ idField "homePlanet"

-droidObject :: Out.ObjectType Identity
+droidObject :: Out.ObjectType (Either SomeException)
 droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
-    [ ("id", Out.Resolver idFieldType (idField "id"))
-    , ("name", Out.Resolver nameFieldType (idField "name"))
-    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
-    , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
-    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
-    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    [ ("id", idFieldType)
+    , ("name", nameFieldType)
+    , ("friends", friendsFieldType)
+    , ("appearsIn", appearsInField)
+    , ("primaryFunction", primaryFunctionFieldType)
+    , ("secretBackstory", secretBackstoryFieldType)
+    , ("__typename", typenameFieldType)
    ]
  where
-    primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+    primaryFunctionFieldType
+        = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+        $ idField "primaryFunction"

-idFieldType :: Out.Field Identity
-idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
+typenameFieldType :: Resolver (Either SomeException)
+typenameFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+    $ idField "__typename"

-nameFieldType :: Out.Field Identity
-nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+idFieldType :: Resolver (Either SomeException)
+idFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType id) mempty)
+    $ idField "id"

-friendsFieldType :: Out.Field Identity
-friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+nameFieldType :: Resolver (Either SomeException)
+nameFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+    $ idField "name"

-appearsInField :: Out.Field Identity
-appearsInField = Out.Field (Just description) fieldType mempty
+friendsFieldType :: Resolver (Either SomeException)
+friendsFieldType
+    = ValueResolver (Out.Field Nothing fieldType mempty)
+    $ idField "friends"
+  where
+    fieldType = Out.ListType $ Out.NamedObjectType droidObject
+
+appearsInField :: Resolver (Either SomeException)
+appearsInField
+    = ValueResolver (Out.Field (Just description) fieldType mempty)
+    $ idField "appearsIn"
  where
    fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
    description = "Which movies they appear in."

-secretBackstoryFieldType :: Out.Field Identity
-secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+secretBackstoryFieldType :: Resolver (Either SomeException)
+secretBackstoryFieldType = ValueResolver field secretBackstory
+  where
+    field = Out.Field Nothing (Out.NamedScalarType string) mempty

-idField :: Text -> ActionT Identity Value
+idField :: Text -> Resolve (Either SomeException)
 idField f = do
-    v <- ActionT $ lift $ asks values
+    v <- asks values
    let (Object v') = v
    pure $ v' HashMap.! f

@ -95,7 +120,7 @@ episodeEnum = EnumType "Episode" (Just description)
    empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
    jedi = ("JEDI", EnumValue $ Just "Released in 1983.")

-hero :: ActionT Identity Value
+hero :: Resolve (Either SomeException)
 hero = do
  episode <- argument "episode"
  pure $ character $ case episode of
@ -104,23 +129,19 @@ hero = do
      Enum "JEDI" -> getHero 6
      _ -> artoo

-human :: ActionT Identity Value
+human :: Resolve (Either SomeException)
 human = do
    id' <- argument "id"
    case id' of
-        String i -> do
-            humanCharacter <- lift $ return $ getHuman i >>= Just
-            case humanCharacter of
-                Nothing -> pure Null
-                Just e -> pure $ character e
-        _ -> ActionT $ throwE "Invalid arguments."
+        String i -> pure $ maybe Null character $ getHuman i >>= Just
+        _ -> throwM InvalidArguments

-droid :: ActionT Identity Value
+droid :: Resolve (Either SomeException)
 droid = do
    id' <- argument "id"
    case id' of
-        String i -> character <$> getDroid i
-        _ -> ActionT $ throwE "Invalid arguments."
+        String i -> pure $ maybe Null character $ getDroid i >>= Just
+        _ -> throwM InvalidArguments

 character :: Character -> Value
 character char = Object $ HashMap.fromList
Author	SHA1	Message	Date
Eugen Wissner	adeba459a2	Release 0.9.0.0	2020-07-24 21:34:31 +02:00
Eugen Wissner	44d506d4b5	Draft the Validation API	2020-07-20 21:29:12 +02:00
Eugen Wissner	b9d5b1fb1b	Return a stream as well from graphql* functions	2020-07-19 07:36:06 +02:00
Eugen Wissner	09135c581a	Constrain base monad to MonadCatch Let's try MonadThrow/MonadCatch. It looks nice at a first glance. The monad transformer stack contains only the ReaderT, less lifts are required. Exception subtyping is easier, the user can (and should) define custom error types and throw them. And it is still possible to use pure error handling, if someone doesn't like runtime exceptions or need to run a query in a pure environment. Fixes #42.	2020-07-17 07:05:03 +02:00
Eugen Wissner	e24386402b	Respect subscriptions in the executor After the last commit there were a few places needed to be adjusted to support subscriptions. This is done and a test case is added. It is important to implement subscriptions now, because they require changes to the library API, and they are a big missing part to finish the executor. When the executor is finished, we can start to provide more stable API without breaking everything every release. Validation and introspection shouldn't require much changes to the API; AST would require some changes to report good errors after the validation - this is one thing I can think of. Fixes #5.	2020-07-15 19:15:31 +02:00
Eugen Wissner	ae2210f659	Support subscriptions This is experimental support. The implementation is based on conduit and is boring. There is a new resolver data constructor that should create a source event stream. The executor receives the events, pipes them through the normal execution and puts them into the response stream which is returned to the user. - Tests are missing. - The executor should check field value resolver on subscription types. - The graphql function should probably return (Either ResponseEventStream Response), but I'm not sure about this. It will make the usage more complicated if no subscriptions are involved, but with the current API implementing subscriptions is more difficult than it should be.	2020-07-14 19:37:56 +02:00
Eugen Wissner	840e129c44	Parse subscriptions	2020-07-11 06:34:10 +02:00
Eugen Wissner	04a58be3f8	Label parsers with help info Fixes #36.	2020-07-10 08:43:47 +02:00
Eugen Wissner	28781586a5	Parse comments in the front of definitions	2020-07-09 08:11:12 +02:00
Eugen Wissner	c9e265f72c	Return parser error location in a list An error can have multiple locations which are returned in a listt with key "locations".	2020-07-08 08:17:55 +02:00
Eugen Wissner	b2d473de8d	Export sum type for all GraphQL types	2020-07-06 19:10:34 +02:00
Eugen Wissner	a6f9cec413	Handle errors using custom types Fixes #32.	2020-07-05 14:36:00 +02:00
Eugen Wissner	b5157e141e	Check in .cabal	2020-07-03 07:00:37 +02:00
Eugen Wissner	2f4310268a	Merge Trans and Type.Out modules	2020-07-02 07:33:03 +02:00
Eugen Wissner	8b164c4844	Move Core module out of AST	2020-06-30 10:28:10 +02:00
Eugen Wissner	705e506c13	Combine Resolver and ActionT in ResolverT	2020-06-29 13:14:23 +02:00
Eugen Wissner	9798b08b4c	Remove semaphoreci.sh	2020-06-26 11:40:09 +02:00
Eugen Wissner	175268b422	Add a github actions workflow	2020-06-24 10:12:22 +02:00