Add test for introspection as subscription root

Add a pending test checking that an introspection field cannot be subscription root.
Adjust wording according to the 2021 specification
2024-11-10 22:23:54 +01:00 · 2024-11-07 18:18:12 +01:00 · 2024-11-05 19:44:45 +01:00 · 2024-11-05 19:39:16 +01:00 · 2024-10-26 20:03:32 +02:00 · 2024-10-24 16:56:31 +02:00
58 changed files with 9598 additions and 2558 deletions
--- a/.gitea/deploy.awk
+++ b/.gitea/deploy.awk
@ -0,0 +1,3 @@
 END {
    system("cabal upload --username belka --password "ENVIRON["HACKAGE_PASSWORD"]" "$0)
 }
--- a/.gitea/workflows/build.yml
+++ b/.gitea/workflows/build.yml
@ -0,0 +1,33 @@
 name: Build
 on:
  push:
    branches:
      - '**'
  pull_request:
    branches: [master]
 jobs:
  audit:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - run: hlint -- src tests
  test:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Install dependencies
        run: cabal update
      - name: Prepare system
        run: cabal build graphql-test
      - run: cabal test --test-show-details=streaming
  doc:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Install dependencies
        run: cabal update
      - run: cabal haddock --enable-documentation
--- a/.gitea/workflows/release.yml
+++ b/.gitea/workflows/release.yml
@ -0,0 +1,17 @@
 name: Release
 on:
  push:
    tags:
      - '**'
 jobs:
  release:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Upload a candidate
        env:
          HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
        run: |
          cabal sdist | awk -f .gitea/deploy.awk
--- a/.gitignore
+++ b/.gitignore
@ -8,4 +8,8 @@
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.project.local
-/graphql.cabal
+
 # GHC
 *.hi
 *.o
 /docs/tutorial/tutorial
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -1,6 +1,387 @@
-# Change Log
+# Changelog
 All notable changes to this project will be documented in this file.
 The format is based on
 [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 ## [Unreleased]
 ### Changed
 - Remove deprecated 'gql' quasi quoter.
 ## [1.4.0.0] - 2024-10-26
 ### Changed
 - `Schema.Directive` is extended to contain a boolean argument, representing
  repeatable directives. The parser can parse repeatable directive definitions.
  Validation allows repeatable directives.
 - `AST.Document.Directive` is a record.
 - `gql` quasi quoter is deprecated (moved to graphql-spice package).
 ### Fixed
 - `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF).
 ### Added
 - @specifiedBy directive.
 ## [1.3.0.0] - 2024-05-01
 ### Changed
 - Remove deprecated `runCollectErrs`, `Resolution`, `CollectErrsT` from the
  `Error` module.
 ## [1.2.0.3] - 2024-01-09
 ### Fixed
 - Fix corrupted source distribution.
 ## [1.2.0.2] - 2024-01-09
 ### Fixed
 - `gql` removes not only leading `\n` but also `\r`.
 - Fix non nullable type string representation in executor error messages.
 - Fix input objects not being coerced to lists.
 - Fix used variables are not found in the properties of input objects.
 ## [1.2.0.1] - 2023-04-25
 ### Fixed
 - Support hspec 2.11.
 ## [1.2.0.0] - 2023-02-28
 ### Added
 - Schema printing.
 - `Semigroup` and `Monoid` instances for `AST.Document.Description`.
 - Support for vector 0.13.0.0 and transformers 0.6.1.0.
 ### Fixed
 - Fix resolvers returning a list in the reverse order.
 ### Removed
 - GHC 8 support.
 - Cabal -json flag.
 - `Test.Hspec.GraphQL`: moved to `graphql-spice` package.
 - CPP `ifdef WITH_JSON` blocks.
 ## [1.1.0.0] - 2022-12-24
 ### Changed
 - Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,
  `singleError`.
 - Deprecate `Resolution`, `CollectErrsT` and `runCollectErrs` in the `Error`
  module. It was already noted in the documentation that these symbols are
  deprecated, now a pragma is added.
 - `Language.GraphQL`: Added information about the *json* flag and switching to
  *graphql-spice* for JSON support.
 ### Added
 - Partial schema printing: operation type encoder.
 ## [1.0.3.0] - 2022-03-27
 ### Fixed
 - Index position in error path. (Index and Segment paths of a field have been
  swapped).
 - Parsing empty list as an argument.
 ### Added
 - quickCheck Parser test for arguments. Arbitrary instances for Language.GraphQL.AST.Document.
 - Enhanced query error messages. Add tests for these cases.
 - Allow version 2.0 of the text package.
 ## [1.0.2.0] - 2021-12-26
 ### Added
 - `Serialize` instance for `Type.Definition.Value`.
 - `VariableValue` instance for `Type.Definition.Value`.
 - `Json` build flag, enabled by default. JSON and Aeson support can be disabled
  by disabling this flag.
 ## [1.0.1.0] - 2021-09-27
 ### Added
 - Custom `Show` instance for `Type.Definition.Value` (for error
  messages).
 - Path information in errors (path to the field throwing the error).
 - Deprecation notes in the `Error` module for `Resolution`, `CollectErrsT` and
  `runCollectErrs`. These symbols are part of the old executor and aren't used
  anymore, it will be deprecated in the future and removed.
 - `TH` module with the `gql` quasi quoter.
 ### Fixed
 - Error messages are more concrete, they also contain type information and
  wrong values, where appropriate and possible.
 - If the field with an error is Non-Nullable, the error is propagated to the
  first nullable field, as required by the specification.
 ## [1.0.0.0] - 2021-07-04
 ### Added
 - `Language.GraphQL.Execute.OrderedMap` is a map data structure, that preserves
  insertion order.
 - `Language.GraphQL.Schema.schemaWithTypes` constructs a complete schema,
  including an optional schema description and user-defined types not referenced
  in the schema directly (for example interface implementations).
 - `Language.GraphQL.Schema.description` returns the optional schema description.
 - All errors that can be associated with a location in the query contain
  location information.
 ### Fixed
 - Parser now accepts empty lists and objects.
 - Parser now accepts all directive locations.
 - `valuesOfCorrectTypeRule` doesn't check lists recursively since the
  validation traverser calls it on all list items.
 - `valuesOfCorrectTypeRule` doesn't check objects recursively since the
  validation traverser calls it on all object properties.
 - Validation of non-nullable values inside lists.
 - `executeField` shouldn't assume that a selection has only one field with a
  given name, but it should take the first field. The underlying cause is a
  wrong pattern, which (because of the laziness) is executed only if the field
  has arguments.
 ### Changed
 - `AST.Document.Value.List` and `AST.Document.ConstValue.ConstList` contain
  location information for each list item.
 - `Error`: `singleError`, `addErr` and `addErrMsg` are deprecated. They are
  internal functions used by the executor for error handling.
 ## [0.11.1.0] - 2021-02-07
 ### Added
 - `Validate.Rules`:
  - `overlappingFieldsCanBeMergedRule`
  - `possibleFragmentSpreadsRule`
  - `variablesInAllowedPositionRule`
  - `valuesOfCorrectTypeRule`
 - `Type.Schema.implementations` contains a map from interfaces and objects to
  interfaces they implement.
 - Show instances for GraphQL type definitions in the `Type` modules.
 - Custom Show instances for type and value representations in the AST.
 - `AST.Document.escape` escapes a single character in a `StringValue`.
 ## [0.11.0.0] - 2020-11-07
 ### Changed
 - `AST.Document.Selection` wraps additional new types: `Field`, `FragmentSpread`
  and  `InlineFragment`. Thus validation rules can be defined more concise.
 - `AST.Document`: `Argument` and `Directive` contain token location.
 - `AST.Document.Argument` contains the `Value` wrapped in the `Node`.
 - `AST.Lexer.colon` and `AST.Lexer.at` ignore the result (it is always the
 - same).
 - `Validate.Validation`: `Validation.rules` was removed. `Validation.rules`
  contained the list of rules, but the executed rules shouldn't know about other
  rules. `rules` was a part of the `Validation` context to pass it easier
  around, but since the rules are traversed once now and applied to all nodes in
  the tree at the beginning, it isn't required anymore.
 - `Validate.Validation.Error`: `path` is removed since it isn't possible to get
  the path without executing the query.
 - `Error.Error`: `path` added. It is currently always empty.
 - `Validate.Validation.Path` was moved to `Error`.
 - `Type.Schema.Schema`: data constructor is hidden, fields are accessible with
  freestanding functions: `query`, `mutation`, `subscription`, `directives` and
  `types`.
 ### Added
 - `Validate.Validation.Rule` constructors:
  - `SelectionRule`
  - `FragmentRule`
  - `FragmentSpreadRule`
  - `ArgumentsRule`
  - `DirectivesRule`
  - `VariablesRule`
  - `FieldRule`
 - `Validate.Rules`:
  - `fragmentsOnCompositeTypesRule`
  - `fragmentSpreadTargetDefinedRule`
  - `fragmentSpreadTypeExistenceRule`
  - `noUnusedFragmentsRule`
  - `noFragmentCyclesRule`
  - `uniqueArgumentNamesRule`
  - `uniqueDirectiveNamesRule`
  - `uniqueVariableNamesRule`
  - `variablesAreInputTypesRule`
  - `noUndefinedVariablesRule`
  - `noUndefinedVariablesRule`
  - `noUnusedVariablesRule`
  - `uniqueInputFieldNamesRule`
  - `fieldsOnCorrectTypeRule`
  - `scalarLeafsRule`
  - `knownArgumentNamesRule`
  - `knownDirectiveNamesRule`
  - `directivesInValidLocationsRule`
  - `providedRequiredArgumentsRule`
  - `providedRequiredInputFieldsRule`
 - `AST.Document.Field`.
 - `AST.Document.FragmentSpread`.
 - `AST.Document.InlineFragment`.
 - `AST.Document.Node`.
 - `Type.In.Arguments`: Type alias for an argument map.
 - `Type.Schema.Directive` and `Type.Schema.Directives` are directive definition
  representation.
 - `Type.Schema.schema`: Schema constructor.
 ### Fixed
 - Collecting existing types from the schema considers subscriptions.
 ### Removed
 - `AST.Document.Alias`. Use `AST.Document.Name` instead.
 ## [0.10.0.0] - 2020-08-29
 ### Changed
 - `Test.Hspec.GraphQL.*`: replace `IO` in the resolver with any `MonadCatch`.
 - The `Location` argument of `AST.Document.Definition.ExecutableDefinition` was
  moved to `OperationDefinition` and `FragmentDefinition` since these are the
  actual elements that have a location in the document.
 - `Validate.Rules` get the whole validation context (AST and schema).
 ### Added
 - `Validate.Validation` contains data structures and functions used by the
  validator and concretet rules.
 - `Validate.Rules`: operation validation rules.
 ## [0.9.0.0] - 2020-07-24
 ### 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.
 - `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.
 - `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
  specification defines default values as `Value` with `const` parameter and
  constants cannot be variables. `AST.Document.ConstValue` was added,
  `AST.Document.ObjectField` was modified.
 - AST transformation should never fail.
    * Arguments and fields with a missing variable as value should be left out.
    * Invalid (recusrive or non-existing) fragments should be skipped.
 - Argument value coercion.
 - Variable value coercion.
 - Result coercion.
 - The executor should skip the fields missing in the object type and not fail.
 - Merging subselections.
 ### Changed
 - `Schema.Resolver` was moved to `Type.Out`, it is a field and resolver function
  pair.
 - `AST.Core.Value` was moved into `Type.Definition`. These values are used only
  in the execution and type system, it is not a part of the parsing tree.
 - `Type` module is superseded by `Type.Out`. This module contains now only
  exports from other module that complete `Type.In` and `Type.Out` exports.
 - `Error.CollectErrsT` contains the new `Resolution` data structure.
  `Resolution` represents the state used by the executor. It contains all types
  defined in the schema and collects the thrown errors.
 ### Added
 - `Type.Definition` contains base type system definition, e.g. Enums and
  Scalars.
 - `Type.Schema` describes a schema. Both public functions that execute queries
  accept a `Schema` now instead of a `HashMap`. The execution fails if the root
  operation doesn't match the root Query type in the schema.
 - `Type.In` and `Type.Out` contain definitions for input and output types.
 - `Execute.Coerce` defines a typeclass responsible for input, variable value
  coercion. It decouples us a bit from JSON since any format can be used to pass
  query variables. Execution functions accept (`HashMap Name a`) instead of
  `Subs`, where a is an instance of `VariableValue`.
 ### Removed
 - `Schema.scalar`, `Schema.wrappedScalar`. They accepted everything can be
  converted to JSON and JSON is not suitable as an internal representation for
  GraphQL. E.g. GraphQL distinguishes between Floats and Integers.
 - `Schema.wrappedObject`, `Schema.object`, `Schema.resolversToMap`. There is no
  need in special functions to construct field resolvers anymore, resolvers are
  normal functions attached to the fields in the schema representation.
 - `Schema.resolve` is superseded by `Execute.Execution`.
 - `Error.runAppendErrs` isn't used anywhere.
 - `AST.Core`: `Document`, `Directive`, `Field`, `Fragment`, `Selection`, `Alias`
  `TypeCondition` were modified, moved into `Execute.Transform.Document` and
  made private. These types describe intermediate representation used by the
  executor internally. Moving was required to avoid cyclic dependencies between
  the executor and type system.
 - `AST.Core` doesn't reexports anything.
 ## [0.7.0.0] - 2020-05-11
 ### Fixed
 - Result of null encoding
 - Block strings encoding
 - Result of tab and newline encoding
 ### Added
 - AST for the GraphQL schema.
 - Type system definition parser.
 - `Trans.argument`.
 - Schema extension parser.
 - Contributing guidelines.
 - `Schema.resolversToMap` (intended to be used internally).
 ### Changed
 - Rename `AST.Definition` into `AST.Document.ExecutableDefinition`.
  `AST.Document.TypeSystemDefinition` and `AST.Document.TypeSystemExtension`
  can also be definitions.
 - Move all AST data to `AST.Document` and reexport them.
 - Rename `AST.OperationSelectionSet` to `AST.Document.SelectionSet`.
 - Make `Schema.Subs` a `Data.HashMap.Strict` (was a function
  `key -> Maybe value` before).
 - Make `AST.Lexer.at` a text (symbol) parser. It was a char before and is
  `symbol "@"` now.
 - Replace `MonadIO` with a plain `Monad`. Since the tests don't use IO,
  set the inner monad to `Identity`.
 - `NonEmpty (Resolver m)` is now `HashMap Text (NonEmpty (Resolver m))`. Root
  operation type can be any type, therefore a hashmap is needed. Since types
  cannot be empty, we save the list of resolvers in the type as a non-empty
  list. Currently only "Query" and "Mutation" are supported as types. For more
  schema support is required. The executor checks now if the type in the query
  matches the type of the provided root resolvers.
 ### Removed
 - `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
  These types are only used in `AST.Selection` and `AST.Selection` contains now
  3 corresponding data constructors, `Field`, `InlineFragment` and
  `FragmentSpread`, instead of separate types. It simplifies pattern matching
  and doesn't make the code less typesafe.
 - `Schema.scalarA`.
 - `Schema.wrappedScalarA`.
 - `Schema.wrappedObjectA`.
 - `Schema.objectA`.
 - `AST.Argument`. Replaced with `AST.Arguments` which holds all arguments as a
  key/value map.
 ## [0.6.1.0] - 2019-12-23
 ### Fixed
 - Parsing multiple string arguments, such as
@ -57,7 +438,6 @@ All notable changes to this project will be documented in this file.
 - `Language.GraphQL.Schema`: `enum`, `enumA`, `wrappedEnum` and `wrappedEnumA`.
  Use `scalar`, `scalarA`, `wrappedScalar` and `wrappedScalarA` instead.
 ## [0.5.1.0] - 2019-10-22
 ### Deprecated
 - `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
@ -162,12 +542,30 @@ All notable changes to this project will be documented in this file.
 ### Added
 - Data types for the GraphQL language.
-[0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
+[Unreleased]: https://git.caraus.tech/OSS/graphql/compare/v1.4.0.0...master
-[0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
+[1.4.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.3.0.0...v1.4.0.0
-[0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0
+[1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0
-[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
+[1.2.0.3]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.2...v1.2.0.3
-[0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0
+[1.2.0.2]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...v1.2.0.2
-[0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
+[1.2.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.0...v1.2.0.1
-[0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
+[1.2.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.1.0.0...v1.2.0.0
-[0.2.1]: https://github.com/caraus-ecms/graphql/compare/v0.2...v0.2.1
+[1.1.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.3.0...v1.1.0.0
-[0.2]: https://github.com/caraus-ecms/graphql/compare/v0.1...v0.2
+[1.0.3.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.2.0...v1.0.3.0
 [1.0.2.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.1.0...v1.0.2.0
 [1.0.1.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.0.0...v1.0.1.0
 [1.0.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.11.1.0...v1.0.0.0
 [0.11.1.0]: https://git.caraus.tech/OSS/graphql/compare/v0.11.0.0...v0.11.1.0
 [0.11.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.10.0.0...v0.11.0.0
 [0.10.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.9.0.0...v0.10.0.0
 [0.9.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.8.0.0...v0.9.0.0
 [0.8.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.7.0.0...v0.8.0.0
 [0.7.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.6.1.0...v0.7.0.0
 [0.6.1.0]: https://git.caraus.tech/OSS/graphql/compare/v0.6.0.0...v0.6.1.0
 [0.6.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.5.1.0...v0.6.0.0
 [0.5.1.0]: https://git.caraus.tech/OSS/graphql/compare/v0.5.0.1...v0.5.1.0
 [0.5.0.1]: https://git.caraus.tech/OSS/graphql/compare/v0.5.0.0...v0.5.0.1
 [0.5.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.4.0.0...v0.5.0.0
 [0.4.0.0]: https://git.caraus.tech/OSS/graphql/compare/v0.3...v0.4.0.0
 [0.3]: https://git.caraus.tech/OSS/graphql/compare/v0.2.1...v0.3
 [0.2.1]: https://git.caraus.tech/OSS/graphql/compare/v0.2...v0.2.1
 [0.2]: https://git.caraus.tech/OSS/graphql/compare/v0.1...v0.2
--- a/2
+++ b/2
@ -1,4 +1,4 @@
-Copyright 2019 Eugen Wissner, Germany
+Copyright 2019-2020 Eugen Wissner, Germany
 Copyright 2015-2017 J. Daniel Navarro
 All rights reserved.
--- a/LICENSE.MPL
+++ b/LICENSE.MPL
@ -0,0 +1,373 @@
 Mozilla Public License Version 2.0
 ==================================
 1. Definitions
 --------------
 1.1. "Contributor"
    means each individual or legal entity that creates, contributes to
    the creation of, or owns Covered Software.
 1.2. "Contributor Version"
    means the combination of the Contributions of others (if any) used
    by a Contributor and that particular Contributor's Contribution.
 1.3. "Contribution"
    means Covered Software of a particular Contributor.
 1.4. "Covered Software"
    means Source Code Form to which the initial Contributor has attached
    the notice in Exhibit A, the Executable Form of such Source Code
    Form, and Modifications of such Source Code Form, in each case
    including portions thereof.
 1.5. "Incompatible With Secondary Licenses"
    means
    (a) that the initial Contributor has attached the notice described
        in Exhibit B to the Covered Software; or
    (b) that the Covered Software was made available under the terms of
        version 1.1 or earlier of the License, but not also under the
        terms of a Secondary License.
 1.6. "Executable Form"
    means any form of the work other than Source Code Form.
 1.7. "Larger Work"
    means a work that combines Covered Software with other material, in
    a separate file or files, that is not Covered Software.
 1.8. "License"
    means this document.
 1.9. "Licensable"
    means having the right to grant, to the maximum extent possible,
    whether at the time of the initial grant or subsequently, any and
    all of the rights conveyed by this License.
 1.10. "Modifications"
    means any of the following:
    (a) any file in Source Code Form that results from an addition to,
        deletion from, or modification of the contents of Covered
        Software; or
    (b) any new file in Source Code Form that contains any Covered
        Software.
 1.11. "Patent Claims" of a Contributor
    means any patent claim(s), including without limitation, method,
    process, and apparatus claims, in any patent Licensable by such
    Contributor that would be infringed, but for the grant of the
    License, by the making, using, selling, offering for sale, having
    made, import, or transfer of either its Contributions or its
    Contributor Version.
 1.12. "Secondary License"
    means either the GNU General Public License, Version 2.0, the GNU
    Lesser General Public License, Version 2.1, the GNU Affero General
    Public License, Version 3.0, or any later versions of those
    licenses.
 1.13. "Source Code Form"
    means the form of the work preferred for making modifications.
 1.14. "You" (or "Your")
    means an individual or a legal entity exercising rights under this
    License. For legal entities, "You" includes any entity that
    controls, is controlled by, or is under common control with You. For
    purposes of this definition, "control" means (a) the power, direct
    or indirect, to cause the direction or management of such entity,
    whether by contract or otherwise, or (b) ownership of more than
    fifty percent (50%) of the outstanding shares or beneficial
    ownership of such entity.
 2. License Grants and Conditions
 --------------------------------
 2.1. Grants
 Each Contributor hereby grants You a world-wide, royalty-free,
 non-exclusive license:
 (a) under intellectual property rights (other than patent or trademark)
    Licensable by such Contributor to use, reproduce, make available,
    modify, display, perform, distribute, and otherwise exploit its
    Contributions, either on an unmodified basis, with Modifications, or
    as part of a Larger Work; and
 (b) under Patent Claims of such Contributor to make, use, sell, offer
    for sale, have made, import, and otherwise transfer either its
    Contributions or its Contributor Version.
 2.2. Effective Date
 The licenses granted in Section 2.1 with respect to any Contribution
 become effective for each Contribution on the date the Contributor first
 distributes such Contribution.
 2.3. Limitations on Grant Scope
 The licenses granted in this Section 2 are the only rights granted under
 this License. No additional rights or licenses will be implied from the
 distribution or licensing of Covered Software under this License.
 Notwithstanding Section 2.1(b) above, no patent license is granted by a
 Contributor:
 (a) for any code that a Contributor has removed from Covered Software;
    or
 (b) for infringements caused by: (i) Your and any other third party's
    modifications of Covered Software, or (ii) the combination of its
    Contributions with other software (except as part of its Contributor
    Version); or
 (c) under Patent Claims infringed by Covered Software in the absence of
    its Contributions.
 This License does not grant any rights in the trademarks, service marks,
 or logos of any Contributor (except as may be necessary to comply with
 the notice requirements in Section 3.4).
 2.4. Subsequent Licenses
 No Contributor makes additional grants as a result of Your choice to
 distribute the Covered Software under a subsequent version of this
 License (see Section 10.2) or under the terms of a Secondary License (if
 permitted under the terms of Section 3.3).
 2.5. Representation
 Each Contributor represents that the Contributor believes its
 Contributions are its original creation(s) or it has sufficient rights
 to grant the rights to its Contributions conveyed by this License.
 2.6. Fair Use
 This License is not intended to limit any rights You have under
 applicable copyright doctrines of fair use, fair dealing, or other
 equivalents.
 2.7. Conditions
 Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
 in Section 2.1.
 3. Responsibilities
 -------------------
 3.1. Distribution of Source Form
 All distribution of Covered Software in Source Code Form, including any
 Modifications that You create or to which You contribute, must be under
 the terms of this License. You must inform recipients that the Source
 Code Form of the Covered Software is governed by the terms of this
 License, and how they can obtain a copy of this License. You may not
 attempt to alter or restrict the recipients' rights in the Source Code
 Form.
 3.2. Distribution of Executable Form
 If You distribute Covered Software in Executable Form then:
 (a) such Covered Software must also be made available in Source Code
    Form, as described in Section 3.1, and You must inform recipients of
    the Executable Form how they can obtain a copy of such Source Code
    Form by reasonable means in a timely manner, at a charge no more
    than the cost of distribution to the recipient; and
 (b) You may distribute such Executable Form under the terms of this
    License, or sublicense it under different terms, provided that the
    license for the Executable Form does not attempt to limit or alter
    the recipients' rights in the Source Code Form under this License.
 3.3. Distribution of a Larger Work
 You may create and distribute a Larger Work under terms of Your choice,
 provided that You also comply with the requirements of this License for
 the Covered Software. If the Larger Work is a combination of Covered
 Software with a work governed by one or more Secondary Licenses, and the
 Covered Software is not Incompatible With Secondary Licenses, this
 License permits You to additionally distribute such Covered Software
 under the terms of such Secondary License(s), so that the recipient of
 the Larger Work may, at their option, further distribute the Covered
 Software under the terms of either this License or such Secondary
 License(s).
 3.4. Notices
 You may not remove or alter the substance of any license notices
 (including copyright notices, patent notices, disclaimers of warranty,
 or limitations of liability) contained within the Source Code Form of
 the Covered Software, except that You may alter any license notices to
 the extent required to remedy known factual inaccuracies.
 3.5. Application of Additional Terms
 You may choose to offer, and to charge a fee for, warranty, support,
 indemnity or liability obligations to one or more recipients of Covered
 Software. However, You may do so only on Your own behalf, and not on
 behalf of any Contributor. You must make it absolutely clear that any
 such warranty, support, indemnity, or liability obligation is offered by
 You alone, and You hereby agree to indemnify every Contributor for any
 liability incurred by such Contributor as a result of warranty, support,
 indemnity or liability terms You offer. You may include additional
 disclaimers of warranty and limitations of liability specific to any
 jurisdiction.
 4. Inability to Comply Due to Statute or Regulation
 ---------------------------------------------------
 If it is impossible for You to comply with any of the terms of this
 License with respect to some or all of the Covered Software due to
 statute, judicial order, or regulation then You must: (a) comply with
 the terms of this License to the maximum extent possible; and (b)
 describe the limitations and the code they affect. Such description must
 be placed in a text file included with all distributions of the Covered
 Software under this License. Except to the extent prohibited by statute
 or regulation, such description must be sufficiently detailed for a
 recipient of ordinary skill to be able to understand it.
 5. Termination
 --------------
 5.1. The rights granted under this License will terminate automatically
 if You fail to comply with any of its terms. However, if You become
 compliant, then the rights granted under this License from a particular
 Contributor are reinstated (a) provisionally, unless and until such
 Contributor explicitly and finally terminates Your grants, and (b) on an
 ongoing basis, if such Contributor fails to notify You of the
 non-compliance by some reasonable means prior to 60 days after You have
 come back into compliance. Moreover, Your grants from a particular
 Contributor are reinstated on an ongoing basis if such Contributor
 notifies You of the non-compliance by some reasonable means, this is the
 first time You have received notice of non-compliance with this License
 from such Contributor, and You become compliant prior to 30 days after
 Your receipt of the notice.
 5.2. If You initiate litigation against any entity by asserting a patent
 infringement claim (excluding declaratory judgment actions,
 counter-claims, and cross-claims) alleging that a Contributor Version
 directly or indirectly infringes any patent, then the rights granted to
 You by any and all Contributors for the Covered Software under Section
 2.1 of this License shall terminate.
 5.3. In the event of termination under Sections 5.1 or 5.2 above, all
 end user license agreements (excluding distributors and resellers) which
 have been validly granted by You or Your distributors under this License
 prior to termination shall survive termination.
 ************************************************************************
 *                                                                      *
 *  6. Disclaimer of Warranty                                           *
 *  -------------------------                                           *
 *                                                                      *
 *  Covered Software is provided under this License on an "as is"       *
 *  basis, without warranty of any kind, either expressed, implied, or  *
 *  statutory, including, without limitation, warranties that the       *
 *  Covered Software is free of defects, merchantable, fit for a        *
 *  particular purpose or non-infringing. The entire risk as to the     *
 *  quality and performance of the Covered Software is with You.        *
 *  Should any Covered Software prove defective in any respect, You     *
 *  (not any Contributor) assume the cost of any necessary servicing,   *
 *  repair, or correction. This disclaimer of warranty constitutes an   *
 *  essential part of this License. No use of any Covered Software is   *
 *  authorized under this License except under this disclaimer.         *
 *                                                                      *
 ************************************************************************
 ************************************************************************
 *                                                                      *
 *  7. Limitation of Liability                                          *
 *  --------------------------                                          *
 *                                                                      *
 *  Under no circumstances and under no legal theory, whether tort      *
 *  (including negligence), contract, or otherwise, shall any           *
 *  Contributor, or anyone who distributes Covered Software as          *
 *  permitted above, be liable to You for any direct, indirect,         *
 *  special, incidental, or consequential damages of any character      *
 *  including, without limitation, damages for lost profits, loss of    *
 *  goodwill, work stoppage, computer failure or malfunction, or any    *
 *  and all other commercial damages or losses, even if such party      *
 *  shall have been informed of the possibility of such damages. This   *
 *  limitation of liability shall not apply to liability for death or   *
 *  personal injury resulting from such party's negligence to the       *
 *  extent applicable law prohibits such limitation. Some               *
 *  jurisdictions do not allow the exclusion or limitation of           *
 *  incidental or consequential damages, so this exclusion and          *
 *  limitation may not apply to You.                                    *
 *                                                                      *
 ************************************************************************
 8. Litigation
 -------------
 Any litigation relating to this License may be brought only in the
 courts of a jurisdiction where the defendant maintains its principal
 place of business and such litigation shall be governed by laws of that
 jurisdiction, without reference to its conflict-of-law provisions.
 Nothing in this Section shall prevent a party's ability to bring
 cross-claims or counter-claims.
 9. Miscellaneous
 ----------------
 This License represents the complete agreement concerning the subject
 matter hereof. If any provision of this License is held to be
 unenforceable, such provision shall be reformed only to the extent
 necessary to make it enforceable. Any law or regulation which provides
 that the language of a contract shall be construed against the drafter
 shall not be used to construe this License against a Contributor.
 10. Versions of the License
 ---------------------------
 10.1. New Versions
 Mozilla Foundation is the license steward. Except as provided in Section
 10.3, no one other than the license steward has the right to modify or
 publish new versions of this License. Each version will be given a
 distinguishing version number.
 10.2. Effect of New Versions
 You may distribute the Covered Software under the terms of the version
 of the License under which You originally received the Covered Software,
 or under the terms of any subsequent version published by the license
 steward.
 10.3. Modified Versions
 If you create software not governed by this License, and you want to
 create a new license for such software, you may create and use a
 modified version of this License if you rename the license and remove
 any references to the name of the license steward (except to note that
 such modified license differs from this License).
 10.4. Distributing Source Code Form that is Incompatible With Secondary
 Licenses
 If You choose to distribute Source Code Form that is Incompatible With
 Secondary Licenses under the terms of this version of the License, the
 notice described in Exhibit B of this License must be attached.
 Exhibit A - Source Code Form License Notice
 -------------------------------------------
  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 http://mozilla.org/MPL/2.0/.
 If it is not possible or desirable to put the notice in a particular
 file, then You may include the notice in a location (such as a LICENSE
 file in a relevant directory) where a recipient would be likely to look
 for such a notice.
 You may add additional accurate notices of copyright ownership.
 Exhibit B - "Incompatible With Secondary Licenses" Notice
 ---------------------------------------------------------
  This Source Code Form is "Incompatible With Secondary Licenses", as
  defined by the Mozilla Public License, v. 2.0.
--- a/README.md
+++ b/README.md
@ -1,41 +1,12 @@
-# Haskell GraphQL
+# GraphQL implementation in Haskell
-[![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql)
+See https://git.caraus.tech/OSS/graphql.
 [![Build Status](https://semaphoreci.com/api/v1/belka-ew/graphql/branches/master/badge.svg)](https://semaphoreci.com/belka-ew/graphql)
 [![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.
+Report issues on the
-
+[bug tracker](https://git.caraus.tech/OSS/graphql/issues).
 This implementation is relatively low-level by design, it doesn't provide any
 mappings between the GraphQL types and Haskell's type system and avoids
 compile-time magic. It focuses on flexibility instead, so other solutions can
 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
 [`graphql-js`](https://github.com/graphql/graphql-js).
 For the list of currently missing features see issues marked as
 "[not implemented](https://github.com/caraus-ecms/graphql/labels/not%20implemented)".
 ## Documentation
 API documentation is available through
-[hackage](https://hackage.haskell.org/package/graphql).
+[Hackage](https://hackage.haskell.org/package/graphql).
-You'll also find a small tutorial with some examples under
+Further documentation will be made available in the
-[docs/tutorial](https://github.com/caraus-ecms/graphql/tree/master/docs/tutorial).
+[Wiki](https://git.caraus.tech/OSS/graphql/wiki).
 ## Contact
 Suggestions, contributions and bug reports are welcome.
 Should you have questions on usage, please open an issue and ask – this helps
 to write useful documentation.
 Feel free to contact on Slack in [#haskell on
 GraphQL](https://graphql.slack.com/messages/haskell/). You can obtain an
 invitation [here](https://graphql-slack.herokuapp.com/).
--- a/docs/tutorial/tutorial.lhs
+++ b/docs/tutorial/tutorial.lhs
@ -1,153 +0,0 @@
 ---
 title: GraphQL Haskell Tutorial
 ---
 == Getting started ==
 Welcome to graphql-haskell!
 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.
 > {-# LANGUAGE OverloadedStrings #-}
 > {-# LANGUAGE LambdaCase #-}
 > module Main where
 >
 > import Control.Monad.IO.Class (liftIO)
 > import Control.Monad.Trans.Except (throwE)
 > import Data.Aeson (encode)
 > import Data.ByteString.Lazy.Char8 (putStrLn)
 > import Data.List.NonEmpty (NonEmpty(..))
 > import Data.Text (Text)
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
 > import qualified Language.GraphQL.Schema as Schema
 > import Language.GraphQL.Trans (ActionT(..))
 >
 > 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).
 First we build a GraphQL schema.
 > schema1 :: NonEmpty (Schema.Resolver IO)
 > schema1 = hello :| []
 >
 > hello :: Schema.Resolver IO
 > hello = Schema.scalar "hello" (return ("it's me" :: Text))
 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 = putStrLn =<< encode <$> graphql schema1 query1
 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 :: NonEmpty (Schema.Resolver IO)
 > schema2 = time :| []
 >
 > time :: Schema.Resolver IO
 > time = Schema.scalarA "time" $ \case
 >   [] -> do t <- liftIO getCurrentTime
 >            return $ show t
 >   _ -> ActionT $ throwE "Invalid arguments."
 This defines a simple schema with one type and one field,
 which resolves to the current time.
 Next we define our query.
 > query2 :: Text
 > query2 = "{ time }"
 >
 > main2 :: IO ()
 > main2 = putStrLn =<< encode <$> graphql schema2 query2
 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 :: NonEmpty (Schema.Resolver IO)
 > schema3 = hello :| [time]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
 > main3 = putStrLn =<< encode <$> graphql schema3 query3
 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.
 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.
 > main :: IO ()
 > main = main1 >> main2 >> mainShouldFail >> main3
--- a/graphql.cabal
+++ b/graphql.cabal
@ -0,0 +1,108 @@
 cabal-version: 3.0
 name:           graphql
 version:        1.4.0.0
 synopsis:       Haskell GraphQL implementation
 description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
 category:       Language
 homepage:       https://git.caraus.tech/OSS/graphql
 bug-reports:    https://git.caraus.tech/OSS/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-2024 Eugen Wissner,
                (c) 2015-2017 J. Daniel Navarro
 license:        MPL-2.0 AND BSD-3-Clause
 license-files:  LICENSE,
                LICENSE.MPL
 build-type:     Simple
 extra-source-files:
  CHANGELOG.md
  README.md
 tested-with:
  GHC == 9.8.2
 source-repository head
  type: git
  location: https://git.caraus.tech/OSS/graphql.git
 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.Execute.OrderedMap
    Language.GraphQL.Type
    Language.GraphQL.Type.In
    Language.GraphQL.Type.Out
    Language.GraphQL.Type.Schema
    Language.GraphQL.Validate
    Language.GraphQL.Validate.Validation
  other-modules:
    Language.GraphQL.Execute.Transform
    Language.GraphQL.Type.Definition
    Language.GraphQL.Type.Internal
    Language.GraphQL.Validate.Rules
  hs-source-dirs:
    src
  ghc-options: -Wall
  build-depends:
    base >= 4.15 && < 5,
    conduit ^>= 1.3.4,
    containers >= 0.6 && < 0.8,
    exceptions ^>= 0.10.4,
    megaparsec >= 9.0 && < 10,
    parser-combinators >= 1.3 && < 2,
    text >= 1.2 && < 3,
    transformers >= 0.5.6 && < 0.7,
    unordered-containers ^>= 0.2.14,
    vector >= 0.12 && < 0.14
  default-language: Haskell2010
 test-suite graphql-test
  type: exitcode-stdio-1.0
  main-is: Spec.hs
  other-modules:
    Language.GraphQL.AST.DocumentSpec
    Language.GraphQL.AST.EncoderSpec
    Language.GraphQL.AST.LexerSpec
    Language.GraphQL.AST.ParserSpec
    Language.GraphQL.AST.Arbitrary
    Language.GraphQL.ErrorSpec
    Language.GraphQL.Execute.CoerceSpec
    Language.GraphQL.Execute.OrderedMapSpec
    Language.GraphQL.ExecuteSpec
    Language.GraphQL.Type.OutSpec
    Language.GraphQL.Validate.RulesSpec
    Schemas.HeroSchema
  hs-source-dirs:
    tests
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
  build-depends:
    QuickCheck >= 2.14 && < 2.16,
    base,
    conduit,
    exceptions,
    graphql,
    hspec >= 2.10.9 && < 2.12,
    hspec-expectations ^>= 0.8.2,
    hspec-megaparsec ^>= 2.2.0,
    megaparsec,
    text,
    unordered-containers,
    containers,
    vector
  build-tool-depends:
    hspec-discover:hspec-discover
  default-language: Haskell2010
--- a/package.yaml
+++ b/package.yaml
@ -1,56 +0,0 @@
 name:                graphql
 version:             0.6.1.0
 synopsis:            Haskell GraphQL implementation
 description:
  This package provides a rudimentary parser for the
  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 maintainer:          belka@caraus.de
 github:              caraus-ecms/graphql
 category:            Language
 copyright:
 - (c) 2019 Eugen Wissner
 - (c) 2015-2017 J. Daniel Navarro
 author:
 - Danny Navarro <j@dannynavarro.net>
 - Matthías Páll Gissurarson <mpg@mpg.is>
 - Sólrún Halla Einarsdóttir <she@mpg.is>
 extra-source-files:
 - CHANGELOG.md
 - README.md
 - LICENSE
 - docs/tutorial/tutorial.lhs
 data-files:
 - tests/data/*.graphql
 - tests/data/*.min.graphql
 dependencies:
 - aeson
 - base >= 4.7 && < 5
 - containers
 - megaparsec
 - text
 - transformers
 - unordered-containers
 library:
  source-dirs: src
  other-modules:
  - Language.GraphQL.Execute.Transform
  - Language.GraphQL.Type.Directive
 tests:
  tasty:
    main: Spec.hs
    source-dirs: tests
    ghc-options:
    - -threaded
    - -rtsopts
    - -with-rtsopts=-N
    dependencies:
    - graphql
    - hspec
    - hspec-expectations
    - hspec-megaparsec
    - raw-strings-qq
--- a/semaphoreci.sh
+++ b/semaphoreci.sh
@ -1,35 +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
 	$STACK --no-terminal setup
 }
 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,35 +1,46 @@
 {-# LANGUAGE RecordWildCards #-}
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
    ( graphql
    , graphqlSubs
    ) where
-import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Catch (MonadCatch)
-import qualified Data.Aeson as Aeson
+import Data.HashMap.Strict (HashMap)
-import Data.List.NonEmpty (NonEmpty)
+import qualified Data.Sequence as Seq
-import qualified Data.Text as T
+import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
-import Language.GraphQL.AST.Parser
+import qualified Language.GraphQL.Validate as Validate
-import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type.Schema (Schema)
 import Prelude hiding (null)
 import Text.Megaparsec (parse)
 -- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema.Resolver's.
+-- executed using the given 'Schema'.
-graphql :: MonadIO m
+--
-    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
+-- An operation name can be given if the document contains multiple operations.
-    -> T.Text -- ^ Text representing a @GraphQL@ request document.
+graphql :: (MonadCatch m, VariableValue a, Serialize b)
-    -> m Aeson.Value -- ^ Response.
+    => Schema m -- ^ Resolvers.
-graphql = flip graphqlSubs $ const Nothing
+    -> Maybe Text -- ^ Operation name.
-
+    -> HashMap Full.Name a -- ^ Variable substitution function.
-- | If the text parses correctly as a @GraphQL@ query the substitution is
+    -> Text -- ^ Text representing a @GraphQL@ request document.
-- applied to the query and the query is then executed using to the given
+    -> m (Either (ResponseEventStream m b) (Response b)) -- ^ Response.
-- 'Schema.Resolver's.
+graphql schema operationName variableValues document' =
-graphqlSubs :: MonadIO m
+    case parse Full.document "" document' of
-    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
+        Left errorBundle -> pure  <$> parseError errorBundle
-    -> Schema.Subs -- ^ Variable substitution function.
+        Right parsed ->
-    -> T.Text -- ^ Text representing a @GraphQL@ request document.
+            case validate parsed of
-    -> m Aeson.Value -- ^ Response.
+                Seq.Empty -> execute schema operationName variableValues parsed
-graphqlSubs schema f
+                errors -> pure $ pure
-    = either parseError (execute schema f)
+                    $ Response null
-    . parse document ""
+                    $ fromValidationError <$> errors
  where
    validate = Validate.document schema Validate.specifiedRules
    fromValidationError Validate.Error{..} = Error
        { message = Text.pack message
        , locations = locations
        , path = []
        }
--- a/src/Language/GraphQL/AST.hs
+++ b/src/Language/GraphQL/AST.hs
@ -1,185 +1,10 @@
-- | This module defines an abstract syntax tree for the @GraphQL@ language based on
+{-# LANGUAGE Safe #-}
--   <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
+
--
+-- | Target AST for parser.
 -- Target AST for Parser.
 module Language.GraphQL.AST
-    ( Alias
+    ( module Language.GraphQL.AST.Document
-    , Argument(..)
+    , module Language.GraphQL.AST.Parser
    , Definition(..)
    , Directive(..)
    , Document
    , Field(..)
    , FragmentDefinition(..)
    , FragmentSpread(..)
    , InlineFragment(..)
    , Name
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
    , OperationType(..)
    , Selection(..)
    , SelectionSet
    , SelectionSetOpt
    , Type(..)
    , TypeCondition
    , Value(..)
    , VariableDefinition(..)
    ) where
-import Data.Int (Int32)
+import Language.GraphQL.AST.Document
-import Data.List.NonEmpty (NonEmpty)
+import Language.GraphQL.AST.Parser
 import Data.Text (Text)
 -- * Document
 -- | GraphQL document.
 type Document = NonEmpty Definition
 -- | Name
 type Name = Text
 -- | Directive.
 data Directive = Directive Name [Argument] deriving (Eq, Show)
 -- * Operations
 -- | Top-level definition of a document, either an operation or a fragment.
 data Definition
    = DefinitionOperation OperationDefinition
    | DefinitionFragment FragmentDefinition
    deriving (Eq, Show)
 -- | Operation definition.
 data OperationDefinition
    = OperationSelectionSet SelectionSet
    | OperationDefinition OperationType
                          (Maybe Name)
                          [VariableDefinition]
                          [Directive]
                          SelectionSet
    deriving (Eq, Show)
 -- | GraphQL has 3 operation types: queries, mutations and subscribtions.
 --
 -- Currently only queries and mutations are supported.
 data OperationType = Query | Mutation deriving (Eq, Show)
 -- * Selections
 -- | "Top-level" selection, selection on an operation or fragment.
 type SelectionSet = NonEmpty Selection
 -- | Field selection.
 type SelectionSetOpt = [Selection]
 -- | Single selection element.
 data Selection
    = SelectionField Field
    | SelectionFragmentSpread FragmentSpread
    | SelectionInlineFragment InlineFragment
    deriving (Eq, Show)
 -- * Field
 -- | Single GraphQL field.
 --
 -- The only required property of a field is its name. Optionally it can also
 -- have an alias, arguments or a list of subfields.
 --
 -- Given the following query:
 --
 -- @
 -- {
 --   zuck: user(id: 4) {
 --     id
 --     name
 --   }
 -- }
 -- @
 --
 -- * "user", "id" and "name" are field names.
 -- * "user" has two subfields, "id" and "name".
 -- * "zuck" is an alias for "user". "id" and "name" have no aliases.
 -- * "id: 4" is an argument for "user". "id" and "name" don't have any
 -- arguments.
 data Field
    = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
    deriving (Eq, Show)
 -- | Alternative field name.
 --
 -- @
 -- {
 --   smallPic: profilePic(size: 64)
 --   bigPic: profilePic(size: 1024)
 -- }
 -- @
 --
 -- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
 -- used to distinquish between profile pictures with different arguments
 -- (sizes).
 type Alias = Name
 -- | Single argument.
 --
 -- @
 -- {
 --   user(id: 4) {
 --     name
 --   }
 -- }
 -- @
 --
 --  Here "id" is an argument for the field "user" and its value is 4.
 data Argument = Argument Name Value deriving (Eq,Show)
 -- * Fragments
 -- | Fragment spread.
 data FragmentSpread = FragmentSpread Name [Directive] deriving (Eq, Show)
 -- | Inline fragment.
 data InlineFragment = InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
                      deriving (Eq, Show)
 -- | Fragment definition.
 data FragmentDefinition
    = FragmentDefinition Name TypeCondition [Directive] SelectionSet
    deriving (Eq, Show)
 -- * Inputs
 -- | Input value.
 data Value = Variable Name
           | Int Int32
           | Float Double
           | String Text
           | Boolean Bool
           | Null
           | Enum Name
           | List [Value]
           | Object [ObjectField]
           deriving (Eq, Show)
 -- | Key-value pair.
 --
 -- A list of 'ObjectField's represents a GraphQL object type.
 data ObjectField = ObjectField Name Value deriving (Eq, Show)
 -- | Variable definition.
 data VariableDefinition = VariableDefinition Name Type (Maybe Value)
                          deriving (Eq, Show)
 -- | Type condition.
 type TypeCondition = Name
 -- | Type representation.
 data Type = TypeNamed   Name
          | TypeList    Type
          | TypeNonNull NonNullType
            deriving (Eq, Show)
 -- | Helper type to represent Non-Null types and lists of such types.
 data NonNullType = NonNullTypeNamed Name
                 | NonNullTypeList  Type
                   deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@ -1,76 +0,0 @@
 -- | This is the AST meant to be executed.
 module Language.GraphQL.AST.Core
    ( Alias
    , Argument(..)
    , Arguments(..)
    , Directive(..)
    , Document
    , Field(..)
    , Fragment(..)
    , Name
    , Operation(..)
    , Selection(..)
    , TypeCondition
    , Value(..)
    ) where
 import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Sequence (Seq)
 import Data.String (IsString(..))
 import Data.Text (Text)
 import Language.GraphQL.AST (Alias, Name, TypeCondition)
 -- | GraphQL document is a non-empty list of operations.
 type Document = NonEmpty Operation
 -- | GraphQL has 3 operation types: queries, mutations and subscribtions.
 --
 -- Currently only queries and mutations are supported.
 data Operation
    = Query (Maybe Text) (Seq Selection)
    | Mutation (Maybe Text) (Seq Selection)
    deriving (Eq, Show)
 -- | Single GraphQL field.
 data Field
    = Field (Maybe Alias) Name [Argument] (Seq Selection)
    deriving (Eq, Show)
 -- | Single argument.
 data Argument = Argument Name Value deriving (Eq, Show)
 -- | Argument list.
 newtype Arguments = Arguments (HashMap Name Value)
    deriving (Eq, Show)
 -- | Directive.
 data Directive = Directive Name Arguments
    deriving (Eq, Show)
 -- | Represents fragments and inline fragments.
 data Fragment
    = Fragment TypeCondition (Seq Selection)
    deriving (Eq, Show)
 -- | Single selection element.
 data Selection
    = SelectionFragment Fragment
    | SelectionField Field
    deriving (Eq, Show)
 -- | Represents accordingly typed GraphQL values.
 data Value
    = Int Int32
    | Float Double -- ^ GraphQL Float is double precision
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value]
    | Object (HashMap Name Value)
    deriving (Eq, Show)
 instance IsString Value where
    fromString = String . fromString
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@ -0,0 +1,71 @@
 {-# LANGUAGE Safe #-}
 -- | Various parts of a GraphQL document can be annotated with directives.
 -- This module describes locations in a document where directives can appear.
 module Language.GraphQL.AST.DirectiveLocation
    ( DirectiveLocation(..)
    , ExecutableDirectiveLocation(..)
    , TypeSystemDirectiveLocation(..)
    ) where
 -- | All directives can be splitted in two groups: directives used to annotate
 -- various parts of executable definitions and the ones used in the schema
 -- definition.
 data DirectiveLocation
    = ExecutableDirectiveLocation ExecutableDirectiveLocation
    | TypeSystemDirectiveLocation TypeSystemDirectiveLocation
    deriving Eq
 instance Show DirectiveLocation where
    show (ExecutableDirectiveLocation directiveLocation) =
        show directiveLocation
    show (TypeSystemDirectiveLocation directiveLocation) =
        show directiveLocation
 -- | Where directives can appear in an executable definition, like a query.
 data ExecutableDirectiveLocation
    = Query
    | Mutation
    | Subscription
    | Field
    | FragmentDefinition
    | FragmentSpread
    | InlineFragment
    deriving Eq
 instance Show ExecutableDirectiveLocation where
    show Query = "QUERY"
    show Mutation = "MUTATION"
    show Subscription = "SUBSCRIPTION"
    show Field = "FIELD"
    show FragmentDefinition = "FRAGMENT_DEFINITION"
    show FragmentSpread = "FRAGMENT_SPREAD"
    show InlineFragment = "INLINE_FRAGMENT"
 -- | Where directives can appear in a type system definition.
 data TypeSystemDirectiveLocation
    = Schema
    | Scalar
    | Object
    | FieldDefinition
    | ArgumentDefinition
    | Interface
    | Union
    | Enum
    | EnumValue
    | InputObject
    | InputFieldDefinition
    deriving Eq
 instance Show TypeSystemDirectiveLocation where
    show Schema = "SCHEMA"
    show Scalar = "SCALAR"
    show Object = "OBJECT"
    show FieldDefinition = "FIELD_DEFINITION"
    show ArgumentDefinition = "ARGUMENT_DEFINITION"
    show Interface = "INTERFACE"
    show Union = "UNION"
    show Enum = "ENUM"
    show EnumValue = "ENUM_VALUE"
    show InputObject = "INPUT_OBJECT"
    show InputFieldDefinition = "INPUT_FIELD_DEFINITION"
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@ -0,0 +1,630 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE Safe #-}
 -- | This module defines an abstract syntax tree for the @GraphQL@ language. It
 -- follows closely the structure given in the specification. Please refer to
 -- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
 -- for more information.
 module Language.GraphQL.AST.Document
    ( Argument(..)
    , ArgumentsDefinition(..)
    , ConstValue(..)
    , Definition(..)
    , Description(..)
    , Directive(..)
    , Document
    , EnumValueDefinition(..)
    , ExecutableDefinition(..)
    , Field(..)
    , FieldDefinition(..)
    , FragmentDefinition(..)
    , FragmentSpread(..)
    , ImplementsInterfaces(..)
    , InlineFragment(..)
    , InputValueDefinition(..)
    , Location(..)
    , Name
    , NamedType
    , Node(..)
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
    , OperationType(..)
    , OperationTypeDefinition(..)
    , SchemaExtension(..)
    , Selection(..)
    , SelectionSet
    , SelectionSetOpt
    , Type(..)
    , TypeCondition
    , TypeDefinition(..)
    , TypeExtension(..)
    , TypeSystemDefinition(..)
    , TypeSystemExtension(..)
    , UnionMemberTypes(..)
    , Value(..)
    , VariableDefinition(..)
    , escape
    , showVariableName
    , showVariable
    ) where
 import Data.Char (ord)
 import Data.Foldable (toList)
 import Data.Int (Int32)
 import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty)
 import Numeric (showFloat, showHex)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
 -- * Language
 -- ** Source Text
 -- | Name.
 type Name = Text
 -- | Error location, line and column.
 data Location = Location
    { line :: Word
    , column :: Word
    } deriving (Eq, Show)
 instance Ord Location where
    compare (Location thisLine thisColumn) (Location thatLine thatColumn)
        | thisLine < thatLine = LT
        | thisLine > thatLine = GT
        | otherwise = compare thisColumn thatColumn
 -- | Contains some tree node with a location.
 data Node a = Node
    { node :: a
    , location :: Location
    } deriving Eq
 instance Show a => Show (Node a) where
    show Node{ node } = show node
 instance Functor Node where
    fmap f Node{..} = Node (f node) location
 -- ** Document
 -- | GraphQL document.
 type Document = NonEmpty Definition
 -- | All kinds of definitions that can occur in a GraphQL document.
 data Definition
    = ExecutableDefinition ExecutableDefinition
    | TypeSystemDefinition TypeSystemDefinition Location
    | TypeSystemExtension TypeSystemExtension Location
    deriving (Eq, Show)
 -- | Top-level definition of a document, either an operation or a fragment.
 data ExecutableDefinition
    = DefinitionOperation OperationDefinition
    | DefinitionFragment FragmentDefinition
    deriving (Eq, Show)
 -- ** Operations
 -- | Operation definition.
 data OperationDefinition
    = SelectionSet SelectionSet Location
    | OperationDefinition
        OperationType
        (Maybe Name)
        [VariableDefinition]
        [Directive]
        SelectionSet
        Location
    deriving (Eq, Show)
 -- | GraphQL has 3 operation types:
 --
 -- * query - a read-only fetch.
 -- * mutation - a write operation followed by a fetch.
 -- * subscription - a long-lived request that fetches data in response to
 -- source events.
 data OperationType = Query | Mutation | Subscription deriving (Eq, Show)
 -- ** Selection Sets
 -- | "Top-level" selection, selection on an operation or fragment.
 type SelectionSet = NonEmpty Selection
 -- | Field selection.
 type SelectionSetOpt = [Selection]
 -- | Selection is a single entry in a selection set. It can be a single 'Field',
 -- 'FragmentSpread' or an 'InlineFragment'.
 data Selection
    = FieldSelection Field
    | FragmentSpreadSelection FragmentSpread
    | InlineFragmentSelection InlineFragment
    deriving (Eq, Show)
 -- | The only required property of a field is its name. Optionally it can also
 -- have an alias, arguments, directives and a list of subfields.
 --
 -- In the following query "user" is a field with two subfields, "id" and "name":
 --
 -- @
 -- {
 --   user {
 --     id
 --     name
 --   }
 -- }
 -- @
 data Field =
    Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location
    deriving (Eq, Show)
 -- | Inline fragments don't have any name and the type condition ("on UserType")
 -- is optional.
 --
 -- @
 -- {
 --   user {
 --     ... on UserType {
 --       id
 --       name
 --     }
 -- }
 -- @
 data InlineFragment = InlineFragment
    (Maybe TypeCondition) [Directive] SelectionSet Location
    deriving (Eq, Show)
 -- | A fragment spread refers to a fragment defined outside the operation and is
 -- expanded at the execution time.
 --
 -- @
 -- {
 --   user {
 --     ...userFragment
 --   }
 -- }
 --
 -- fragment userFragment on UserType {
 --   id
 --   name
 -- }
 -- @
 data FragmentSpread = FragmentSpread Name [Directive] Location
    deriving (Eq, Show)
 -- ** Arguments
 -- | Single argument.
 --
 -- @
 -- {
 --   user(id: 4) {
 --     name
 --   }
 -- }
 -- @
 --
 --  Here "id" is an argument for the field "user" and its value is 4.
 data Argument = Argument Name (Node Value) Location deriving (Eq, Show)
 -- ** Fragments
 -- | Fragment definition.
 data FragmentDefinition
    = FragmentDefinition Name TypeCondition [Directive] SelectionSet Location
    deriving (Eq, Show)
 -- | Type condition.
 type TypeCondition = Name
 -- ** Input Values
 -- | Escapes a single character according to the GraphQL escaping rules for
 -- double-quoted string values.
 --
 -- Characters, that should be escaped, are written as escaped characters with a
 -- backslash or Unicode with an \"\\u\". Other characters are returned as
 -- strings.
 escape :: Char -> String
 escape char'
    | char' == '\\' = "\\\\"
    | char' == '\"' = "\\\""
    | char' == '\b' = "\\b"
    | char' == '\f' = "\\f"
    | char' == '\n' = "\\n"
    | char' == '\r' = "\\r"
    | char' == '\t' = "\\t"
    | char' < '\x0010' = unicode  "\\u000" char'
    | char' < '\x0020' = unicode "\\u00" char'
    | otherwise = [char']
  where
    unicode prefix uchar = prefix <> (showHex $ ord uchar) ""
 showList' :: Show a => [a] -> String
 showList' list = "[" ++ intercalate ", " (show <$> list) ++ "]"
 showObject :: Show a => [ObjectField a] -> String
 showObject fields =
    "{ " ++ intercalate ", " (show <$> fields) ++ " }"
 -- | Input value (literal or variable).
 data Value
    = Variable Name
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Node Value]
    | Object [ObjectField Value]
    deriving Eq
 instance Show Value where
    showList = mappend . showList'
    show (Variable variableName) = '$' : Text.unpack variableName
    show (Int integer) = show integer
    show (Float float) = show $ ConstFloat float
    show (String text) = show $  ConstString text
    show (Boolean boolean) = show boolean
    show Null = "null"
    show (Enum name) = Text.unpack name
    show (List list) = show list
    show (Object fields) = showObject fields
 -- | Constant input value.
 data ConstValue
    = ConstInt Int32
    | ConstFloat Double
    | ConstString Text
    | ConstBoolean Bool
    | ConstNull
    | ConstEnum Name
    | ConstList [Node ConstValue]
    | ConstObject [ObjectField ConstValue]
    deriving Eq
 instance Show ConstValue where
    showList = mappend . showList'
    show (ConstInt integer) = show integer
    show (ConstFloat float) = showFloat float mempty
    show (ConstString text) = "\"" <> Text.foldr (mappend . escape) "\"" text
    show (ConstBoolean boolean) = show boolean
    show ConstNull = "null"
    show (ConstEnum name) = Text.unpack name
    show (ConstList list) = show list
    show (ConstObject fields) = showObject fields
 -- | Key-value pair.
 --
 -- A list of 'ObjectField's represents a GraphQL object type.
 data ObjectField a = ObjectField
    { name :: Name
    , value :: Node a
    , location :: Location
    } deriving Eq
 instance Show a => Show (ObjectField a) where
    show ObjectField{..} = Text.unpack name ++ ": " ++ show value
 instance Functor ObjectField where
    fmap f ObjectField{..} = ObjectField name (f <$> value) location
 -- ** Variables
 -- | Variable definition.
 --
 -- Each operation can include a list of variables:
 --
 -- @
 -- query (protagonist: String = \"Zarathustra\") {
 --   getAuthor(protagonist: $protagonist)
 -- }
 -- @
 --
 -- This query defines an optional variable @protagonist@ of type @String@,
 -- its default value is \"Zarathustra\". If no default value is defined and no
 -- value is provided, a variable can still be @null@ if its type is nullable.
 --
 -- Variables are usually passed along with the query, but not in the query
 -- itself. They make queries reusable.
 data VariableDefinition =
    VariableDefinition Name Type (Maybe (Node ConstValue)) Location
    deriving (Eq, Show)
 showVariableName :: VariableDefinition -> String
 showVariableName (VariableDefinition name _ _ _) = "$" <> Text.unpack name
 showVariable :: VariableDefinition -> String
 showVariable var@(VariableDefinition _ type' _ _) = showVariableName var <> ":" <> " " <> show type'
 -- ** Type References
 -- | Type representation.
 data Type
    = TypeNamed Name
    | TypeList Type
    | TypeNonNull NonNullType
    deriving Eq
 instance Show Type where
    show (TypeNamed typeName) = Text.unpack typeName
    show (TypeList listType) = concat ["[", show listType, "]"]
    show (TypeNonNull nonNullType) = show nonNullType
 -- | Represents type names.
 type NamedType = Name
 -- | Helper type to represent Non-Null types and lists of such types.
 data NonNullType
    = NonNullTypeNamed Name
    | NonNullTypeList Type
    deriving Eq
 instance Show NonNullType where
    show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!"
    show (NonNullTypeList listType) = concat ["[", show listType, "]!"]
 -- ** Directives
 -- | Directive.
 --
 -- Directives begin with "@", can accept arguments, and can be applied to the
 -- most GraphQL elements, providing additional information.
 data Directive = Directive
    { name :: Name
    , arguments :: [Argument]
    , location :: Location
    } deriving (Eq, Show)
 -- * Type System
 -- | Type system can define a schema, a type or a directive.
 --
 -- @
 -- schema {
 --   query: Query
 -- }
 --
 -- directive @example on FIELD_DEFINITION
 --
 -- type Query {
 --   field: String @example
 -- }
 -- @
 --
 -- This example defines a custom directive "@example", which is applied to a
 -- field definition of the type definition "Query". On the top the schema
 -- is defined by taking advantage of the type "Query".
 data TypeSystemDefinition
    = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
    | TypeDefinition TypeDefinition
    | DirectiveDefinition
        Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation)
    deriving (Eq, Show)
 -- ** Type System Extensions
 -- | Extension for a type system definition. Only schema and type definitions
 -- can be extended.
 data TypeSystemExtension
    = SchemaExtension SchemaExtension
    | TypeExtension TypeExtension
    deriving (Eq, Show)
 -- ** Schema
 -- | Root operation type definition.
 --
 -- Defining root operation types is not required since they have defaults. So
 -- the default query root type is "Query", and the default mutation root type
 -- is "Mutation". But these defaults can be changed for a specific schema. In
 -- the following code the query root type is changed to "MyQueryRootType", and
 -- the mutation root type to "MyMutationRootType":
 --
 -- @
 -- schema {
 --   query: MyQueryRootType
 --   mutation: MyMutationRootType
 -- }
 -- @
 data OperationTypeDefinition
    = OperationTypeDefinition OperationType NamedType
    deriving (Eq, Show)
 -- | Extension of the schema definition by further operations or directives.
 data SchemaExtension
    = SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
    | SchemaDirectivesExtension (NonEmpty Directive)
    deriving (Eq, Show)
 -- ** Descriptions
 -- | GraphQL has built-in capability to document service APIs. Documentation
 -- is a GraphQL string that precedes a particular definition and contains
 -- Markdown. Any GraphQL definition can be documented this way.
 --
 -- @
 -- """
 -- Supported languages.
 -- """
 -- enum Language {
 --   "English"
 --   EN
 --
 --   "Russian"
 --   RU
 -- }
 -- @
 newtype Description = Description (Maybe Text)
    deriving (Eq, Show)
 instance Semigroup Description
  where
    Description lhs <> Description rhs = Description $ lhs <> rhs
 instance Monoid Description
  where
    mempty = Description mempty
 -- ** Types
 -- | Type definitions describe various user-defined types.
 data TypeDefinition
    = ScalarTypeDefinition Description Name [Directive]
    | ObjectTypeDefinition
        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
    | InterfaceTypeDefinition
        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
    | UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
    | EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
    | InputObjectTypeDefinition
        Description Name [Directive] [InputValueDefinition]
    deriving (Eq, Show)
 -- | Extensions for custom, already defined types.
 data TypeExtension
    = ScalarTypeExtension Name (NonEmpty Directive)
    | ObjectTypeFieldsDefinitionExtension
        Name (ImplementsInterfaces []) [Directive] (NonEmpty FieldDefinition)
    | ObjectTypeDirectivesExtension
        Name (ImplementsInterfaces []) (NonEmpty Directive)
    | ObjectTypeImplementsInterfacesExtension
        Name (ImplementsInterfaces NonEmpty)
    | InterfaceTypeFieldsDefinitionExtension
        Name [Directive] (NonEmpty FieldDefinition)
    | InterfaceTypeDirectivesExtension Name (NonEmpty Directive)
    | UnionTypeUnionMemberTypesExtension
        Name [Directive] (UnionMemberTypes NonEmpty)
    | UnionTypeDirectivesExtension Name (NonEmpty Directive)
    | EnumTypeEnumValuesDefinitionExtension
        Name [Directive] (NonEmpty EnumValueDefinition)
    | EnumTypeDirectivesExtension Name (NonEmpty Directive)
    | InputObjectTypeInputFieldsDefinitionExtension
        Name [Directive] (NonEmpty InputValueDefinition)
    | InputObjectTypeDirectivesExtension Name (NonEmpty Directive)
    deriving (Eq, Show)
 -- ** Objects
 -- | Defines a list of interfaces implemented by the given object type.
 --
 -- @
 -- type Business implements NamedEntity & ValuedEntity {
 --   name: String
 -- }
 -- @
 --
 -- Here the object type "Business" implements two interfaces: "NamedEntity" and
 -- "ValuedEntity".
 newtype ImplementsInterfaces t = ImplementsInterfaces (t NamedType)
 instance Foldable t => Eq (ImplementsInterfaces t) where
    (ImplementsInterfaces xs) == (ImplementsInterfaces ys)
        = toList xs == toList ys
 instance Foldable t => Show (ImplementsInterfaces t) where
    show (ImplementsInterfaces interfaces) = Text.unpack
        $ Text.append "implements"
        $ Text.intercalate " & "
        $ toList interfaces
 -- | Definition of a single field in a type.
 --
 -- @
 -- type Person {
 --   name: String
 --   picture(width: Int, height: Int): Url
 -- }
 -- @
 --
 -- "name" and "picture", including their arguments and types, are field
 -- definitions.
 data FieldDefinition
    = FieldDefinition Description Name ArgumentsDefinition Type [Directive]
    deriving (Eq, Show)
 -- | A list of values passed to a field.
 --
 -- @
 -- type Person {
 --   name: String
 --   picture(width: Int, height: Int): Url
 -- }
 -- @
 --
 -- "Person" has two fields, "name" and "picture". "name" doesn't have any
 -- arguments, so 'ArgumentsDefinition' contains an empty list. "picture"
 -- contains definitions for 2 arguments: "width" and "height".
 newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
    deriving (Eq, Show)
 instance Semigroup ArgumentsDefinition where
    (ArgumentsDefinition xs) <> (ArgumentsDefinition ys) =
        ArgumentsDefinition $ xs <> ys
 instance Monoid ArgumentsDefinition where
    mempty = ArgumentsDefinition []
 -- | Defines an input value.
 --
 -- * Input values can define field arguments, see 'ArgumentsDefinition'.
 -- * They can also be used as field definitions in an input type.
 --
 -- @
 -- input Point2D {
 --   x: Float
 --   y: Float
 -- }
 -- @
 --
 -- The input type "Point2D" contains two value definitions: "x" and "y".
 data InputValueDefinition = InputValueDefinition
    Description Name Type (Maybe (Node ConstValue)) [Directive]
    deriving (Eq, Show)
 -- ** Unions
 -- | List of types forming a union.
 --
 -- @
 -- union SearchResult = Person | Photo
 -- @
 --
 -- "Person" and "Photo" are member types of the union "SearchResult".
 newtype UnionMemberTypes t = UnionMemberTypes (t NamedType)
 instance Foldable t => Eq (UnionMemberTypes t) where
    (UnionMemberTypes xs) == (UnionMemberTypes ys) = toList xs == toList ys
 instance Foldable t => Show (UnionMemberTypes t) where
    show (UnionMemberTypes memberTypes) = Text.unpack
        $ Text.intercalate " | "
        $ toList memberTypes
 -- ** Enums
 -- | Single value in an enum definition.
 --
 -- @
 -- enum Direction {
 --   NORTH
 --   EAST
 --   SOUTH
 --   WEST
 -- }
 -- @
 --
 -- "NORTH, "EAST", "SOUTH", and "WEST" are value definitions of an enum type
 -- definition "Direction".
 data EnumValueDefinition = EnumValueDefinition Description Name [Directive]
    deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@ -1,5 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE Safe #-}
 -- | This module defines a minifier and a printer for the @GraphQL@ language.
 module Language.GraphQL.AST.Encoder
@ -8,14 +11,14 @@ module Language.GraphQL.AST.Encoder
    , directive
    , document
    , minified
    , operationType
    , pretty
    , type'
    , typeSystemDefinition
    , value
    ) where
-import Data.Char (ord)
+import Data.Foldable (fold, Foldable (..))
 import Data.Foldable (fold)
 import Data.Monoid ((<>))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text (Text)
 import qualified Data.Text as Text
@ -23,9 +26,10 @@ import qualified Data.Text.Lazy as Lazy (Text)
 import qualified Data.Text.Lazy as Lazy.Text
 import Data.Text.Lazy.Builder (Builder)
 import qualified Data.Text.Lazy.Builder as Builder
-import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
+import Data.Text.Lazy.Builder.Int (decimal)
 import Data.Text.Lazy.Builder.RealFloat (realFloat)
-import qualified Language.GraphQL.AST as Full
+import qualified Language.GraphQL.AST.Document as Full
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 -- | Instructs the encoder whether the GraphQL document should be minified or
 --   pretty printed.
@ -33,7 +37,7 @@ import qualified Language.GraphQL.AST as Full
 --   Use 'pretty' or 'minified' to construct the formatter.
 data Formatter
    = Minified
-    | Pretty Word
+    | Pretty !Word
 -- | Constructs a formatter for pretty printing.
 pretty :: Formatter
@ -43,16 +47,260 @@ pretty = Pretty 0
 minified :: Formatter
 minified = Minified
-- | Converts a 'Full.Document' into a string.
+-- | Converts a Document' into a string.
 document :: Formatter -> Full.Document -> Lazy.Text
 document formatter defs
    | Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
    | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
  where
-    encodeDocument = NonEmpty.toList $ definition formatter <$> defs
+    encodeDocument = foldr executableDefinition [] defs
    executableDefinition (Full.ExecutableDefinition executableDefinition') acc =
        definition formatter executableDefinition' : acc
    executableDefinition (Full.TypeSystemDefinition typeSystemDefinition' _location) acc =
        typeSystemDefinition formatter typeSystemDefinition' : acc
    executableDefinition (Full.TypeSystemExtension typeSystemExtension' _location) acc =
        typeSystemExtension formatter typeSystemExtension' : acc
-- | Converts a 'Full.Definition' into a string.
+directiveLocation :: DirectiveLocation.DirectiveLocation -> Lazy.Text
-definition :: Formatter -> Full.Definition -> Lazy.Text
+directiveLocation = Lazy.Text.pack . show
 withLineBreak :: Formatter -> Lazy.Text.Text -> Lazy.Text.Text
 withLineBreak formatter encodeDefinition
    | Pretty _ <- formatter = Lazy.Text.snoc encodeDefinition '\n'
    | Minified <- formatter = encodeDefinition
 typeSystemExtension :: Formatter -> Full.TypeSystemExtension -> Lazy.Text
 typeSystemExtension formatter = \case
    Full.SchemaExtension schemaExtension' ->
        schemaExtension formatter schemaExtension'
    Full.TypeExtension typeExtension' -> typeExtension formatter typeExtension'
 schemaExtension :: Formatter -> Full.SchemaExtension -> Lazy.Text
 schemaExtension formatter = \case
    Full.SchemaOperationExtension operationDirectives operationTypeDefinitions' ->
        withLineBreak formatter
            $ "extend schema "
            <> optempty (directives formatter) operationDirectives
            <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
    Full.SchemaDirectivesExtension operationDirectives -> "extend schema "
        <> optempty (directives formatter) (NonEmpty.toList operationDirectives)
 typeExtension :: Formatter -> Full.TypeExtension -> Lazy.Text
 typeExtension formatter = \case
    Full.ScalarTypeExtension name' directives'
        -> "extend scalar "
        <> Lazy.Text.fromStrict name'
        <> directives formatter (NonEmpty.toList directives')
    Full.ObjectTypeFieldsDefinitionExtension name' ifaces' directives' fields'
        -> "extend type "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields')
    Full.ObjectTypeDirectivesExtension name' ifaces' directives'
        -> "extend type "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
        <> optempty (directives formatter) (NonEmpty.toList directives')
    Full.ObjectTypeImplementsInterfacesExtension name' ifaces'
        -> "extend type "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
    Full.InterfaceTypeFieldsDefinitionExtension name' directives' fields'
        -> "extend interface "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) (NonEmpty.toList fields')
    Full.InterfaceTypeDirectivesExtension name' directives'
        -> "extend interface "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) (NonEmpty.toList directives')
    Full.UnionTypeUnionMemberTypesExtension name' directives' members'
        -> "extend union "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> unionMemberTypes formatter members'
    Full.UnionTypeDirectivesExtension name' directives'
        -> "extend union "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) (NonEmpty.toList directives')
    Full.EnumTypeEnumValuesDefinitionExtension name' directives' members'
        -> "extend enum "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (enumValueDefinition formatter) (NonEmpty.toList members')
    Full.EnumTypeDirectivesExtension name' directives'
        -> "extend enum "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) (NonEmpty.toList directives')
    Full.InputObjectTypeInputFieldsDefinitionExtension name' directives' fields'
        -> "extend input "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (inputValueDefinition nextFormatter) (NonEmpty.toList fields')
    Full.InputObjectTypeDirectivesExtension name' directives'
        -> "extend input "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) (NonEmpty.toList directives')
  where
    nextFormatter = incrementIndent formatter
 -- | Converts a t'Full.TypeSystemDefinition' into a string.
 typeSystemDefinition :: Formatter -> Full.TypeSystemDefinition -> Lazy.Text
 typeSystemDefinition formatter = \case
    Full.SchemaDefinition operationDirectives operationTypeDefinitions' ->
        withLineBreak formatter
            $ "schema "
            <> optempty (directives formatter) operationDirectives
            <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
    Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
    Full.DirectiveDefinition description' name' arguments' repeatable locations
        -> description formatter description'
        <> "@"
        <> Lazy.Text.fromStrict name'
        <> argumentsDefinition formatter arguments'
        <> (if repeatable then " repeatable" else mempty)
        <> " on"
        <> pipeList formatter (directiveLocation <$> locations)
 operationTypeDefinition :: Formatter -> Full.OperationTypeDefinition -> Lazy.Text.Text
 operationTypeDefinition formatter (Full.OperationTypeDefinition operationType' namedType')
    = indentLine (incrementIndent formatter)
    <> operationType formatter operationType'
    <> colon formatter
    <> Lazy.Text.fromStrict namedType'
 fieldDefinition :: Formatter -> Full.FieldDefinition -> Lazy.Text.Text
 fieldDefinition formatter fieldDefinition' =
    let Full.FieldDefinition description' name' arguments' type'' directives' = fieldDefinition'
     in optempty (description formatter) description'
            <> indentLine formatter
            <> Lazy.Text.fromStrict name'
            <> argumentsDefinition formatter arguments'
            <> colon formatter
            <> type' type''
            <> optempty (directives formatter) directives'
 argumentsDefinition :: Formatter -> Full.ArgumentsDefinition -> Lazy.Text.Text
 argumentsDefinition formatter (Full.ArgumentsDefinition arguments') =
    parensCommas formatter (argumentDefinition formatter) arguments'
 argumentDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
 argumentDefinition formatter definition' =
    let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition'
     in optempty (description formatter) description'
            <> Lazy.Text.fromStrict name'
            <> colon formatter
            <> type' type''
            <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
            <> directives formatter directives'
 inputValueDefinition :: Formatter -> Full.InputValueDefinition -> Lazy.Text.Text
 inputValueDefinition formatter definition' =
    let Full.InputValueDefinition description' name' type'' defaultValue' directives' = definition'
     in optempty (description formatter) description'
            <> indentLine formatter
            <> Lazy.Text.fromStrict name'
            <> colon formatter
            <> type' type''
            <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
            <> directives formatter directives'
 typeDefinition :: Formatter -> Full.TypeDefinition -> Lazy.Text
 typeDefinition formatter = \case
    Full.ScalarTypeDefinition description' name' directives'
        -> optempty (description formatter) description'
        <> "scalar "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
    Full.ObjectTypeDefinition description' name' ifaces' directives' fields'
        -> optempty (description formatter) description'
        <> "type "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) fields'
    Full.InterfaceTypeDefinition description' name' ifaces' directives' fields'
        -> optempty (description formatter) description'
        <> "interface "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) fields'
    Full.UnionTypeDefinition description' name' directives' members'
        -> optempty (description formatter) description'
        <> "union "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> unionMemberTypes formatter members'
    Full.EnumTypeDefinition description' name' directives' members'
        -> optempty (description formatter) description'
        <> "enum "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (enumValueDefinition formatter) members'
    Full.InputObjectTypeDefinition description' name' directives' fields'
        -> optempty (description formatter) description'
        <> "input "
        <> Lazy.Text.fromStrict name'
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (inputValueDefinition nextFormatter) fields'
  where
    nextFormatter = incrementIndent formatter
 implementsInterfaces :: Foldable t => Full.ImplementsInterfaces t -> Lazy.Text
 implementsInterfaces (Full.ImplementsInterfaces interfaces)
    | null interfaces = mempty
    | otherwise = Lazy.Text.fromStrict
        $ Text.append "implements "
        $ Text.intercalate " & "
        $ toList interfaces
 unionMemberTypes :: Foldable t => Formatter -> Full.UnionMemberTypes t -> Lazy.Text
 unionMemberTypes formatter (Full.UnionMemberTypes memberTypes)
    | null memberTypes = mempty
    | otherwise = Lazy.Text.append "="
        $ pipeList formatter
        $ Lazy.Text.fromStrict
        <$> toList memberTypes
 pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text
 pipeList Minified =  (" " <>) . Lazy.Text.intercalate " | " . toList
 pipeList (Pretty _) =  Lazy.Text.concat
    . fmap (("\n" <> indentSymbol <> "| ") <>)
    . toList
 enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text
 enumValueDefinition (Pretty _) enumValue =
    let Full.EnumValueDefinition description' name' directives' = enumValue
        formatter = Pretty 1
     in description formatter description'
        <> indentLine formatter
        <> Lazy.Text.fromStrict name'
        <> directives formatter directives'
 enumValueDefinition Minified enumValue =
    let Full.EnumValueDefinition description' name' directives' = enumValue
     in description Minified description'
        <> Lazy.Text.fromStrict name'
        <> directives Minified directives'
 description :: Formatter -> Full.Description -> Lazy.Text.Text
 description _formatter (Full.Description Nothing) = ""
 description formatter (Full.Description (Just description')) =
    stringValue formatter description'
 -- | Converts a t'Full.ExecutableDefinition' into a string.
 definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
 definition formatter x
    | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
    | Minified <- formatter = encodeDefinition x
@ -62,42 +310,47 @@ definition formatter x
    encodeDefinition (Full.DefinitionFragment fragment)
        = fragmentDefinition formatter fragment
 -- | Converts a 'Full.OperationDefinition into a string.
 operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
-operationDefinition formatter (Full.OperationSelectionSet sels)
+operationDefinition formatter = \case
-    = selectionSet formatter sels
+    Full.SelectionSet sels _ -> selectionSet formatter sels
-operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
+    Full.OperationDefinition Full.Query name vars dirs sels _ ->
-    = "query " <> node formatter name vars dirs sels
+        "query " <> root name vars dirs sels
-operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
+    Full.OperationDefinition Full.Mutation name vars dirs sels _ ->
-    = "mutation " <> node formatter name vars dirs sels
+        "mutation " <> root name vars dirs sels
-
+    Full.OperationDefinition Full.Subscription name vars dirs sels _ ->
-node :: Formatter ->
+        "subscription " <> root name vars dirs sels
-    Maybe Full.Name ->
+  where
-    [Full.VariableDefinition] ->
+    -- | Converts a Query or Mutation into a string.
-    [Full.Directive] ->
+    root :: Maybe Full.Name ->
-    Full.SelectionSet ->
+        [Full.VariableDefinition] ->
-    Lazy.Text
+        [Full.Directive] ->
-node formatter name vars dirs sels
+        Full.SelectionSet ->
-    = Lazy.Text.fromStrict (fold name)
+        Lazy.Text
-    <> optempty (variableDefinitions formatter) vars
+    root name vars dirs sels
-    <> optempty (directives formatter) dirs
+        = Lazy.Text.fromStrict (fold name)
-    <> eitherFormat formatter " " mempty
+        <> optempty (variableDefinitions formatter) vars
-    <> selectionSet formatter sels
+        <> optempty (directives formatter) dirs
        <> eitherFormat formatter " " mempty
        <> selectionSet formatter sels
 variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
 variableDefinitions formatter
    = parensCommas formatter $ variableDefinition formatter
 variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
-variableDefinition formatter (Full.VariableDefinition var ty dv)
+variableDefinition formatter variableDefinition' =
-    = variable var
+    let Full.VariableDefinition variableName variableType defaultValue' _ =
-    <> eitherFormat formatter ": " ":"
+            variableDefinition'
-    <> type' ty
+     in variable variableName
-    <> maybe mempty (defaultValue formatter) dv
+    <> colon formatter
    <> type' variableType
    <> maybe mempty (defaultValue formatter . Full.node) defaultValue'
-defaultValue :: Formatter -> Full.Value -> Lazy.Text
+defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
 defaultValue formatter val
    = eitherFormat formatter " = " "="
-    <> value formatter val
+    <> value formatter (fromConstValue val)
 variable :: Full.Name -> Lazy.Text
 variable var = "$" <> Lazy.Text.fromStrict var
@ -110,29 +363,40 @@ selectionSet formatter
 selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
 selectionSetOpt formatter = bracesList formatter $ selection formatter
 indentSymbol :: Lazy.Text
 indentSymbol = "  "
 indent :: (Integral a) => a -> Lazy.Text
-indent indentation = Lazy.Text.replicate (fromIntegral indentation) "  "
+indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
 selection :: Formatter -> Full.Selection -> Lazy.Text
-selection formatter = Lazy.Text.append indent' . encodeSelection
+selection formatter = Lazy.Text.append (indentLine formatter')
    . encodeSelection
  where
-    encodeSelection (Full.SelectionField field') = field incrementIndent field'
+    encodeSelection (Full.FieldSelection fieldSelection) =
-    encodeSelection (Full.SelectionInlineFragment fragment) =
+        field formatter' fieldSelection
-        inlineFragment incrementIndent fragment
+    encodeSelection (Full.InlineFragmentSelection fragmentSelection) =
-    encodeSelection (Full.SelectionFragmentSpread spread) =
+        inlineFragment formatter' fragmentSelection
-        fragmentSpread incrementIndent spread
+    encodeSelection (Full.FragmentSpreadSelection fragmentSelection) =
-    incrementIndent
+        fragmentSpread formatter' fragmentSelection
-        | Pretty indentation <- formatter = Pretty $ indentation + 1
+    formatter' = incrementIndent formatter
-        | otherwise = Minified
+
-    indent'
+indentLine :: Formatter -> Lazy.Text
-        | Pretty indentation <- formatter = indent $ indentation + 1
+indentLine formatter
-        | otherwise = ""
+    | Pretty indentation <- formatter = indent indentation
    | otherwise = ""
 incrementIndent :: Formatter -> Formatter
 incrementIndent formatter
    | Pretty indentation <- formatter = Pretty $ indentation + 1
    | otherwise = Minified
 colon :: Formatter -> Lazy.Text
 colon formatter = eitherFormat formatter ": " ":"
 -- | Converts Field into a string.
 field :: Formatter -> Full.Field -> Lazy.Text
-field formatter (Full.Field alias name args dirs set)
+field formatter (Full.Field alias name args dirs set _)
    = optempty prependAlias (fold alias)
    <> Lazy.Text.fromStrict name
    <> optempty (arguments formatter) args
@ -147,27 +411,28 @@ arguments :: Formatter -> [Full.Argument] -> Lazy.Text
 arguments formatter = parensCommas formatter $ argument formatter
 argument :: Formatter -> Full.Argument -> Lazy.Text
-argument formatter (Full.Argument name value')
+argument formatter (Full.Argument name value' _)
    = Lazy.Text.fromStrict name
    <> colon formatter
-    <> value formatter value'
+    <> value formatter (Full.node value')
 -- * Fragments
 fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
-fragmentSpread formatter (Full.FragmentSpread name ds)
+fragmentSpread formatter (Full.FragmentSpread name directives' _)
-    = "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) ds
+    = "..." <> Lazy.Text.fromStrict name
    <> optempty (directives formatter) directives'
 inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
-inlineFragment formatter (Full.InlineFragment tc dirs sels)
+inlineFragment formatter (Full.InlineFragment typeCondition directives' selections _)
    = "... on "
-    <> Lazy.Text.fromStrict (fold tc)
+    <> Lazy.Text.fromStrict (fold typeCondition)
-    <> directives formatter dirs
+    <> directives formatter directives'
    <> eitherFormat formatter " " mempty
-    <> selectionSet formatter sels
+    <> selectionSet formatter selections
 fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
-fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
+fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _)
    = "fragment " <> Lazy.Text.fromStrict name
    <> " on " <> Lazy.Text.fromStrict tc
    <> optempty (directives formatter) dirs
@ -178,12 +443,14 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
 -- | Converts a 'Full.Directive' into a string.
 directive :: Formatter -> Full.Directive -> Lazy.Text
-directive formatter (Full.Directive name args)
+directive formatter (Full.Directive name args _)
    = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
 directives :: Formatter -> [Full.Directive] -> Lazy.Text
-directives Minified = spaces (directive Minified)
+directives Minified values = spaces (directive Minified) values
-directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
+directives formatter values
    | null values = ""
    | otherwise = Lazy.Text.cons ' ' $ spaces (directive formatter) values
 -- | Converts a 'Full.Value' into a string.
 value :: Formatter -> Full.Value -> Lazy.Text
@ -191,54 +458,70 @@ value _ (Full.Variable x) = variable x
 value _ (Full.Int x) = Builder.toLazyText $ decimal x
 value _ (Full.Float x) = Builder.toLazyText $ realFloat x
 value _ (Full.Boolean  x) = booleanValue x
-value _ Full.Null = mempty
+value _ Full.Null = "null"
 value formatter (Full.String string) = stringValue formatter string
 value _ (Full.Enum x) = Lazy.Text.fromStrict x
 value formatter (Full.List x) = listValue formatter x
 value formatter (Full.Object x) = objectValue formatter x
 fromConstValue :: Full.ConstValue -> Full.Value
 fromConstValue (Full.ConstInt x) = Full.Int x
 fromConstValue (Full.ConstFloat x) = Full.Float x
 fromConstValue (Full.ConstBoolean  x) = Full.Boolean x
 fromConstValue Full.ConstNull = Full.Null
 fromConstValue (Full.ConstString string) = Full.String string
 fromConstValue (Full.ConstEnum x) = Full.Enum x
 fromConstValue (Full.ConstList x) = Full.List $ fmap fromConstValue <$> x
 fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x
  where
    fromConstObjectField Full.ObjectField{value = value', ..} =
        Full.ObjectField name (fromConstValue <$> value') location
 booleanValue :: Bool -> Lazy.Text
 booleanValue True  = "true"
 booleanValue False = "false"
 quote :: Builder.Builder
 quote = Builder.singleton '\"'
 oneLine :: Text -> Builder
 oneLine string = quote <> Text.foldr merge quote string
  where
    merge = mappend . Builder.fromString . Full.escape
 stringValue :: Formatter -> Text -> Lazy.Text
-stringValue Minified string = Builder.toLazyText
+stringValue Minified string = Builder.toLazyText $ oneLine string
-    $ quote <> Text.foldr (mappend . escape') quote string
+stringValue (Pretty indentation) string =
-  where
+  if hasEscaped string
-    quote = Builder.singleton '\"'
+  then stringValue Minified string
-    escape' '\n' = Builder.fromString "\\n"
+  else Builder.toLazyText $ encoded lines'
-    escape' char = escape char
+    where
-stringValue (Pretty indentation) string = byStringType $ Text.lines string
+      isWhiteSpace char = char == ' ' || char == '\t'
-  where
+      isNewline char = char == '\n' || char == '\r'
-    byStringType [] = "\"\""
+      hasEscaped = Text.any (not . isAllowed)
-    byStringType [line] = Builder.toLazyText
+      isAllowed char =
-        $ quote <> Text.foldr (mappend . escape) quote line
+          char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
    byStringType lines' = "\"\"\"\n"
        <> Lazy.Text.unlines (transformLine <$> lines')
        <> indent indentation
        <> "\"\"\""
    transformLine = (indent (indentation + 1) <>)
        . Lazy.Text.fromStrict
        . Text.replace "\"\"\"" "\\\"\"\""
    quote = Builder.singleton '\"'
-escape :: Char -> Builder
+      tripleQuote = Builder.fromText "\"\"\""
-escape char'
+      newline = Builder.singleton '\n'
    | char' == '\\' = Builder.fromString "\\\\"
    | char' == '\"' = Builder.fromString "\\\""
    | char' == '\b' = Builder.fromString "\\b"
    | char' == '\f' = Builder.fromString "\\f"
    | char' == '\r' = Builder.fromString "\\r"
    | char' < '\x0010' = unicode  "\\u000" char'
    | char' < '\x0020' = unicode "\\u00" char'
    | otherwise = Builder.singleton char'
  where
    unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord)
-listValue :: Formatter -> [Full.Value] -> Lazy.Text
+      strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
-listValue formatter = bracketsCommas formatter $ value formatter
+      lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
      encoded [] = oneLine string
      encoded [_] = oneLine string
      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
-objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text
+listValue :: Formatter -> [Full.Node Full.Value] -> Lazy.Text
 listValue formatter = bracketsCommas formatter $ value formatter . Full.node
 objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
 objectValue formatter = intercalate $ objectField formatter
  where
    intercalate f
@ -246,14 +529,14 @@ objectValue formatter = intercalate $ objectField formatter
        . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
        . fmap f
-objectField :: Formatter -> Full.ObjectField -> Lazy.Text
+objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text
-objectField formatter (Full.ObjectField name value') =
+objectField formatter (Full.ObjectField name (Full.Node value' _) _) =
    Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
 -- | Converts a 'Full.Type' a type into a string.
 type' :: Full.Type -> Lazy.Text
-type' (Full.TypeNamed   x) = Lazy.Text.fromStrict x
+type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
-type' (Full.TypeList    x) = listType x
+type' (Full.TypeList x) = listType x
 type' (Full.TypeNonNull x) = nonNullType x
 listType :: Full.Type -> Lazy.Text
@ -261,7 +544,13 @@ listType x = brackets (type' x)
 nonNullType :: Full.NonNullType -> Lazy.Text
 nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
-nonNullType (Full.NonNullTypeList  x) = listType x <> "!"
+nonNullType (Full.NonNullTypeList x) = listType x <> "!"
 -- | Produces lowercase operation type: query, mutation or subscription.
 operationType :: Formatter -> Full.OperationType -> Lazy.Text
 operationType _formatter Full.Query = "query"
 operationType _formatter Full.Mutation = "mutation"
 operationType _formatter Full.Subscription = "subscription"
 -- * Internal
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@ -15,6 +15,7 @@ module Language.GraphQL.AST.Lexer
    , dollar
    , comment
    , equals
    , extend
    , integer
    , float
    , lexeme
@ -28,41 +29,37 @@ module Language.GraphQL.AST.Lexer
    , unicodeBOM
    ) where
-import Control.Applicative ( Alternative(..)
+import Control.Applicative (Alternative(..))
-                           , liftA2
+import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
-                           )
+import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
 import Data.Char ( chr
                 , digitToInt
                 , isAsciiLower
                 , isAsciiUpper
                 , ord
                 )
 import Data.Foldable (foldl')
 import Data.List (dropWhileEnd)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Proxy (Proxy(..))
 import Data.Void (Void)
-import Text.Megaparsec ( Parsec
+import Text.Megaparsec
-                       , between
+    ( Parsec
-                       , chunk
+    , (<?>)
-                       , chunkToTokens
+    , between
-                       , notFollowedBy
+    , chunk
-                       , oneOf
+    , chunkToTokens
-                       , option
+    , notFollowedBy
-                       , optional
+    , oneOf
-                       , satisfy
+    , option
-                       , sepBy
+    , optional
-                       , skipSome
+    , satisfy
-                       , takeP
+    , skipSome
-                       , takeWhile1P
+    , takeP
-                       , try
+    , takeWhile1P
-                       )
+    , try
-import Text.Megaparsec.Char ( char
+    )
-                            , digitChar
+import Text.Megaparsec.Char (char, digitChar, space1)
                            , space1
                            )
 import qualified Text.Megaparsec.Char.Lexer as Lexer
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Control.Monad (void)
 -- | Standard parser.
 -- Accepts the type of the parsed token.
@ -97,16 +94,16 @@ dollar :: Parser T.Text
 dollar = symbol "$"
 -- | Parser for "@".
-at :: Parser Char
+at :: Parser ()
-at = char '@'
+at = void $ symbol "@"
 -- | Parser for "&".
 amp :: Parser T.Text
 amp = symbol "&"
 -- | Parser for ":".
-colon :: Parser T.Text
+colon :: Parser ()
-colon = symbol ":"
+colon = void $ symbol ":"
 -- | Parser for "=".
 equals :: Parser T.Text
@ -146,12 +143,13 @@ blockString :: Parser T.Text
 blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
  where
    stringValue = do
-        byLine <- sepBy (many blockStringCharacter) lineTerminator
+        byLine <- NonEmpty.sepBy1 (many blockStringCharacter) lineTerminator
-        let indentSize = foldr countIndent 0 $ tail byLine
+        let indentSize = foldr countIndent 0 $ NonEmpty.tail byLine
-            withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
+            withoutIndent = NonEmpty.head byLine
                : (removeIndent indentSize <$> NonEmpty.tail byLine)
            withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
-        return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
+        pure $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
    removeEmptyLine [] = True
    removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
    removeEmptyLine _ = False
@ -173,21 +171,21 @@ 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
 name = do
    firstLetter <- nameFirstLetter
    rest <- many $ nameFirstLetter <|> digitChar
-    _ <- spaceConsumer
+    void spaceConsumer
-    return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
+    pure $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
-      where
+  where
-        nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
+    nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
 isChunkDelimiter :: Char -> Bool
 isChunkDelimiter = flip notElem ['"', '\\', '\n', '\r']
@ -201,28 +199,41 @@ lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
 isSourceCharacter :: Char -> Bool
 isSourceCharacter = isSourceCharacter' . ord
  where
-    isSourceCharacter' code = code >= 0x0020
+    isSourceCharacter' code
-                           || code == 0x0009
+        = code >= 0x0020
-                           || code == 0x000a
+        || elem code [0x0009, 0x000a, 0x000d]
                           || code == 0x000d
 escapeSequence :: Parser Char
 escapeSequence = do
-    _ <- char '\\'
+    void $ char '\\'
    escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
    case escaped of
-        'b' -> return '\b'
+        'b' -> pure '\b'
-        'f' -> return '\f'
+        'f' -> pure '\f'
-        'n' -> return '\n'
+        'n' -> pure '\n'
-        'r' -> return '\r'
+        'r' -> pure '\r'
-        't' -> return '\t'
+        't' -> pure '\t'
-        'u' -> chr . foldl' step 0
+        'u' -> chr
-                   . chunkToTokens (Proxy :: Proxy T.Text)
+            . foldl' step 0
-                 <$> takeP Nothing 4
+            . chunkToTokens (Proxy :: Proxy T.Text)
-        _ -> return escaped
+            <$> takeP Nothing 4
        _ -> pure escaped
  where
    step accumulator = (accumulator * 16 +) . digitToInt
 -- | Parser for the "Byte Order Mark".
 unicodeBOM :: Parser ()
-unicodeBOM = optional (char '\xfeff') >> pure ()
+unicodeBOM = void $ optional $ char '\xfeff'
 -- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
 extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
 extend token extensionLabel parsers
    = foldr combine headParser (NonEmpty.tail parsers)
    <?> extensionLabel
  where
    headParser = tryExtension $ NonEmpty.head parsers
    combine current accumulated = accumulated <|> tryExtension current
    tryExtension extensionParser = try
        $ symbol "extend"
        *> symbol token
        *> extensionParser
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@ -1,188 +1,545 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | @GraphQL@ document parser.
 module Language.GraphQL.AST.Parser
    ( document
    ) where
-import Control.Applicative ( Alternative(..)
+import Control.Applicative (Alternative(..), optional)
-                           , optional
+import Control.Applicative.Combinators (sepBy1)
-                           )
+import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
-import Language.GraphQL.AST
+import Data.Text (Text)
 import qualified Language.GraphQL.AST.DirectiveLocation as Directive
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
 import qualified Language.GraphQL.AST.Document as Full
 import Language.GraphQL.AST.Lexer
-import Text.Megaparsec ( lookAhead
+import Text.Megaparsec
-                       , option
+    ( MonadParsec(..)
-                       , try
+    , SourcePos(..)
-                       , (<?>)
+    , getSourcePos
-                       )
+    , lookAhead
    , option
    , try
    , unPos
    , (<?>)
    )
 import Data.Maybe (isJust)
 -- | Parser for the GraphQL documents.
-document :: Parser Document
+document :: Parser Full.Document
-document = unicodeBOM >> spaceConsumer >> lexeme (manyNE definition)
+document = unicodeBOM
    *> spaceConsumer
    *> lexeme (NonEmpty.some definition)
-definition :: Parser Definition
+definition :: Parser Full.Definition
-definition = DefinitionOperation <$> operationDefinition
+definition = Full.ExecutableDefinition <$> executableDefinition
-         <|> DefinitionFragment  <$> fragmentDefinition
+    <|> typeSystemDefinition'
-         <?> "definition error!"
+    <|> typeSystemExtension'
-
+    <?> "Definition"
 operationDefinition :: Parser OperationDefinition
 operationDefinition = OperationSelectionSet <$> selectionSet
                  <|> OperationDefinition   <$> operationType
                                            <*> optional name
                                            <*> opt variableDefinitions
                                            <*> opt directives
                                            <*> selectionSet
                  <?> "operationDefinition error"
 operationType :: Parser OperationType
 operationType = Query <$ symbol "query"
    <|> Mutation <$ symbol "mutation"
    <?> "operationType error"
 -- * SelectionSet
 selectionSet :: Parser SelectionSet
 selectionSet = braces $ manyNE selection
 selectionSetOpt :: Parser SelectionSetOpt
 selectionSetOpt = braces $ some selection
 selection :: Parser Selection
 selection = SelectionField          <$> field
        <|> try (SelectionFragmentSpread <$> fragmentSpread)
        <|> SelectionInlineFragment <$> inlineFragment
        <?> "selection error!"
 -- * Field
 field :: Parser Field
 field = Field <$> optional alias
              <*> name
              <*> opt arguments
              <*> opt directives
              <*> opt selectionSetOpt
 alias :: Parser Alias
 alias = try $ name <* colon
 -- * Arguments
 arguments :: Parser [Argument]
 arguments = parens $ some argument
 argument :: Parser Argument
 argument = Argument <$> name <* colon <*> value
 -- * Fragments
 fragmentSpread :: Parser FragmentSpread
 fragmentSpread = FragmentSpread <$  spread
                                <*> fragmentName
                                <*> opt directives
 inlineFragment :: Parser InlineFragment
 inlineFragment = InlineFragment <$  spread
                                <*> optional typeCondition
                                <*> opt directives
                                <*> selectionSet
 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
                 <$  symbol "fragment"
                 <*> name
                 <*> typeCondition
                 <*> opt directives
                 <*> selectionSet
 fragmentName :: Parser Name
 fragmentName = but (symbol "on") *> name
 typeCondition :: Parser TypeCondition
 typeCondition = symbol "on" *> name
 -- * Input Values
 value :: Parser Value
 value = Variable <$> variable
    <|> Float    <$> try float
    <|> Int      <$> integer
    <|> Boolean  <$> booleanValue
    <|> Null     <$  symbol "null"
    <|> String   <$> blockString
    <|> String   <$> string
    <|> Enum     <$> try enumValue
    <|> List     <$> listValue
    <|> Object   <$> objectValue
    <?> "value error!"
  where
-    booleanValue :: Parser Bool
+    typeSystemDefinition' = do
-    booleanValue = True  <$ symbol "true"
+        location <- getLocation
-               <|> False <$ symbol "false"
+        definition' <- typeSystemDefinition
        pure $ Full.TypeSystemDefinition definition' location
    typeSystemExtension' = do
        location <- getLocation
        definition' <- typeSystemExtension
        pure $ Full.TypeSystemExtension definition' location
-    enumValue :: Parser Name
+getLocation :: Parser Full.Location
-    enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
+getLocation = fromSourcePosition <$> getSourcePos
  where
    fromSourcePosition SourcePos{..} =
        Full.Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
    wordFromPosition = fromIntegral . unPos
-    listValue :: Parser [Value]
+executableDefinition :: Parser Full.ExecutableDefinition
-    listValue = brackets $ some value
+executableDefinition = Full.DefinitionOperation <$> operationDefinition
    <|> Full.DefinitionFragment  <$> fragmentDefinition
    <?> "ExecutableDefinition"
-    objectValue :: Parser [ObjectField]
+typeSystemDefinition :: Parser Full.TypeSystemDefinition
-    objectValue = braces $ some objectField
+typeSystemDefinition = schemaDefinition
    <|> typeSystemDefinitionWithDescription
    <?> "TypeSystemDefinition"
  where
    typeSystemDefinitionWithDescription = description
        >>= liftA2 (<|>) typeDefinition' directiveDefinition
    typeDefinition' description' = Full.TypeDefinition
        <$> typeDefinition description'
-objectField :: Parser ObjectField
+typeSystemExtension :: Parser Full.TypeSystemExtension
-objectField = ObjectField <$> name <* symbol ":" <*> value
+typeSystemExtension = Full.SchemaExtension <$> schemaExtension
    <|> Full.TypeExtension <$> typeExtension
    <?> "TypeSystemExtension"
-- * Variables
+directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition
 directiveDefinition description' = Full.DirectiveDefinition description'
    <$ symbol "directive"
    <* at
    <*> name
    <*> argumentsDefinition
    <*> (isJust <$> optional (symbol "repeatable"))
    <* symbol "on"
    <*> directiveLocations
    <?> "DirectiveDefinition"
-variableDefinitions :: Parser [VariableDefinition]
+directiveLocations :: Parser (NonEmpty DirectiveLocation)
-variableDefinitions = parens $ some variableDefinition
+directiveLocations = optional pipe
    *> directiveLocation `NonEmpty.sepBy1` pipe
    <?> "DirectiveLocations"
-variableDefinition :: Parser VariableDefinition
+directiveLocation :: Parser DirectiveLocation
-variableDefinition = VariableDefinition <$> variable
+directiveLocation = e (Directive.Query <$ symbol "QUERY")
-                                        <*  colon
+    <|> e (Directive.Mutation <$ symbol "MUTATION")
-                                        <*> type_
+    <|> e (Directive.Subscription <$ symbol "SUBSCRIPTION")
-                                        <*> optional defaultValue
+    <|> t (Directive.FieldDefinition <$ symbol "FIELD_DEFINITION")
-variable :: Parser Name
+    <|> e (Directive.Field <$ symbol "FIELD")
-variable = dollar *> name
+    <|> e (Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION")
    <|> e (Directive.FragmentSpread <$ "FRAGMENT_SPREAD")
    <|> e (Directive.InlineFragment <$ "INLINE_FRAGMENT")
    <|> t (Directive.Schema <$ symbol "SCHEMA")
    <|> t (Directive.Scalar <$ symbol "SCALAR")
    <|> t (Directive.Object <$ symbol "OBJECT")
    <|> t (Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION")
    <|> t (Directive.Interface <$ symbol "INTERFACE")
    <|> t (Directive.Union <$ symbol "UNION")
    <|> t (Directive.EnumValue <$ symbol "ENUM_VALUE")
    <|> t (Directive.Enum <$ symbol "ENUM")
    <|> t (Directive.InputObject <$ symbol "INPUT_OBJECT")
    <|> t (Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION")
    <?> "DirectiveLocation"
  where
    e = fmap Directive.ExecutableDirectiveLocation
    t = fmap Directive.TypeSystemDirectiveLocation
-defaultValue :: Parser Value
+typeDefinition :: Full.Description -> Parser Full.TypeDefinition
-defaultValue = equals *> value
+typeDefinition description' = scalarTypeDefinition description'
    <|> objectTypeDefinition description'
    <|> interfaceTypeDefinition description'
    <|> unionTypeDefinition description'
    <|> enumTypeDefinition description'
    <|> inputObjectTypeDefinition description'
    <?> "TypeDefinition"
-- * Input Types
+typeExtension :: Parser Full.TypeExtension
 typeExtension = scalarTypeExtension
    <|> objectTypeExtension
    <|> interfaceTypeExtension
    <|> unionTypeExtension
    <|> enumTypeExtension
    <|> inputObjectTypeExtension
    <?> "TypeExtension"
-type_ :: Parser Type
+scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
-type_ = try (TypeNonNull <$> nonNullType)
+scalarTypeDefinition description' = Full.ScalarTypeDefinition description'
-    <|> TypeList <$> brackets type_
+    <$ symbol "scalar"
-    <|> TypeNamed <$> name
+    <*> name
-    <?> "type_ error!"
+    <*> directives
    <?> "ScalarTypeDefinition"
-nonNullType :: Parser NonNullType
+scalarTypeExtension :: Parser Full.TypeExtension
-nonNullType = NonNullTypeNamed <$> name <* bang
+scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
-          <|> NonNullTypeList  <$> brackets type_  <* bang
+    $ (Full.ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
          <?> "nonNullType error!"
-- * Directives
+objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 objectTypeDefinition description' = Full.ObjectTypeDefinition description'
    <$ symbol "type"
    <*> name
    <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "ObjectTypeDefinition"
-directives :: Parser [Directive]
+objectTypeExtension :: Parser Full.TypeExtension
-directives = some directive
+objectTypeExtension = extend "type" "ObjectTypeExtension"
    $ fieldsDefinitionExtension :|
        [ directivesExtension
        , implementsInterfacesExtension
        ]
  where
    fieldsDefinitionExtension = Full.ObjectTypeFieldsDefinitionExtension
        <$> name
        <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
    directivesExtension = Full.ObjectTypeDirectivesExtension
        <$> name
        <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> NonEmpty.some directive
    implementsInterfacesExtension = Full.ObjectTypeImplementsInterfacesExtension
        <$> name
        <*> implementsInterfaces NonEmpty.sepBy1
-directive :: Parser Directive
+description :: Parser Full.Description
-directive = Directive
+description = Full.Description
-        <$  at
+    <$> optional stringValue
-        <*> name
+    <?> "Description"
        <*> opt arguments
-- * Internal
+unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 unionTypeDefinition description' = Full.UnionTypeDefinition description'
    <$ symbol "union"
    <*> name
    <*> directives
    <*> option (Full.UnionMemberTypes []) (unionMemberTypes sepBy1)
    <?> "UnionTypeDefinition"
-opt :: Monoid a => Parser a -> Parser a
+unionTypeExtension :: Parser Full.TypeExtension
-opt = option mempty
+unionTypeExtension = extend "union" "UnionTypeExtension"
    $ unionMemberTypesExtension :| [directivesExtension]
  where
    unionMemberTypesExtension = Full.UnionTypeUnionMemberTypesExtension
        <$> name
        <*> directives
        <*> unionMemberTypes NonEmpty.sepBy1
    directivesExtension = Full.UnionTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 unionMemberTypes ::
    Foldable t =>
    (Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
    Parser (Full.UnionMemberTypes t)
 unionMemberTypes sepBy' = Full.UnionMemberTypes
    <$ equals
    <* optional pipe
    <*> name `sepBy'` pipe
    <?> "UnionMemberTypes"
 interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
    <$ symbol "interface"
    <*> name
    <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "InterfaceTypeDefinition"
 interfaceTypeExtension :: Parser Full.TypeExtension
 interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
    $ fieldsDefinitionExtension :| [directivesExtension]
  where
    fieldsDefinitionExtension = Full.InterfaceTypeFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
    directivesExtension = Full.InterfaceTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 enumTypeDefinition description' = Full.EnumTypeDefinition description'
    <$ symbol "enum"
    <*> name
    <*> directives
    <*> listOptIn braces enumValueDefinition
    <?> "EnumTypeDefinition"
 enumTypeExtension :: Parser Full.TypeExtension
 enumTypeExtension = extend "enum" "EnumTypeExtension"
    $ enumValuesDefinitionExtension :| [directivesExtension]
  where
    enumValuesDefinitionExtension = Full.EnumTypeEnumValuesDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some enumValueDefinition)
    directivesExtension = Full.EnumTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 inputObjectTypeDefinition description' = Full.InputObjectTypeDefinition description'
    <$ symbol "input"
    <*> name
    <*> directives
    <*> listOptIn braces inputValueDefinition
    <?> "InputObjectTypeDefinition"
 inputObjectTypeExtension :: Parser Full.TypeExtension
 inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
    $ inputFieldsDefinitionExtension :| [directivesExtension]
  where
    inputFieldsDefinitionExtension = Full.InputObjectTypeInputFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some inputValueDefinition)
    directivesExtension = Full.InputObjectTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 enumValueDefinition :: Parser Full.EnumValueDefinition
 enumValueDefinition = Full.EnumValueDefinition
    <$> description
    <*> enumValue
    <*> directives
    <?> "EnumValueDefinition"
 implementsInterfaces ::
    Foldable t =>
    (Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
    Parser (Full.ImplementsInterfaces t)
 implementsInterfaces sepBy' = Full.ImplementsInterfaces
    <$ symbol "implements"
    <* optional amp
    <*> name `sepBy'` amp
    <?> "ImplementsInterfaces"
 inputValueDefinition :: Parser Full.InputValueDefinition
 inputValueDefinition = Full.InputValueDefinition
    <$> description
    <*> name
    <* colon
    <*> type'
    <*> defaultValue
    <*> directives
    <?> "InputValueDefinition"
 argumentsDefinition :: Parser Full.ArgumentsDefinition
 argumentsDefinition = Full.ArgumentsDefinition
    <$> listOptIn parens inputValueDefinition
    <?> "ArgumentsDefinition"
 fieldDefinition :: Parser Full.FieldDefinition
 fieldDefinition = Full.FieldDefinition
    <$> description
    <*> name
    <*> argumentsDefinition
    <* colon
    <*> type'
    <*> directives
    <?> "FieldDefinition"
 schemaDefinition :: Parser Full.TypeSystemDefinition
 schemaDefinition = Full.SchemaDefinition
    <$ symbol "schema"
    <*> directives
    <*> operationTypeDefinitions
    <?> "SchemaDefinition"
 operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition)
 operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
 schemaExtension :: Parser Full.SchemaExtension
 schemaExtension = extend "schema" "SchemaExtension"
    $ schemaOperationExtension :| [directivesExtension]
  where
    directivesExtension = Full.SchemaDirectivesExtension
        <$> NonEmpty.some directive
    schemaOperationExtension = Full.SchemaOperationExtension
        <$> directives
        <*> operationTypeDefinitions
 operationTypeDefinition :: Parser Full.OperationTypeDefinition
 operationTypeDefinition = Full.OperationTypeDefinition
    <$> operationType <* colon
    <*> name
    <?> "OperationTypeDefinition"
 operationDefinition :: Parser Full.OperationDefinition
 operationDefinition = shorthand
    <|> operationDefinition'
    <?> "OperationDefinition"
  where
    shorthand = do
        location <- getLocation
        selectionSet' <- selectionSet
        pure $ Full.SelectionSet selectionSet' location
    operationDefinition' = do
        location <- getLocation
        operationType' <- operationType
        operationName <- optional name
        variableDefinitions' <- variableDefinitions
        directives' <- directives
        selectionSet' <- selectionSet
        pure $ Full.OperationDefinition
            operationType'
            operationName
            variableDefinitions'
            directives'
            selectionSet'
            location
 operationType :: Parser Full.OperationType
 operationType = Full.Query <$ symbol "query"
    <|> Full.Mutation <$ symbol "mutation"
    <|> Full.Subscription <$ symbol "subscription"
    <?> "OperationType"
 selectionSet :: Parser Full.SelectionSet
 selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
 selectionSetOpt :: Parser Full.SelectionSetOpt
 selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
 selection :: Parser Full.Selection
 selection = Full.FieldSelection <$> field
    <|> Full.FragmentSpreadSelection <$> try fragmentSpread
    <|> Full.InlineFragmentSelection <$> inlineFragment
    <?> "Selection"
 field :: Parser Full.Field
 field = label "Field" $ do
    location <- getLocation
    alias' <- optional alias
    name' <- name
    arguments' <- arguments
    directives' <- directives
    selectionSetOpt' <- selectionSetOpt
    pure $ Full.Field alias' name' arguments' directives' selectionSetOpt' location
 alias :: Parser Full.Name
 alias = try (name <* colon) <?> "Alias"
 arguments :: Parser [Full.Argument]
 arguments = listOptIn parens argument <?> "Arguments"
 argument :: Parser Full.Argument
 argument = label "Argument" $ do
    location <- getLocation
    name' <- name
    colon
    value' <- valueNode value
    pure $ Full.Argument name' value' location
 fragmentSpread :: Parser Full.FragmentSpread
 fragmentSpread = label "FragmentSpread" $ do
    location <- getLocation
    _ <- spread
    fragmentName' <- fragmentName
    directives' <- directives
    pure $ Full.FragmentSpread fragmentName' directives' location
 inlineFragment :: Parser Full.InlineFragment
 inlineFragment = label "InlineFragment" $ do
    location <- getLocation
    _ <- spread
    typeCondition' <- optional typeCondition
    directives' <- directives
    selectionSet' <- selectionSet
    pure $ Full.InlineFragment typeCondition' directives' selectionSet' location
 fragmentDefinition :: Parser Full.FragmentDefinition
 fragmentDefinition =  label "FragmentDefinition" $ do
    location <- getLocation
    _ <- symbol "fragment"
    fragmentName' <- name
    typeCondition' <- typeCondition
    directives' <- directives
    selectionSet' <- selectionSet
    pure $ Full.FragmentDefinition
        fragmentName' typeCondition' directives' selectionSet' location
 fragmentName :: Parser Full.Name
 fragmentName = but (symbol "on") *> name <?> "FragmentName"
 typeCondition :: Parser Full.TypeCondition
 typeCondition = symbol "on" *> name <?> "TypeCondition"
 valueNode :: forall a. Parser a -> Parser (Full.Node a)
 valueNode valueParser = do
    location <- getLocation
    value' <- valueParser
    pure $ Full.Node value' location
 value :: Parser Full.Value
 value = Full.Variable <$> variable
    <|> Full.Float <$> try float
    <|> Full.Int <$> integer
    <|> Full.Boolean <$> booleanValue
    <|> Full.Null <$  nullValue
    <|> Full.String <$> stringValue
    <|> Full.Enum <$> try enumValue
    <|> Full.List <$> brackets (many $ valueNode value)
    <|> Full.Object <$> braces (many $ objectField $ valueNode value)
    <?> "Value"
 constValue :: Parser Full.ConstValue
 constValue = Full.ConstFloat <$> try float
    <|> Full.ConstInt <$> integer
    <|> Full.ConstBoolean <$> booleanValue
    <|> Full.ConstNull <$ nullValue
    <|> Full.ConstString <$> stringValue
    <|> Full.ConstEnum <$> try enumValue
    <|> Full.ConstList <$> brackets (many $ valueNode constValue)
    <|> Full.ConstObject <$> braces (many $ objectField $ valueNode constValue)
    <?> "Value"
 booleanValue :: Parser Bool
 booleanValue = True  <$ symbol "true"
    <|> False <$ symbol "false"
    <?> "BooleanValue"
 enumValue :: Parser Full.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 :: forall a. Parser (Full.Node a) -> Parser (Full.ObjectField a)
 objectField valueParser = label "ObjectField" $ do
    location <- getLocation
    fieldName <- name
    colon
    fieldValue <- valueParser
    pure $ Full.ObjectField fieldName fieldValue location
 variableDefinitions :: Parser [Full.VariableDefinition]
 variableDefinitions = listOptIn parens variableDefinition
    <?> "VariableDefinitions"
 variableDefinition :: Parser Full.VariableDefinition
 variableDefinition = label "VariableDefinition" $ do
    location <- getLocation
    variableName <- variable
    colon
    variableType <- type'
    variableValue <- defaultValue
    pure $ Full.VariableDefinition variableName variableType variableValue location
 variable :: Parser Full.Name
 variable = dollar *> name <?> "Variable"
 defaultValue :: Parser (Maybe (Full.Node Full.ConstValue))
 defaultValue = optional (equals *> valueNode constValue) <?> "DefaultValue"
 type' :: Parser Full.Type
 type' = try (Full.TypeNonNull <$> nonNullType)
    <|> Full.TypeList <$> brackets type'
    <|> Full.TypeNamed <$> name
    <?> "Type"
 nonNullType :: Parser Full.NonNullType
 nonNullType = Full.NonNullTypeNamed <$> name <* bang
    <|> Full.NonNullTypeList  <$> brackets type'  <* bang
    <?> "NonNullType"
 directives :: Parser [Full.Directive]
 directives = many directive <?> "Directives"
 directive :: Parser Full.Directive
 directive = label "Directive" $ do
    location <- getLocation
    at
    directiveName <- name
    directiveArguments <- arguments
    pure $ Full.Directive directiveName directiveArguments location
 listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
 listOptIn surround = option [] . surround . some
 -- Hack to reverse parser success
 but :: Parser a -> Parser ()
 but pn = False <$ lookAhead pn <|> pure True >>= \case
    False -> empty
    True  -> pure ()
 manyNE :: Alternative f => f a -> f (NonEmpty a)
 manyNE p = (:|) <$> p <*> many p
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -1,85 +1,93 @@
-{-# LANGUAGE OverloadedStrings #-}
+{- 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 DuplicateRecordFields #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | Error handling.
 module Language.GraphQL.Error
-    ( parseError
+    ( Error(..)
-    , CollectErrsT
+    , Path(..)
-    , addErr
+    , ResolverException(..)
-    , addErrMsg
+    , Response(..)
-    , runCollectErrs
+    , ResponseEventStream
-    , runAppendErrs
+    , parseError
    , singleError
    ) where
-import qualified Data.Aeson as Aeson
+import Conduit
 import Control.Exception (Exception(..))
 import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
-import Data.Void (Void)
+import qualified Data.Text as Text
-import Control.Monad.Trans.Class (lift)
+import Language.GraphQL.AST (Location(..))
-import Control.Monad.Trans.State ( StateT
+import Language.GraphQL.Execute.Coerce
-                                 , modify
+import Prelude hiding (null)
-                                 , runStateT
+import Text.Megaparsec
-                                 )
+    ( ParseErrorBundle(..)
-import Text.Megaparsec ( ParseErrorBundle(..)
+    , PosState(..)
-                       , SourcePos(..)
+    , SourcePos(..)
-                       , errorOffset
+    , errorOffset
-                       , parseErrorTextPretty
+    , parseErrorTextPretty
-                       , reachOffset
+    , reachOffset
-                       , unPos
+    , unPos
-                       )
+    )
 -- | 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
+    errorObject s SourcePos{..} = Error
-        [ ("message", Aeson.toJSON $ init $ parseErrorTextPretty s)
+        { message = Text.pack $ init $ parseErrorTextPretty s
-        , ("line", Aeson.toJSON $ unPos sourceLine)
+        , locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
-        , ("column", Aeson.toJSON $ unPos sourceColumn)
+        , path = []
-        ]
+        }
    unPos' = fromIntegral . unPos
    go (result, state) x =
-        let (sourcePosition, _, newState) = reachOffset (errorOffset x) state
+        let (_, newState) = reachOffset (errorOffset x) state
-         in (errorObject x sourcePosition : result, newState)
+            sourcePosition = pstateSourcePos newState
         in (result |> errorObject x sourcePosition, newState)
-- | A wrapper to pass error messages around.
+-- | If an error can be associated to a particular field in the GraphQL result,
-type CollectErrsT m = StateT [Aeson.Value] m
+-- 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)
-- | Adds an error to the list of errors.
+-- | @GraphQL@ error.
-addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
+data Error = Error
-addErr v = modify (v :)
+    { message :: Text
    , locations :: [Location]
    , path :: [Path]
    } deriving (Eq, Show)
-makeErrorMessage :: Text -> Aeson.Value
+-- | The server\'s response describes the result of executing the requested
-makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
+-- operation if successful, and describes any errors encountered during the
 -- request.
 data Response a = Response
    { data' :: a
    , errors :: Seq Error
    } deriving (Eq, Show)
-- | Constructs a response object containing only the error with the given
+-- | Each event in the underlying Source Stream triggers execution of the
--   message.
+-- subscription selection set. The results of the execution generate a Response
-singleError :: Text -> Aeson.Value
+-- Stream.
-singleError message = Aeson.object
+type ResponseEventStream m a = ConduitT () (Response a) m ()
    [ ("errors", Aeson.toJSON [makeErrorMessage message])
    ]
-- | Convenience function for just wrapping an error message.
+-- | Only exceptions that inherit from 'ResolverException' a cought by the
-addErrMsg :: Monad m => Text -> CollectErrsT m ()
+-- executor.
-addErrMsg = addErr . makeErrorMessage
+data ResolverException = forall e. Exception e => ResolverException e
-- | Appends the given list of errors to the current list of errors.
+instance Show ResolverException where
-appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
+    show (ResolverException e) = show e
 appendErrs errs = modify (errs ++)
-- | Runs the given query computation, but collects the errors into an error
+instance Exception ResolverException
 --   list, which is then sent back with the data.
 runCollectErrs :: Monad m => CollectErrsT m Aeson.Value -> m Aeson.Value
 runCollectErrs res = do
    (dat, errs) <- runStateT res []
    if null errs
       then return $ Aeson.object [("data", dat)]
       else return $ Aeson.object [("data", dat), ("errors", Aeson.toJSON $ reverse errs)]
 -- | Runs the given computation, collecting the errors and appending them
 --   to the previous list of errors.
 runAppendErrs :: Monad m => CollectErrsT m a -> CollectErrsT m a
 runAppendErrs f = do
    (v, errs) <- lift $ runStateT f []
    appendErrs errs
    return v
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -1,38 +1,235 @@
 {- 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 DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeApplications #-}
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
    ( execute
-    , executeWithName
+    , module Language.GraphQL.Execute.Coerce
    ) where
-import Control.Monad.IO.Class (MonadIO)
+import Conduit (mapMC, (.|))
-import qualified Data.Aeson as Aeson
+import Control.Arrow (left)
-import Data.Foldable (toList)
+import Control.Monad.Catch
     ( Exception(..)
     , Handler(..)
     , MonadCatch(..)
     , MonadThrow(..)
     , SomeException(..)
     , catches
     )
 import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT)
 import Control.Monad.Trans.Writer (WriterT(..), runWriterT)
 import qualified Control.Monad.Trans.Writer as Writer
 import Control.Monad (foldM)
 import qualified Language.GraphQL.AST.Document as Full
 import Data.Foldable (find)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NE
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 import qualified Data.Vector as Vector
 import Data.Text (Text)
 import qualified Data.Text as Text
-import qualified Language.GraphQL.AST as AST
+import Data.Typeable (cast)
-import qualified Language.GraphQL.AST.Core as AST.Core
+import GHC.Records (HasField(..))
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.OrderedMap (OrderedMap)
 import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
 import qualified Language.GraphQL.Execute.Transform as Transform
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.Internal as Type.Internal
 import Language.GraphQL.Type.Schema (Schema, Type)
 import qualified Language.GraphQL.Type.Schema as Schema
 import Language.GraphQL.Error
-import qualified Language.GraphQL.Schema as Schema
+    ( Error(..)
    , Response(..)
    , Path(..)
    , ResolverException(..)
    , ResponseEventStream
    )
 import Prelude hiding (null)
 import Language.GraphQL.AST.Document (showVariableName)
-- | The substitution is applied to the document, and the resolvers are applied
+newtype ExecutorT m a = ExecutorT
-- to the resulting fields.
+    { runExecutorT :: ReaderT (HashMap Full.Name (Type m)) (WriterT (Seq Error) m) a
--
+    }
-- Returns the result of the query against the schema wrapped in a /data/
+
-- field, or errors wrapped in an /errors/ field.
+instance Functor m => Functor (ExecutorT m) where
-execute :: MonadIO m
+    fmap f = ExecutorT . fmap f . runExecutorT
-    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
+
-    -> Schema.Subs -- ^ Variable substitution function.
+instance Applicative m => Applicative (ExecutorT m) where
-    -> AST.Document -- @GraphQL@ document.
+    pure = ExecutorT . pure
-    -> m Aeson.Value
+    ExecutorT f <*> ExecutorT x = ExecutorT $ f <*> x
-execute schema subs doc =
+
-    maybe transformError (document schema Nothing) $ Transform.document subs doc
+instance Monad m => Monad (ExecutorT m) where
-  where
+    ExecutorT x >>= f = ExecutorT $ x >>= runExecutorT . f
-    transformError = return $ singleError "Schema transformation error."
+
 instance MonadTrans ExecutorT where
    lift = ExecutorT . lift . lift
 instance MonadThrow m => MonadThrow (ExecutorT m) where
    throwM = lift . throwM
 instance MonadCatch m => MonadCatch (ExecutorT m) where
  catch (ExecutorT stack) handler =
      ExecutorT $ catch stack $ runExecutorT . handler
 data GraphQLException = forall e. Exception e => GraphQLException e
 instance Show GraphQLException where
    show (GraphQLException e) = show e
 instance Exception GraphQLException
 graphQLExceptionToException :: Exception e => e -> SomeException
 graphQLExceptionToException = toException . GraphQLException
 graphQLExceptionFromException :: Exception e => SomeException -> Maybe e
 graphQLExceptionFromException e = do
    GraphQLException graphqlException <- fromException e
    cast graphqlException
 data ResultException = forall e. Exception e => ResultException e
 instance Show ResultException where
    show (ResultException e) = show e
 instance Exception ResultException where
    toException = graphQLExceptionToException
    fromException = graphQLExceptionFromException
 resultExceptionToException :: Exception e => e -> SomeException
 resultExceptionToException = toException . ResultException
 resultExceptionFromException :: Exception e => SomeException -> Maybe e
 resultExceptionFromException e = do
    ResultException resultException <- fromException e
    cast resultException
 data FieldException = forall e. Exception e => FieldException Full.Location [Path] e
 instance Show FieldException where
    show (FieldException _ _ e) = displayException e
 instance Exception FieldException where
    toException = graphQLExceptionToException
    fromException = graphQLExceptionFromException
 data ValueCompletionException = ValueCompletionException String Type.Value
 instance Show ValueCompletionException where
    show (ValueCompletionException typeRepresentation found) = concat
        [ "Value completion error. Expected type "
        , typeRepresentation
        , ", found: "
        , show found
        , "."
        ]
 instance Exception ValueCompletionException where
    toException = resultExceptionToException
    fromException = resultExceptionFromException
 data InputCoercionException =
    InputCoercionException String In.Type (Maybe (Full.Node Transform.Input))
 instance Show InputCoercionException where
    show (InputCoercionException argumentName argumentType Nothing) = concat
        [ "Required argument \""
        , argumentName
        , "\" of type "
        , show argumentType
        , " not specified."
        ]
    show (InputCoercionException argumentName argumentType (Just givenValue)) = concat
        [ "Argument \""
        , argumentName
        , "\" has invalid type. Expected type "
        , show argumentType
        , ", found: "
        , show givenValue
        , "."
        ]
 instance Exception InputCoercionException where
    toException = graphQLExceptionToException
    fromException = graphQLExceptionFromException
 newtype ResultCoercionException = ResultCoercionException String
 instance Show ResultCoercionException where
    show (ResultCoercionException typeRepresentation) = concat
        [ "Unable to coerce result to "
        , typeRepresentation
        , "."
        ]
 instance Exception ResultCoercionException where
    toException = resultExceptionToException
    fromException = resultExceptionFromException
 -- | Query error types.
 data QueryError
    = OperationNameRequired
    | OperationNotFound String
    | CoercionError Full.VariableDefinition
    | UnknownInputType Full.VariableDefinition
 tell :: Monad m => Seq Error -> ExecutorT m ()
 tell = ExecutorT . lift . Writer.tell
 operationNameErrorText :: Text
 operationNameErrorText = Text.unlines
    [ "Named operations must be provided with the name of the desired operation."
    , "See https://spec.graphql.org/June2018/#sec-Language.Document description."
    ]
 queryError :: QueryError -> Error
 queryError OperationNameRequired =
    let queryErrorMessage = "Operation name is required. " <> operationNameErrorText
    in Error{ message = queryErrorMessage, locations = [], path = [] }
 queryError (OperationNotFound operationName) =
    let queryErrorMessage = Text.unlines
            [ Text.concat
              [ "Operation \""
              , Text.pack operationName
              , "\" is not found in the named operations you've provided. "
              ]
            , operationNameErrorText
            ]
     in Error{ message = queryErrorMessage, locations = [], path = [] }
 queryError (CoercionError variableDefinition) =
    let (Full.VariableDefinition _ _ _ location) = variableDefinition
        queryErrorMessage = Text.concat
            [ "Failed to coerce the variable "
            , Text.pack $ Full.showVariable variableDefinition
            , "."
            ]
     in Error{ message = queryErrorMessage, locations = [location], path = [] }
 queryError (UnknownInputType variableDefinition) =
    let Full.VariableDefinition _ variableTypeName _ location = variableDefinition
        queryErrorMessage = Text.concat
            [ "Variable "
            , Text.pack $ showVariableName variableDefinition
            , " has unknown type "
            , Text.pack $ show variableTypeName
            , "."
            ]
     in Error{ message = queryErrorMessage, locations = [location], path = [] }
 -- | 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
@ -40,38 +237,489 @@ execute schema subs doc =
 --
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
-executeWithName :: MonadIO m
+execute :: (MonadCatch m, VariableValue a, Serialize b)
-    => NonEmpty (Schema.Resolver m) -- ^ Resolvers
+    => Schema m -- ^ Resolvers.
-    -> Text -- ^ Operation name.
+    -> Maybe Text -- ^ Operation name.
-    -> Schema.Subs -- ^ Variable substitution function.
+    -> HashMap Full.Name a -- ^ Variable substitution function.
-    -> AST.Document -- ^ @GraphQL@ Document.
+    -> Full.Document -- @GraphQL@ document.
-    -> m Aeson.Value
+    -> m (Either (ResponseEventStream m b) (Response b))
-executeWithName schema name subs doc =
+execute schema' operationName subs document' =
-    maybe transformError (document schema $ Just name) $ Transform.document subs doc
+    executeRequest schema' document' (Text.unpack <$> operationName) subs
  where
    transformError = return $ singleError "Schema transformation error."
-document :: MonadIO m
+executeRequest :: (MonadCatch m, Serialize a, VariableValue b)
-    => NonEmpty (Schema.Resolver m)
+    => Schema m
-    -> Maybe Text
+    -> Full.Document
-    -> AST.Core.Document
+    -> Maybe String
-    -> m Aeson.Value
+    -> HashMap Full.Name b
-document schema Nothing (op :| []) = operation schema op
+    -> m (Either (ResponseEventStream m a) (Response a))
-document schema (Just name) operations = case NE.dropWhile matchingName operations of
+executeRequest schema sourceDocument operationName variableValues = do
-    [] -> return $ singleError
+    operationAndVariables <- sequence buildOperation
-        $ Text.unwords ["Operation", name, "couldn't be found in the document."]
+    case operationAndVariables of
-    (op:_)  -> operation schema op
+        Left queryError' -> pure
            $ Right
            $ Response null $ pure $ queryError queryError'
        Right operation
            | Transform.Operation Full.Query topSelections _operationLocation <- operation ->
                 Right <$> executeQuery topSelections schema
            | Transform.Operation Full.Mutation topSelections operationLocation <- operation ->
                Right <$> executeMutation topSelections schema operationLocation
            | Transform.Operation Full.Subscription topSelections operationLocation <- operation ->
                either rightErrorResponse Left <$> subscribe topSelections schema operationLocation
  where
-    matchingName (AST.Core.Query (Just name') _) = name == name'
+    schemaTypes = Schema.types schema
-    matchingName (AST.Core.Mutation (Just name') _) = name == name'
+    (operationDefinitions, fragmentDefinitions') =
-    matchingName _ = False
+        Transform.document sourceDocument
-document _ _ _ = return $ singleError "Missing operation name."
+    buildOperation = do
        operationDefinition <- getOperation operationDefinitions operationName
        coercedVariableValues <- coerceVariableValues
            schemaTypes
            operationDefinition
            variableValues
        let replacement = Transform.Replacement
                { variableValues = coercedVariableValues
                , fragmentDefinitions = fragmentDefinitions'
                , visitedFragments = mempty
                , types = schemaTypes
                }
        pure $ flip runReaderT replacement
            $ Transform.runTransformT
            $ Transform.transform operationDefinition
-operation :: MonadIO m
+rightErrorResponse :: Serialize b => forall a. Error -> Either a (Response b)
-    => NonEmpty (Schema.Resolver m)
+rightErrorResponse = Right . Response null . pure
-    -> AST.Core.Operation
+
-    -> m Aeson.Value
+getOperation :: [Full.OperationDefinition] -> Maybe String -> Either QueryError Full.OperationDefinition
-operation schema (AST.Core.Query _ flds)
+getOperation [operation] Nothing = Right operation
-    = runCollectErrs (Schema.resolve (toList schema) flds)
+getOperation operations (Just givenOperationName)
-operation schema (AST.Core.Mutation _ flds)
+    = maybe (Left $ OperationNotFound givenOperationName) Right
-    = runCollectErrs (Schema.resolve (toList schema) flds)
+    $ find findOperationByName operations
  where
    findOperationByName (Full.OperationDefinition _ (Just operationName) _ _ _ _) =
        givenOperationName == Text.unpack operationName
    findOperationByName _ = False
 getOperation _ _ = Left OperationNameRequired
 executeQuery :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> m (Response a)
 executeQuery topSelections schema = do
    let queryType = Schema.query schema
    (data', errors) <- runWriterT
        $ flip runReaderT (Schema.types schema)
        $ runExecutorT
        $ catch (executeSelectionSet topSelections queryType Type.Null [])
        handleException
    pure $ Response data' errors
 handleException :: (MonadCatch m, Serialize a)
    => FieldException
    -> ExecutorT m a
 handleException (FieldException fieldLocation errorPath next) =
    let newError = constructError next fieldLocation errorPath
     in tell (Seq.singleton newError) >> pure null
 constructError :: Exception e => e -> Full.Location -> [Path] -> Error
 constructError e fieldLocation errorPath = Error
    { message = Text.pack (displayException e)
    , path = reverse errorPath
    , locations = [fieldLocation]
    }
 executeMutation :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> Full.Location
    -> m (Response a)
 executeMutation topSelections schema operationLocation
    | Just mutationType <- Schema.mutation schema = do
        (data', errors) <- runWriterT
            $ flip runReaderT (Schema.types schema)
            $ runExecutorT
            $ catch (executeSelectionSet topSelections mutationType Type.Null [])
            handleException
        pure $ Response data' errors
    | otherwise = pure
        $ Response null
        $ Seq.singleton
        $ Error "Schema doesn't support mutations." [operationLocation] []
 executeSelectionSet :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Out.ObjectType m
    -> Type.Value
    -> [Path]
    -> ExecutorT m a
 executeSelectionSet selections objectType objectValue errorPath = do
    let groupedFieldSet = collectFields objectType selections
    resolvedValues <- OrderedMap.traverseMaybe go groupedFieldSet
    coerceResult (Out.NonNullObjectType objectType) $ Object resolvedValues
  where
    executeField' fields resolver =
        executeField objectValue fields resolver errorPath
    Out.ObjectType _ _ _ resolvers = objectType
    go fields@(Transform.Field _ fieldName _ _ _ :| _) =
        traverse (executeField' fields) $ HashMap.lookup fieldName resolvers
 fieldsSegment :: forall m. NonEmpty (Transform.Field m) -> Path
 fieldsSegment (Transform.Field alias fieldName _ _ _ :| _) =
    Segment (fromMaybe fieldName alias)
 viewResolver :: Out.Resolver m -> (Out.Field m, Out.Resolve m)
 viewResolver (Out.ValueResolver resolverField' resolveFunction) =
    (resolverField', resolveFunction)
 viewResolver (Out.EventStreamResolver resolverField' resolveFunction _) =
    (resolverField', resolveFunction)
 executeField :: forall m a
    . (MonadCatch m, Serialize a)
    => Type.Value
    -> NonEmpty (Transform.Field m)
    -> Out.Resolver m
    -> [Path]
    -> ExecutorT m a
 executeField objectValue fields (viewResolver -> resolverPair) errorPath =
    let Transform.Field _ fieldName inputArguments _ fieldLocation :| _ = fields
     in catches (go fieldName inputArguments)
        [ Handler nullResultHandler
        , Handler (inputCoercionHandler fieldLocation)
        , Handler (resultHandler fieldLocation)
        , Handler (resolverHandler fieldLocation)
        ]
  where
    fieldErrorPath = fieldsSegment fields : errorPath
    inputCoercionHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> InputCoercionException
        -> ExecutorT m a
    inputCoercionHandler _ e@(InputCoercionException _ _ (Just valueNode)) =
        let argumentLocation = getField @"location" valueNode
         in exceptionHandler argumentLocation e
    inputCoercionHandler fieldLocation e = exceptionHandler fieldLocation e
    resultHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> ResultException
        -> ExecutorT m a
    resultHandler = exceptionHandler
    resolverHandler :: (MonadCatch m, Serialize a)
        => Full.Location
        -> ResolverException
        -> ExecutorT m a
    resolverHandler = exceptionHandler
    nullResultHandler :: (MonadCatch m, Serialize a)
        => FieldException
        -> ExecutorT m a
    nullResultHandler e@(FieldException fieldLocation errorPath' next) =
        let newError = constructError next fieldLocation errorPath'
         in if Out.isNonNullType fieldType
             then throwM e
             else returnError newError
    exceptionHandler errorLocation e =
        let newError = constructError e errorLocation fieldErrorPath
         in if Out.isNonNullType fieldType
             then throwM $ FieldException errorLocation fieldErrorPath e
             else returnError newError
    returnError newError = tell (Seq.singleton newError) >> pure null
    go fieldName inputArguments = do
        argumentValues <- coerceArgumentValues argumentTypes inputArguments
        resolvedValue <-
           resolveFieldValue resolveFunction objectValue fieldName argumentValues
        completeValue fieldType fields fieldErrorPath resolvedValue
    (resolverField, resolveFunction) = resolverPair
    Out.Field _ fieldType argumentTypes = resolverField
 resolveFieldValue :: MonadCatch m
    => Out.Resolve m
    -> Type.Value
    -> Full.Name
    -> Type.Subs
    -> ExecutorT m Type.Value
 resolveFieldValue resolver objectValue _fieldName argumentValues =
    lift $ runReaderT resolver context
  where
    context = Type.Context
        { Type.arguments = Type.Arguments argumentValues
        , Type.values = objectValue
        }
 resolveAbstractType :: Monad m
    => Type.Internal.AbstractType m
    -> Type.Subs
    -> ExecutorT m (Maybe (Out.ObjectType m))
 resolveAbstractType abstractType values'
    | Just (Type.String typeName) <- HashMap.lookup "__typename" values' = do
        types' <- ExecutorT ask
        case HashMap.lookup typeName types' of
            Just (Type.Internal.ObjectType objectType) ->
                if Type.Internal.instanceOf objectType abstractType
                    then pure $ Just objectType
                    else pure Nothing
            _ -> pure Nothing
    | otherwise = pure Nothing
 -- https://spec.graphql.org/October2021/#sec-Value-Completion
 completeValue :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> NonEmpty (Transform.Field m)
    -> [Path]
    -> Type.Value
    -> ExecutorT m a
 completeValue (Out.isNonNullType -> False) _ _ Type.Null =
    pure null
 completeValue outputType@(Out.ListBaseType listType) fields errorPath (Type.List list)
    = foldM go Vector.empty list >>= coerceResult outputType . List . Vector.toList
  where
    go accumulator listItem =
        let updatedPath = Index (Vector.length accumulator) : errorPath
         in Vector.snoc accumulator
            <$> completeValue listType fields updatedPath listItem
 completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Int int) =
    coerceResult outputType $ Int int
 completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Boolean boolean) =
    coerceResult outputType $ Boolean boolean
 completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.Float float) =
    coerceResult outputType $ Float float
 completeValue outputType@(Out.ScalarBaseType _) _ _ (Type.String string) =
    coerceResult outputType $ String string
 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 throwM
            $ ValueCompletionException (show outputType)
            $ Type.Enum enum
 completeValue (Out.ObjectBaseType objectType) fields errorPath result
    = executeSelectionSet (mergeSelectionSets fields) objectType result errorPath
 completeValue outputType@(Out.InterfaceBaseType interfaceType) fields errorPath result
    | Type.Object objectMap <- result = do
        let abstractType = Type.Internal.AbstractInterfaceType interfaceType
        concreteType <- resolveAbstractType abstractType objectMap
        case concreteType of
            Just objectType
                -> executeSelectionSet (mergeSelectionSets fields) objectType result
                $ fieldsSegment fields : errorPath
            Nothing -> throwM
                $ ValueCompletionException (show outputType) result
 completeValue outputType@(Out.UnionBaseType unionType) fields errorPath result
    | Type.Object objectMap <- result = do
        let abstractType = Type.Internal.AbstractUnionType unionType
        concreteType <- resolveAbstractType abstractType objectMap
        case concreteType of
            Just objectType
                -> executeSelectionSet (mergeSelectionSets fields) objectType result
                $ fieldsSegment fields : errorPath
            Nothing -> throwM
                $ ValueCompletionException (show outputType) result
 completeValue outputType _ _ result =
    throwM $ ValueCompletionException (show outputType) result
 coerceResult :: (MonadCatch m, Serialize a)
    => Out.Type m
    -> Output a
    -> ExecutorT m a
 coerceResult outputType result
    | Just serialized <- serialize outputType result = pure serialized
    | otherwise = throwM $ ResultCoercionException $ show outputType
 mergeSelectionSets :: MonadCatch m
    => NonEmpty (Transform.Field m)
    -> Seq (Transform.Selection m)
 mergeSelectionSets = foldr forEach mempty
  where
    forEach (Transform.Field _ _ _ fieldSelectionSet _) selectionSet' =
        selectionSet' <> fieldSelectionSet
 coerceArgumentValues :: MonadCatch m
    => HashMap Full.Name In.Argument
    -> HashMap Full.Name (Full.Node Transform.Input)
    -> m Type.Subs
 coerceArgumentValues argumentDefinitions argumentValues =
    HashMap.foldrWithKey c pure argumentDefinitions mempty
  where
    c argumentName argumentType pure' resultMap =
        forEach argumentName argumentType resultMap >>= pure'
    forEach :: MonadCatch m
         => Full.Name
         -> In.Argument
         -> Type.Subs
         -> m Type.Subs
    forEach argumentName (In.Argument _ variableType defaultValue) resultMap = do
        let matchedMap
                = matchFieldValues' argumentName variableType defaultValue
                $ Just resultMap
         in case matchedMap of
            Just matchedValues -> pure matchedValues
            Nothing
                | Just inputValue <- HashMap.lookup argumentName argumentValues
                    -> throwM
                    $ InputCoercionException (Text.unpack argumentName) variableType
                    $ Just inputValue
                | otherwise -> throwM
                    $ InputCoercionException (Text.unpack argumentName) variableType Nothing
    matchFieldValues' = matchFieldValues coerceArgumentValue
        $ Full.node <$> argumentValues
    coerceArgumentValue inputType transform =
      coerceInputLiteral inputType $ extractArgumentValue transform
    extractArgumentValue (Transform.Int integer) = Type.Int integer
    extractArgumentValue (Transform.Boolean boolean) = Type.Boolean boolean
    extractArgumentValue (Transform.String string) = Type.String string
    extractArgumentValue (Transform.Float float) = Type.Float float
    extractArgumentValue (Transform.Enum enum) = Type.Enum enum
    extractArgumentValue Transform.Null = Type.Null
    extractArgumentValue (Transform.List list) =
      Type.List $ extractArgumentValue <$> list
    extractArgumentValue (Transform.Object object) =
      Type.Object $ extractArgumentValue <$> object
    extractArgumentValue (Transform.Variable variable) = variable
 collectFields :: Monad m
    => Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> OrderedMap (NonEmpty (Transform.Field m))
 collectFields objectType = foldl forEach OrderedMap.empty
  where
    forEach groupedFields (Transform.FieldSelection fieldSelection) =
        let Transform.Field maybeAlias fieldName _ _ _ = fieldSelection
            responseKey = fromMaybe fieldName maybeAlias
         in OrderedMap.insert responseKey (fieldSelection :| []) groupedFields
    forEach groupedFields (Transform.FragmentSelection selectionFragment)
        | Transform.Fragment fragmentType fragmentSelectionSet _ <- selectionFragment
        , Type.Internal.doesFragmentTypeApply fragmentType objectType =
            let fragmentGroupedFieldSet =
                    collectFields objectType fragmentSelectionSet
             in groupedFields <> fragmentGroupedFieldSet
        | otherwise = groupedFields
 coerceVariableValues :: (Monad m, VariableValue b)
    => HashMap Full.Name (Schema.Type m)
    -> Full.OperationDefinition
    -> HashMap Full.Name b
    -> Either QueryError Type.Subs
 coerceVariableValues types operationDefinition' variableValues
    | Full.OperationDefinition _ _ variableDefinitions _ _ _ <-
        operationDefinition'
    = foldr forEach (Right HashMap.empty) variableDefinitions
    | otherwise = pure mempty
  where
    forEach variableDefinition (Right coercedValues) =
        let Full.VariableDefinition variableName variableTypeName defaultValue _ =
                variableDefinition
            defaultValue' = constValue . Full.node <$> defaultValue
         in case Type.Internal.lookupInputType variableTypeName types of
            Just variableType ->
                maybe (Left $ CoercionError variableDefinition) Right
                    $ matchFieldValues
                        coerceVariableValue'
                        variableValues
                        variableName
                        variableType
                        defaultValue'
                    $ Just coercedValues
            Nothing -> Left $ UnknownInputType variableDefinition
    forEach _ coercedValuesOrError = coercedValuesOrError
    coerceVariableValue' variableType value'
        = coerceVariableValue variableType value'
        >>= coerceInputLiteral variableType
 constValue :: Full.ConstValue -> Type.Value
 constValue (Full.ConstInt i) = Type.Int i
 constValue (Full.ConstFloat f) = Type.Float f
 constValue (Full.ConstString x) = Type.String x
 constValue (Full.ConstBoolean b) = Type.Boolean b
 constValue Full.ConstNull = Type.Null
 constValue (Full.ConstEnum e) = Type.Enum e
 constValue (Full.ConstList list) = Type.List $ constValue . Full.node <$> list
 constValue (Full.ConstObject o) =
    Type.Object $ HashMap.fromList $ constObjectField <$> o
  where
    constObjectField Full.ObjectField{value = value', ..} =
        (name, constValue $ Full.node value')
 subscribe :: (MonadCatch m, Serialize a)
    => Seq (Transform.Selection m)
    -> Schema m
    -> Full.Location
    -> m (Either Error (ResponseEventStream m a))
 subscribe fields schema objectLocation
    | Just objectType <- Schema.subscription schema = do
        let types' = Schema.types schema
        sourceStream <-
            createSourceEventStream types' objectType objectLocation fields
        let traverser =
                mapSourceToResponseEvent types' objectType fields
        traverse traverser sourceStream
    | otherwise = pure $ Left
        $ Error "Schema doesn't support subscriptions." [] []
 mapSourceToResponseEvent :: (MonadCatch m, Serialize a)
    => HashMap Full.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 Full.Name (Type m)
    -> Out.ObjectType m
    -> Full.Location
    -> Seq (Transform.Selection m)
    -> m (Either Error (Out.SourceEventStream m))
 createSourceEventStream _types subscriptionType objectLocation fields
    | [fieldGroup] <- OrderedMap.elems groupedFieldSet
    , Transform.Field _ fieldName arguments' _ errorLocation <-
        NonEmpty.head fieldGroup
    , Out.ObjectType _ _ _ fieldTypes <- subscriptionType
    , resolverT <- fieldTypes HashMap.! fieldName
    , Out.EventStreamResolver fieldDefinition _ resolver <- resolverT
    , Out.Field _ _fieldType argumentDefinitions <- fieldDefinition =
        case coerceArgumentValues argumentDefinitions arguments' of
            Left _ -> pure
                $ Left
                $ Error "Argument coercion failed." [errorLocation] []
            Right  argumentValues -> left (singleError [errorLocation])
                <$> resolveFieldEventStream Type.Null argumentValues resolver
    | otherwise = pure
        $ Left
        $ Error "Subscription contains more than one field." [objectLocation] []
  where
    groupedFieldSet = collectFields subscriptionType fields
    singleError :: [Full.Location] -> String -> Error
    singleError errorLocations message = Error (Text.pack message) errorLocations []
 resolveFieldEventStream :: MonadCatch m
    => Type.Value
    -> Type.Subs
    -> Out.Subscribe m
    -> m (Either String (Out.SourceEventStream m))
 resolveFieldEventStream result args resolver =
    catch (Right <$> runReaderT resolver context) handleEventStreamError
  where
    handleEventStreamError :: MonadCatch m
        => ResolverException
        -> m (Either String (Out.SourceEventStream m))
    handleEventStreamError = pure . Left . displayException
    context = Type.Context
        { Type.arguments = Type.Arguments args
        , Type.values = result
        }
 executeSubscriptionEvent :: (MonadCatch m, Serialize a)
    => HashMap Full.Name (Type m)
    -> Out.ObjectType m
    -> Seq (Transform.Selection m)
    -> Type.Value
    -> m (Response a)
 executeSubscriptionEvent types' objectType fields initialValue = do
    (data', errors) <- runWriterT
        $ flip runReaderT types'
        $ runExecutorT
        $ catch (executeSelectionSet fields objectType initialValue [])
        handleException
    pure $ Response data' errors
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@ -0,0 +1,224 @@
 {- 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 #-}
 {-# LANGUAGE ViewPatterns #-}
 -- | Types and functions used for input and result coercion.
 module Language.GraphQL.Execute.Coerce
    ( Output(..)
    , Serialize(..)
    , VariableValue(..)
    , coerceInputLiteral
    , matchFieldValues
    ) 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 qualified Data.Text.Lazy as Text.Lazy
 import qualified Data.Text.Lazy.Builder as Text.Builder
 import qualified Data.Text.Lazy.Builder.Int as Text.Builder
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.Execute.OrderedMap (OrderedMap)
 import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 -- | Since variables are passed separately from the query, in an independent
 -- format, they should be first coerced to the internal representation used by
 -- this implementation.
 class VariableValue a where
    -- | Only a basic, format-specific, coercion must be done here. Type
    -- correctness or nullability shouldn't be validated here, they will be
    -- validated later. The type information is provided only as a hint.
    --
    -- For example @GraphQL@ prohibits the coercion from a 't:Float' to an
    -- 't:Int', but @JSON@ doesn't have integers, so whole numbers should be
    -- coerced to 't:Int` when receiving variables as a JSON object. The same
    -- holds for 't:Enum'. There are formats that support enumerations, @JSON@
    -- doesn't, so the type information is given and 'coerceVariableValue' can
    -- check that an 't:Enum' is expected and treat the given value
    -- appropriately. Even checking whether this value is a proper member of the
    -- corresponding 't:Enum' type isn't required here, since this can be
    -- checked independently.
    --
    -- Another example is an @ID@. @GraphQL@ explicitly allows to coerce
    -- integers and strings to @ID@s, so if an @ID@ is received as an integer,
    -- it can be left as is and will be coerced later.
    --
    -- If a value cannot be coerced without losing information, 'Nothing' should
    -- be returned, the coercion will fail then and the query won't be executed.
    coerceVariableValue
        :: In.Type -- ^ Expected type (variable type given in the query).
        -> a -- ^ Variable value being coerced.
        -> Maybe Type.Value -- ^ Coerced value on success, 'Nothing' otherwise.
 instance VariableValue Type.Value where
    coerceVariableValue _ Type.Null = Just Type.Null
    coerceVariableValue (In.ScalarBaseType _) value = Just value
    coerceVariableValue (In.EnumBaseType _) (Type.Enum stringValue) =
        Just $ Type.Enum stringValue
    coerceVariableValue (In.InputObjectBaseType objectType) value
        | (Type.Object objectValue) <- value = do
            let (In.InputObjectType _ _ inputFields) = objectType
            (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
            if HashMap.null newObjectValue
                then Just $ Type.Object resultMap
                else Nothing
      where
        foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues'
            $ Just (objectValue, HashMap.empty)
        matchFieldValues' _ _ Nothing = Nothing
        matchFieldValues' fieldName inputField (Just (objectValue, resultMap)) =
            let (In.InputField _ fieldType _) = inputField
                insert = flip (HashMap.insert fieldName) resultMap
                newObjectValue = HashMap.delete fieldName objectValue
             in case HashMap.lookup fieldName objectValue of
                    Just variableValue -> do
                        coerced <- coerceVariableValue fieldType variableValue
                        pure (newObjectValue, insert coerced)
                    Nothing -> Just (objectValue, resultMap)
    coerceVariableValue (In.ListBaseType listType) value
        | (Type.List arrayValue) <- value =
            Type.List <$> traverse (coerceVariableValue listType) arrayValue
        | otherwise = coerceVariableValue listType value
    coerceVariableValue _ _ = Nothing
 -- | Looks up a value by name in the given map, coerces it and inserts into the
 -- result map. If the coercion fails, returns 'Nothing'. If the value isn't
 -- given, but a default value is known, inserts the default value into the
 -- result map. Otherwise it fails with 'Nothing' if the Input Type is a
 -- Non-Nullable type, or returns the unchanged, original map.
 matchFieldValues :: forall a
    . (In.Type -> a -> Maybe Type.Value)
    -> HashMap Name a
    -> Name
    -> In.Type
    -> Maybe Type.Value
    -> Maybe (HashMap Name Type.Value)
    -> Maybe (HashMap Name Type.Value)
 matchFieldValues coerce values' fieldName type' defaultValue resultMap =
    case HashMap.lookup fieldName values' of
        Just variableValue -> coerceRuntimeValue $ coerce type' variableValue
        Nothing
            | Just value <- defaultValue ->
                HashMap.insert fieldName value <$> resultMap
            | Nothing <- defaultValue
            , In.isNonNullType type' -> Nothing
            | otherwise -> resultMap
  where
    coerceRuntimeValue (Just Type.Null)
        | In.isNonNullType type' = Nothing
    coerceRuntimeValue coercedValue =
        HashMap.insert fieldName <$> coercedValue <*> resultMap
 -- | Coerces operation arguments according to the input coercion rules for the
 -- corresponding types.
 coerceInputLiteral :: In.Type -> Type.Value -> Maybe Type.Value
 coerceInputLiteral (In.isNonNullType -> False) Type.Null = Just Type.Null
 coerceInputLiteral (In.ScalarBaseType type') value
    | (Type.String stringValue) <- value
    , (Type.ScalarType "String" _) <- type' = Just $ Type.String stringValue
    | (Type.Boolean booleanValue) <- value
    , (Type.ScalarType "Boolean" _) <- type' = Just $ Type.Boolean booleanValue
    | (Type.Int intValue) <- value
    , (Type.ScalarType "Int" _) <- type' = Just $ Type.Int intValue
    | (Type.Float floatValue) <- value
    , (Type.ScalarType "Float" _) <- type' = Just $ Type.Float floatValue
    | (Type.Int intValue) <- value
    , (Type.ScalarType "Float" _) <- type' =
        Just $ Type.Float $ fromIntegral intValue
    | (Type.String stringValue) <- value
    , (Type.ScalarType "ID" _) <- type' = Just $ Type.String stringValue
    | (Type.Int intValue) <- value
    , (Type.ScalarType "ID" _) <- type' = Just $ decimal intValue
  where
    decimal = Type.String
        . Text.Lazy.toStrict
        . Text.Builder.toLazyText
        . Text.Builder.decimal
 coerceInputLiteral (In.EnumBaseType type') (Type.Enum enumValue)
    | member enumValue type' = Just $ Type.Enum enumValue
  where
    member value (Type.EnumType _ _ members) = HashMap.member value members
 coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) =
    let (In.InputObjectType _ _ inputFields) = type'
     in Type.Object
            <$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields
  where
    matchFieldValues' values' fieldName (In.InputField _ inputFieldType defaultValue) =
        matchFieldValues coerceInputLiteral values' fieldName inputFieldType defaultValue
 coerceInputLiteral (In.ListBaseType listType) (Type.List list) =
    Type.List <$> traverse (coerceInputLiteral listType) list
 coerceInputLiteral (In.ListBaseType listType) singleton =
    wrapSingleton listType singleton
  where
      wrapSingleton (In.ListBaseType listType') singleton' =
          Type.List <$> sequence [wrapSingleton listType' singleton']
      wrapSingleton listType' singleton' =
          Type.List <$> sequence [coerceInputLiteral listType' singleton']
 coerceInputLiteral _ _ = Nothing
 -- | 'Serialize' describes how a @GraphQL@ value should be serialized.
 class Serialize a where
    -- | Serializes a @GraphQL@ value according to the given serialization
    -- format.
    --
    -- Type infomration is given as a hint, e.g. if you need to know what type
    -- is being serialized to serialize it properly. Don't do any validation for
    -- @GraphQL@ built-in types here.
    --
    -- If the value cannot be serialized without losing information, return
    -- 'Nothing' — it will cause a field error.
    serialize :: forall m
        . Out.Type m -- ^ Expected output type.
        -> Output a -- ^ The value to be serialized.
        -> Maybe a -- ^ Serialized value on success or 'Nothing'.
    -- | __null__ representation in the given serialization format.
    null :: a
 -- | Intermediate type used to serialize a @GraphQL@ value.
 --
 -- The serialization is done during the execution, and 'Output' contains
 -- already serialized data (in 'List' and 'Object') as well as the new layer
 -- that has to be serialized in the current step. So 'Output' is parameterized
 -- by the serialization format.
 data Output a
    = Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Enum Name
    | List [a]
    | Object (OrderedMap a)
    deriving (Eq, Show)
 instance forall a. IsString (Output a) where
    fromString = String . fromString
 instance Serialize Type.Value where
    null = Type.Null
    serialize (Out.ScalarBaseType scalarType) value
        | Type.ScalarType "Int" _ <- scalarType
        , Int int <- value = Just $ Type.Int int
        | Type.ScalarType "Float" _ <- scalarType
        , Float float <- value = Just $ Type.Float float
        | Type.ScalarType "String" _ <- scalarType
        , String string <- value = Just $ Type.String string
        | Type.ScalarType "ID" _ <- scalarType
        , String string <- value = Just $ Type.String string
        | Type.ScalarType "Boolean" _ <- scalarType
        , Boolean boolean <- value = Just $ Type.Boolean boolean
    serialize _ (Enum enum) = Just $ Type.Enum enum
    serialize _ (List list) = Just $ Type.List list
    serialize _ (Object object) = Just
        $ Type.Object
        $ HashMap.fromList
        $ OrderedMap.toList object
    serialize _ _ = Nothing
--- a/src/Language/GraphQL/Execute/OrderedMap.hs
+++ b/src/Language/GraphQL/Execute/OrderedMap.hs
@ -0,0 +1,148 @@
 {- 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 #-}
 -- | This module contains a map data structure, that preserves insertion order.
 -- Some definitions conflict with functions from prelude, so this module should
 -- probably be imported qualified.
 module Language.GraphQL.Execute.OrderedMap
    ( OrderedMap
    , elems
    , empty
    , insert
    , foldlWithKey'
    , keys
    , lookup
    , replace
    , singleton
    , size
    , toList
    , traverseMaybe
    ) where
 import qualified Data.Foldable as Foldable
 import Data.HashMap.Strict (HashMap, (!))
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 import Prelude hiding (filter, lookup)
 -- | This map associates values with the given text keys. Insertion order is
 -- preserved. When inserting a value with a key, that is already available in
 -- the map, the existing value isn't overridden, but combined with the new value
 -- using its 'Semigroup' instance.
 --
 -- Internally this map uses an array with keys to preserve the order and an
 -- unorded map with key-value pairs.
 data OrderedMap v = OrderedMap (Vector Text) (HashMap Text v)
    deriving (Eq)
 instance Functor OrderedMap where
    fmap f (OrderedMap vector hashMap) = OrderedMap vector $ fmap f hashMap
 instance Foldable OrderedMap where
    foldr f = foldrWithKey $ const f
    null (OrderedMap vector _) = Vector.null vector
 instance Semigroup v => Semigroup (OrderedMap v) where
    (<>) = foldlWithKey'
        $ \accumulator key value -> insert key value accumulator
 instance Semigroup v => Monoid (OrderedMap v) where
    mempty = empty
 instance Traversable OrderedMap where
    traverse f (OrderedMap vector hashMap) = OrderedMap vector
        <$> traverse f hashMap
 instance Show v => Show (OrderedMap v) where
    showsPrec precedence map' = showParen (precedence > 10)
        $ showString "fromList " . shows (toList map')
 -- * Construction
 -- | Constructs a map with a single element.
 singleton :: forall v. Text -> v -> OrderedMap v
 singleton key value = OrderedMap (Vector.singleton key)
    $ HashMap.singleton key value
 -- | Constructs an empty map.
 empty :: forall v. OrderedMap v
 empty = OrderedMap mempty mempty
 -- * Traversal
 -- | Reduces this map by applying a binary operator from right to left to all
 -- elements, using the given starting value.
 foldrWithKey :: forall v a. (Text -> v -> a -> a) -> a -> OrderedMap v -> a
 foldrWithKey f initial (OrderedMap vector hashMap) = foldr go initial vector
  where
    go key = f key (hashMap ! key)
 -- | Reduces this map by applying a binary operator from left to right to all
 -- elements, using the given starting value.
 foldlWithKey' :: forall v a. (a -> Text -> v -> a) -> a -> OrderedMap v -> a
 foldlWithKey' f initial (OrderedMap vector hashMap) =
    Vector.foldl' go initial vector
  where
    go accumulator key = f accumulator key (hashMap ! key)
 -- | Traverse over the elements and collect the 'Just' results.
 traverseMaybe
    :: Applicative f
    => forall a
    . (a -> f (Maybe b))
    -> OrderedMap a
    -> f (OrderedMap b)
 traverseMaybe f orderedMap = foldlWithKey' filter empty
    <$> traverse f orderedMap
  where
    filter accumulator key (Just value) = replace key value accumulator
    filter accumulator _ Nothing = accumulator
 -- * Lists
 -- | Converts this map to the list of key-value pairs.
 toList :: forall v. OrderedMap v -> [(Text, v)]
 toList = foldrWithKey ((.) (:) . (,)) []
 -- | Returns a list with all keys in this map.
 keys :: forall v. OrderedMap v -> [Text]
 keys (OrderedMap vector _) = Foldable.toList vector
 -- | Returns a list with all elements in this map.
 elems :: forall v. OrderedMap v -> [v]
 elems = fmap snd . toList
 -- * Basic interface
 -- | Associates the specified value with the specified key in this map. If this
 -- map previously contained a mapping for the key, the existing and new values
 -- are combined.
 insert :: Semigroup v => Text -> v -> OrderedMap v -> OrderedMap v
 insert key value (OrderedMap vector hashMap)
    | Just available <- HashMap.lookup key hashMap = OrderedMap vector
        $ HashMap.insert key (available <> value) hashMap
    | otherwise = OrderedMap (Vector.snoc vector key)
        $ HashMap.insert key value hashMap
 -- | Associates the specified value with the specified key in this map. If this
 -- map previously contained a mapping for the key, the existing value is
 -- replaced by the new one.
 replace :: Text -> v -> OrderedMap v -> OrderedMap v
 replace key value (OrderedMap vector hashMap)
    | HashMap.member key hashMap = OrderedMap vector
        $ HashMap.insert key value hashMap
    | otherwise = OrderedMap (Vector.snoc vector key)
        $ HashMap.insert key value hashMap
 -- | Gives the size of this map, i.e. number of elements in it.
 size :: forall v. OrderedMap v -> Int
 size (OrderedMap vector _) = Vector.length vector
 -- | Looks up a value in this map by key.
 lookup :: forall v. Text -> OrderedMap v -> Maybe v
 lookup key (OrderedMap _ hashMap) = HashMap.lookup key hashMap
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -1,184 +1,325 @@
-{-# LANGUAGE ExplicitForAll #-}
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
-{-# LANGUAGE TupleSections #-}
+   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/. -}
-- | After the document is parsed, before getting executed the AST is
+{-# LANGUAGE ExplicitForAll #-}
--   transformed into a similar, simpler AST. This module is responsible for
+{-# LANGUAGE LambdaCase #-}
--   this transformation.
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NamedFieldPuns #-}
 -- | After the document is parsed, before getting executed, the AST is
 -- transformed into a similar, simpler AST. Performed transformations include:
 --
 --   * Replacing variables with their values.
 --   * Inlining fragments. Some fragments can be completely eliminated and
 --   replaced by the selection set they represent. Invalid (recursive and
 --   non-existing) fragments are skipped. The most fragments are inlined, so the
 --   executor doesn't have to perform additional lookups later.
 --   * Evaluating directives (@\@include@ and @\@skip@).
 --
 -- This module is also responsible for smaller rewrites that touch only parts of
 -- the original AST.
 module Language.GraphQL.Execute.Transform
-    ( document
+    ( Field(..)
    , Fragment(..)
    , Input(..)
    , Operation(..)
    , Replacement(..)
    , Selection(..)
    , TransformT(..)
    , document
    , transform
    ) where
-import Control.Arrow (first)
+import Control.Monad (foldM)
-import Control.Monad (foldM, unless)
+import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
-import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
+import Control.Monad.Trans.Reader (ReaderT(..), local)
-import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
+import qualified Control.Monad.Trans.Reader as Reader
 import Data.Bifunctor (first)
 import Data.Functor ((<&>))
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
 import Data.Int (Int32)
 import Data.List (intercalate)
 import qualified Data.List.NonEmpty as NonEmpty
-import Data.Sequence (Seq, (<|), (><))
+import Data.Maybe (fromMaybe, isJust)
-import qualified Language.GraphQL.AST as Full
+import Data.Sequence (Seq, (><))
-import qualified Language.GraphQL.AST.Core as Core
+import qualified Data.Sequence as Seq
-import qualified Language.GraphQL.Schema as Schema
+import Data.Text (Text)
-import qualified Language.GraphQL.Type.Directive as Directive
+import qualified Data.Text as Text
 import qualified Language.GraphQL.AST.Document as Full
 import Language.GraphQL.Type.Schema (Type)
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Internal as Type
 import Numeric (showFloat)
-- | Associates a fragment name with a list of 'Core.Field's.
+-- | Associates a fragment name with a list of 'Field's.
-data Replacement = Replacement
+data Replacement m = Replacement
-    { fragments :: HashMap Core.Name Core.Fragment
+    { variableValues :: Type.Subs
    , fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
    , visitedFragments :: HashSet Full.Name
    , types :: HashMap Full.Name (Type m)
    }
-type TransformT a = StateT Replacement (ReaderT Schema.Subs Maybe) a
+newtype TransformT m a = TransformT
    { runTransformT :: ReaderT (Replacement m) m a
    }
-liftJust :: forall a. a -> TransformT a
+instance Functor m => Functor (TransformT m) where
-liftJust = lift . lift . Just
+    fmap f = TransformT . fmap f . runTransformT
 instance Applicative m => Applicative (TransformT m) where
    pure = TransformT . pure
    TransformT f <*> TransformT x = TransformT $ f <*> x
 instance Monad m => Monad (TransformT m) where
    TransformT x >>= f = TransformT $ x >>= runTransformT . f
 instance MonadTrans TransformT where
    lift = TransformT . lift
 instance MonadThrow m => MonadThrow (TransformT m) where
    throwM = lift . throwM
 instance MonadCatch m => MonadCatch (TransformT m) where
  catch (TransformT stack) handler =
      TransformT $ catch stack $ runTransformT . handler
 asks :: Monad m => forall a. (Replacement m -> a) -> TransformT m a
 asks = TransformT . Reader.asks
 -- | GraphQL has 3 operation types: queries, mutations and subscribtions.
 data Operation m
    = Operation Full.OperationType (Seq (Selection m)) Full.Location
 -- | Field or inlined fragment.
 data Selection m
    = FieldSelection (Field m)
    | FragmentSelection (Fragment m)
 data Field m = Field
    (Maybe Full.Name)
    Full.Name
    (HashMap Full.Name (Full.Node Input))
    (Seq (Selection m))
    Full.Location
 data Fragment m = Fragment
    (Type.CompositeType m) (Seq (Selection m)) Full.Location
 data Input
    = Variable Type.Value
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Full.Name
    | List [Input]
    | Object (HashMap Full.Name Input)
    deriving Eq
 instance Show Input where
    showList = mappend . showList'
      where
        showList' list = "[" ++ intercalate ", " (show <$> list) ++ "]"
    show (Int integer) = show integer
    show (Float float') = showFloat float' mempty
    show (String text) = "\"" <> Text.foldr (mappend . Full.escape) "\"" text
    show (Boolean boolean') = show boolean'
    show Null = "null"
    show (Enum name) = Text.unpack name
    show (List list) = show list
    show (Object fields) = unwords
        [ "{"
        , intercalate ", " (HashMap.foldrWithKey showObject [] fields)
        , "}"
        ]
      where
        showObject key value accumulator =
            concat [Text.unpack key, ": ", show value] : accumulator
    show variableValue = show variableValue
 -- | Extracts operations and fragment definitions of the document.
 document :: Full.Document
    -> ([Full.OperationDefinition], HashMap Full.Name Full.FragmentDefinition)
 document = foldr filterOperation ([], HashMap.empty)
  where
    filterOperation (Full.ExecutableDefinition executableDefinition) accumulator
        | Full.DefinitionOperation operationDefinition' <- executableDefinition =
            first (operationDefinition' :) accumulator
        | Full.DefinitionFragment fragmentDefinition <- executableDefinition
        , Full.FragmentDefinition fragmentName _ _ _ _ <- fragmentDefinition =
            HashMap.insert fragmentName fragmentDefinition <$> accumulator
    filterOperation _ accumulator = accumulator -- Type system definitions.
 -- | Rewrites the original syntax tree into an intermediate representation used
-- for query execution.
+-- for the query execution.
-document :: Schema.Subs -> Full.Document -> Maybe Core.Document
+transform :: Monad m => Full.OperationDefinition -> TransformT m (Operation m)
-document subs document' =
+transform (Full.OperationDefinition operationType _ _ _ selectionSet' operationLocation) = do
-    flip runReaderT subs
+    transformedSelections <- selectionSet selectionSet'
-        $ evalStateT (collectFragments >> operations operationDefinitions)
+    pure $ Operation operationType transformedSelections operationLocation
-        $ Replacement HashMap.empty fragmentTable
+transform (Full.SelectionSet selectionSet' operationLocation) = do
    transformedSelections <- selectionSet selectionSet'
    pure $ Operation Full.Query transformedSelections operationLocation
 selectionSet :: Monad m => Full.SelectionSet -> TransformT m (Seq (Selection m))
 selectionSet = selectionSetOpt . NonEmpty.toList
 selectionSetOpt :: Monad m => Full.SelectionSetOpt -> TransformT m (Seq (Selection m))
 selectionSetOpt = foldM go Seq.empty
  where
-    (fragmentTable, operationDefinitions) = foldr defragment mempty document'
+    go accumulatedSelections currentSelection =
-    defragment (Full.DefinitionOperation definition) acc =
+        selection currentSelection <&> (accumulatedSelections ><)
        (definition :) <$> acc
    defragment (Full.DefinitionFragment definition) acc =
        let (Full.FragmentDefinition name _ _ _) = definition
         in first (HashMap.insert name definition) acc
-- * Operation
+selection :: Monad m => Full.Selection -> TransformT m (Seq (Selection m))
 selection (Full.FieldSelection field') =
    maybeToSelectionSet FieldSelection $ field field'
 selection (Full.FragmentSpreadSelection fragmentSpread') =
    maybeToSelectionSet FragmentSelection $ fragmentSpread fragmentSpread'
 selection (Full.InlineFragmentSelection inlineFragment') =
    either id (pure . FragmentSelection) <$> inlineFragment inlineFragment'
-operations :: [Full.OperationDefinition] -> TransformT Core.Document
+maybeToSelectionSet :: Monad m
-operations operations' = do
+    => forall a
-    coreOperations <- traverse operation operations'
+    . (a -> Selection m)
-    lift . lift $ NonEmpty.nonEmpty coreOperations
+    -> TransformT m (Maybe a)
    -> TransformT m (Seq (Selection m))
 maybeToSelectionSet selectionType = fmap (maybe Seq.empty $ pure . selectionType)
-operation :: Full.OperationDefinition -> TransformT Core.Operation
+directives :: Monad m => [Full.Directive] -> TransformT m (Maybe [Definition.Directive])
-operation (Full.OperationSelectionSet sels) =
+directives = fmap Type.selection . traverse directive
    operation $ Full.OperationDefinition Full.Query mempty mempty mempty sels
 -- TODO: Validate Variable definitions with substituter
 operation (Full.OperationDefinition Full.Query name _vars _dirs sels) =
    Core.Query name <$> appendSelection sels
 operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
    Core.Mutation name <$> appendSelection sels
-- * Selection
+inlineFragment :: Monad m
    => Full.InlineFragment
    -> TransformT m (Either (Seq (Selection m)) (Fragment m))
 inlineFragment (Full.InlineFragment maybeCondition directives' selectionSet' location)
    | Just typeCondition <- maybeCondition = do
        transformedSelections <- selectionSet selectionSet'
        transformedDirectives <- directives directives'
        maybeFragmentType <- asks
            $ Type.lookupTypeCondition typeCondition
            . types
        pure $ case transformedDirectives >> maybeFragmentType of
            Just fragmentType -> Right
                $ Fragment fragmentType transformedSelections location
            Nothing -> Left Seq.empty
    | otherwise = do
        transformedSelections <- selectionSet selectionSet'
        transformedDirectives <- directives directives'
        pure $ if isJust transformedDirectives
            then Left transformedSelections
            else Left Seq.empty
-selection ::
+fragmentSpread :: Monad m => Full.FragmentSpread -> TransformT m (Maybe (Fragment m))
-    Full.Selection ->
+fragmentSpread (Full.FragmentSpread spreadName directives' location) = do
-    TransformT (Either (Seq Core.Selection) Core.Selection)
+    transformedDirectives <- directives directives'
-selection (Full.SelectionField field') =
+    visitedFragment <- asks $ HashSet.member spreadName . visitedFragments
-    maybe (Left mempty) (Right . Core.SelectionField) <$> field field'
+    possibleFragmentDefinition <- asks
-selection (Full.SelectionFragmentSpread fragment) =
+        $ HashMap.lookup spreadName
-    maybe (Left mempty) (Right . Core.SelectionFragment)
+        . fragmentDefinitions
-    <$> fragmentSpread fragment
+    case transformedDirectives >> possibleFragmentDefinition of
-selection (Full.SelectionInlineFragment fragment) =
+        Just (Full.FragmentDefinition _ typeCondition _ selections _)
-    inlineFragment fragment
+            | visitedFragment -> pure Nothing
-
+            | otherwise -> do
-appendSelection ::
+                fragmentType <- asks
-    Traversable t =>
+                    $ Type.lookupTypeCondition typeCondition
-    t Full.Selection ->
+                    . types
-    TransformT (Seq Core.Selection)
+                traverse (traverseSelections selections) fragmentType
-appendSelection = foldM go mempty
+        Nothing -> pure Nothing
  where
-    go acc sel = append acc <$> selection sel
+    traverseSelections selections typeCondition = do
-    append acc (Left list) = list >< acc
+        transformedSelections <- TransformT
-    append acc (Right one) = one <| acc
+            $ local fragmentInserter
            $ runTransformT
            $ selectionSet selections
        pure $ Fragment typeCondition transformedSelections location
    fragmentInserter replacement@Replacement{ visitedFragments } = replacement
        { visitedFragments = HashSet.insert spreadName visitedFragments }
-directives :: [Full.Directive] -> TransformT [Core.Directive]
+field :: Monad m => Full.Field -> TransformT m (Maybe (Field m))
-directives = traverse directive
+field (Full.Field alias' name' arguments' directives' selectionSet' location') = do
    transformedSelections <- selectionSetOpt selectionSet'
    transformedDirectives <- directives directives'
    transformedArguments <- arguments arguments'
    let transformedField = Field
            alias'
            name'
            transformedArguments
            transformedSelections
            location'
    pure $ transformedDirectives >> pure transformedField
 arguments :: Monad m => [Full.Argument] -> TransformT m (HashMap Full.Name (Full.Node Input))
 arguments = foldM go HashMap.empty
  where
-    directive (Full.Directive directiveName directiveArguments) =
+    go accumulator (Full.Argument name' valueNode argumentLocation) = do
-        Core.Directive directiveName <$> arguments directiveArguments
+        let replaceLocation = flip Full.Node argumentLocation . Full.node
        argumentValue <- fmap replaceLocation <$> node valueNode
        pure $ insertIfGiven name' argumentValue accumulator
-- * Fragment replacement
+directive :: Monad m => Full.Directive -> TransformT m Definition.Directive
-
+directive (Full.Directive name' arguments' _)
-- | Extract fragment definitions into a single 'HashMap'.
+    = Definition.Directive name'
-collectFragments :: TransformT ()
+    . Type.Arguments
-collectFragments = do
+    <$> foldM go HashMap.empty arguments'
    fragDefs <- gets fragmentDefinitions
    let nextValue = head $ HashMap.elems fragDefs
    unless (HashMap.null fragDefs) $ do
        _ <- fragmentDefinition nextValue
        collectFragments
 inlineFragment ::
    Full.InlineFragment ->
    TransformT (Either (Seq Core.Selection) Core.Selection)
 inlineFragment (Full.InlineFragment type' directives' selectionSet) = do
    fragmentDirectives <- Directive.selection <$> directives directives'
    case fragmentDirectives of
        Nothing -> pure $ Left mempty
        _ -> do
            fragmentSelectionSet <- appendSelection selectionSet
            pure $ maybe Left selectionFragment type' fragmentSelectionSet
  where
-    selectionFragment typeName = Right
+    go accumulator (Full.Argument argumentName Full.Node{ node = node' } _) = do
-        . Core.SelectionFragment
+        transformedValue <- directiveValue node'
-        . Core.Fragment typeName
+        pure $ HashMap.insert argumentName transformedValue accumulator
-fragmentSpread :: Full.FragmentSpread -> TransformT (Maybe Core.Fragment)
+directiveValue :: Monad m => Full.Value -> TransformT m Type.Value
-fragmentSpread (Full.FragmentSpread name directives') = do
+directiveValue = \case
-    spreadDirectives <- Directive.selection <$> directives directives'
+    (Full.Variable name') -> asks
-    fragments' <- gets fragments
+        $ HashMap.lookupDefault Type.Null name'
-    fragment <- maybe lookupDefinition liftJust (HashMap.lookup name fragments')
+        . variableValues
-    pure $ fragment <$ spreadDirectives 
+    (Full.Int integer) -> pure $ Type.Int integer
    (Full.Float double) -> pure $ Type.Float double
    (Full.String string) -> pure $ Type.String string
    (Full.Boolean boolean) -> pure $ Type.Boolean boolean
    Full.Null -> pure Type.Null
    (Full.Enum enum) -> pure $ Type.Enum enum
    (Full.List list) -> Type.List <$> traverse directiveNode list
    (Full.Object objectFields) ->
        Type.Object <$> foldM objectField HashMap.empty objectFields
  where
-    lookupDefinition = do
+    directiveNode Full.Node{ node = node'} = directiveValue node'
-        fragmentDefinitions' <- gets fragmentDefinitions
+    objectField accumulator Full.ObjectField{ name, value } = do
-        found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
+        transformedValue <- directiveNode value
-        fragmentDefinition found
+        pure $ HashMap.insert name transformedValue accumulator
-fragmentDefinition ::
+input :: Monad m => Full.Value -> TransformT m (Maybe Input)
-    Full.FragmentDefinition ->
+input (Full.Variable name') =
-    TransformT Core.Fragment
+    asks (HashMap.lookup name' . variableValues) <&> fmap Variable
-fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
+input (Full.Int integer) = pure $ Just $ Int integer
-    modify deleteFragmentDefinition
+input (Full.Float double) = pure $ Just $ Float double
-    fragmentSelection <- appendSelection selections
+input (Full.String string) = pure $ Just $ String string
-    let newValue = Core.Fragment type' fragmentSelection
+input (Full.Boolean boolean) = pure $ Just $ Boolean boolean
-    modify $ insertFragment newValue
+input Full.Null = pure $ Just Null
-    liftJust newValue
+input (Full.Enum enum) = pure $ Just $ Enum enum
 input (Full.List list) = Just . List
    <$> traverse (fmap (fromMaybe Null) . input . Full.node) list
 input (Full.Object objectFields) = Just . Object
    <$> foldM objectField HashMap.empty objectFields
  where
-    deleteFragmentDefinition (Replacement fragments' fragmentDefinitions') =
+    objectField accumulator Full.ObjectField{..} = do
-        Replacement fragments' $ HashMap.delete name fragmentDefinitions'
+        objectFieldValue <- fmap Full.node <$> node value
-    insertFragment newValue (Replacement fragments' fragmentDefinitions') =
+        pure $ insertIfGiven name objectFieldValue accumulator
        let newFragments = HashMap.insert name newValue fragments'
         in Replacement newFragments fragmentDefinitions'
-field :: Full.Field -> TransformT (Maybe Core.Field)
+insertIfGiven :: forall a
-field (Full.Field alias name arguments' directives' selections) = do
+    . Full.Name
-    fieldArguments <- traverse argument arguments'
+    -> Maybe a
-    fieldSelections <- appendSelection selections
+    -> HashMap Full.Name a
-    fieldDirectives <- Directive.selection <$> directives directives'
+    -> HashMap Full.Name a
-    let field' = Core.Field alias name fieldArguments fieldSelections
+insertIfGiven name (Just v) = HashMap.insert name v
-    pure $ field' <$ fieldDirectives
+insertIfGiven _ _ = id
-arguments :: [Full.Argument] -> TransformT Core.Arguments
+node :: Monad m => Full.Node Full.Value -> TransformT m (Maybe (Full.Node Input))
-arguments = fmap Core.Arguments . foldM go HashMap.empty
+node Full.Node{node = node', ..} =
-  where
+    traverse Full.Node <$> input node' <*> pure location
    go arguments' argument' = do
        (Core.Argument name value') <- argument argument'
        return $ HashMap.insert name value' arguments'
 argument :: Full.Argument -> TransformT Core.Argument
 argument (Full.Argument n v) = Core.Argument n <$> value v
 value :: Full.Value -> TransformT Core.Value
 value (Full.Variable n) = do
    substitute' <- lift ask
    lift . lift $ substitute' n
 value (Full.Int i) = pure $ Core.Int i
 value (Full.Float f) = pure $ Core.Float f
 value (Full.String x) = pure $ Core.String x
 value (Full.Boolean b) = pure $ Core.Boolean b
 value Full.Null = pure   Core.Null
 value (Full.Enum e) = pure $ Core.Enum e
 value (Full.List l) =
    Core.List <$> traverse value l
 value (Full.Object o) =
    Core.Object . HashMap.fromList <$> traverse objectField o
 objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
 objectField (Full.ObjectField name value') = (name,) <$> value value'
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@ -1,145 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Schema
    ( Resolver
    , Subs
    , object
    , objectA
    , scalar
    , scalarA
    , resolve
    , wrappedObject
    , wrappedObjectA
    , wrappedScalar
    , wrappedScalarA
    -- * AST Reexports
    , Field
    , Argument(..)
    , Value(..)
    ) where
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Control.Monad.Trans.Reader (runReaderT)
 import Data.Foldable (find, fold)
 import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Language.GraphQL.AST.Core
 import Language.GraphQL.Error
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
 --   information (if an error has occurred). @m@ is usually expected to be an
 --   instance of 'MonadIO'.
 data Resolver m = Resolver
    Text -- ^ Name
    (Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
 -- | Variable substitution function.
 type Subs = Name -> Maybe Value
 -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
 object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m
 object name = objectA name . const
 -- | Like 'object' but also taking 'Argument's.
 objectA :: MonadIO m
    => Name -> ([Argument] -> ActionT m [Resolver m]) -> Resolver m
 objectA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ flds) resolver = withField (resolve resolver flds) fld
 -- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
 wrappedObjectA :: MonadIO m
    => Name -> ([Argument] -> ActionT m (Type.Wrapping [Resolver m])) -> Resolver m
 wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ sels) resolver
        = withField (traverse (`resolve` sels) resolver) fld
 -- | Like 'object' but can be null or a list of objects.
 wrappedObject :: MonadIO m
    => Name -> ActionT m (Type.Wrapping [Resolver m]) -> Resolver m
 wrappedObject name = wrappedObjectA name . const
 -- | A scalar represents a primitive value, like a string or an integer.
 scalar :: (MonadIO m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m
 scalar name = scalarA name . const
 -- | Like 'scalar' but also taking 'Argument's.
 scalarA :: (MonadIO m, Aeson.ToJSON a)
    => Name -> ([Argument] -> ActionT m a) -> Resolver m
 scalarA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld result = withField (return result) fld
 -- | Like 'scalar' but also taking 'Argument's and can be null or a list of scalars.
 wrappedScalarA :: (MonadIO m, Aeson.ToJSON a)
    => Name -> ([Argument] -> ActionT m (Type.Wrapping a)) -> Resolver m
 wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld (Type.Named result) = withField (return result) fld
    resolveRight fld Type.Null
        = return $ HashMap.singleton (aliasOrName fld) Aeson.Null
    resolveRight fld (Type.List result) = withField (return result) fld
 -- | Like 'scalar' but can be null or a list of scalars.
 wrappedScalar :: (MonadIO m, Aeson.ToJSON a)
    => Name -> ActionT m (Type.Wrapping a) -> Resolver m
 wrappedScalar name = wrappedScalarA name . const
 resolveFieldValue :: MonadIO m
    => ([Argument] -> ActionT m a)
    -> (Field -> a -> CollectErrsT m (HashMap Text Aeson.Value))
    -> Field
    -> CollectErrsT m (HashMap Text Aeson.Value)
 resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
    result <- lift $ reader . runExceptT . runActionT $ f args
    either resolveLeft (resolveRight fld) result
      where
        reader = flip runReaderT $ Context mempty
        resolveLeft err = do
            _ <- addErrMsg err
            return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 -- | Helper function to facilitate 'Argument' handling.
 withField :: (MonadIO m, Aeson.ToJSON a)
    => CollectErrsT m a -> Field -> CollectErrsT m (HashMap Text Aeson.Value)
 withField v fld
    = HashMap.singleton (aliasOrName fld) . Aeson.toJSON <$> runAppendErrs v
 -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
 --   'Resolver' to each 'Field'. Resolves into a value containing the
 --   resolved 'Field', or a null value and error information.
 resolve :: MonadIO m
    => [Resolver m] -> Seq Selection -> CollectErrsT m Aeson.Value
 resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
  where
    resolveTypeName (Resolver "__typename" f) = do
        value <- f $ Field Nothing "__typename" mempty mempty
        return $ HashMap.lookupDefault "" "__typename" value
    resolveTypeName _ = return ""
    tryResolvers (SelectionField fld@(Field _ name _ _))
        = maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers name) resolvers
    tryResolvers (SelectionFragment (Fragment typeCondition selections')) = do
        that <- traverse resolveTypeName (find (compareResolvers "__typename") resolvers)
        if maybe True (Aeson.String typeCondition ==) that
            then fmap fold . traverse tryResolvers $ selections'
            else return mempty
    compareResolvers name (Resolver name' _) = name == name'
    tryResolver fld (Resolver _ resolver)  = resolver fld
    errmsg fld@(Field _ name _ _) = do
        addErrMsg $ T.unwords ["field", name, "not resolved."]
        return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 aliasOrName :: Field -> Text
 aliasOrName (Field alias name _ _) = fromMaybe name alias
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@ -1,49 +0,0 @@
 -- | Monad transformer stack used by the @GraphQL@ resolvers.
 module Language.GraphQL.Trans
    ( ActionT(..)
    , Context(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)
 import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
 import Language.GraphQL.AST.Core (Name, Value)
 -- | Resolution context holds resolver arguments.
 newtype Context = Context (HashMap Name 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 = (<|>)
--- a/src/Language/GraphQL/Type.hs
+++ b/src/Language/GraphQL/Type.hs
@ -1,55 +1,26 @@
-- | Definitions for @GraphQL@ input types.
+{- 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
-    ( Wrapping(..)
+    ( 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
-import Data.Aeson as Aeson (ToJSON, toJSON)
+import Language.GraphQL.Type.Definition
-import qualified Data.Aeson as Aeson
+import Language.GraphQL.Type.Schema (Schema, schema, schemaWithTypes)
-
+import qualified Language.GraphQL.Type.In as In
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
+import qualified Language.GraphQL.Type.Out as Out
 --   type can wrap other wrapping or named types. Wrapping types are lists and
 --   Non-Null types (named types are nullable by default).
 --
 --   This 'Wrapping' type doesn\'t reflect this distinction exactly but it is
 --   used in the resolvers to take into account that the returned value can be
 --   nullable or an (arbitrary nested) list.
 data Wrapping a
    = List [Wrapping a] -- ^ Arbitrary nested list
    | Named a -- ^ Named type without further wrapping
    | Null -- ^ Null
    deriving (Eq, Show)
 instance Functor Wrapping where
    fmap f (List list) = List $ fmap (fmap f) list
    fmap f (Named named) = Named $ f named
    fmap _ Null = Null
 instance Foldable Wrapping where
    foldr f acc (List list) = foldr (flip $ foldr f) acc list
    foldr f acc (Named named) = f named acc
    foldr _ acc Null = acc
 instance Traversable Wrapping where
    traverse f (List list) = List <$> traverse (traverse f) list
    traverse f (Named named) = Named <$> f named
    traverse _ Null = pure Null
 instance Applicative Wrapping where
    pure = Named
    Null <*> _ = Null
    _ <*> Null = Null
    (Named f) <*> (Named x) = Named $ f x
    (List fs) <*> (List xs) = List $ (<*>) <$> fs <*> xs
    (Named f) <*> list = f <$> list
    (List fs) <*> named = List $ (<*> named) <$> fs
 instance Monad Wrapping where
    return = pure
    Null >>= _ = Null
    (Named x) >>= f = f x
    (List xs) >>= f = List $ fmap (>>= f) xs
 instance ToJSON a => ToJSON (Wrapping a) where
    toJSON (List list) = toJSON list
    toJSON (Named named) = toJSON named
    toJSON Null = Aeson.Null
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@ -0,0 +1,219 @@
 {- 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 Safe #-}
 -- | Types that can be used as both input and output types.
 module Language.GraphQL.Type.Definition
    ( Arguments(..)
    , Directive(..)
    , EnumType(..)
    , EnumValue(..)
    , ScalarType(..)
    , Subs
    , Value(..)
    , boolean
    , float
    , id
    , int
    , showNonNullType
    , showNonNullListType
    , selection
    , string
    ) where
 import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List (intercalate)
 import Data.String (IsString(..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST (Name, escape)
 import Numeric (showFloat)
 import Prelude hiding (id)
 -- | Represents accordingly typed GraphQL values.
 data Value
    = Int Int32
    | Float Double -- ^ GraphQL Float is double precision.
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value] -- ^ Arbitrary nested list.
    | Object (HashMap Name Value)
    deriving Eq
 instance Show Value where
    showList = mappend . showList'
      where
        showList' list = "[" ++ intercalate ", " (show <$> list) ++ "]"
    show (Int integer) = show integer
    show (Float float') = showFloat float' mempty
    show (String text) = "\"" <> Text.foldr (mappend . escape) "\"" text
    show (Boolean boolean') = show boolean'
    show Null = "null"
    show (Enum name) = Text.unpack name
    show (List list) = show list
    show (Object fields) = unwords
        [ "{"
        , intercalate ", " (HashMap.foldrWithKey showObject [] fields)
        , "}"
        ]
      where
        showObject key value accumulator =
            concat [Text.unpack key, ": ", show value] : accumulator
 instance IsString Value where
    fromString = String . fromString
 -- | Contains variables for the query. The key of the map is a variable name,
 -- 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
 -- Enums) .
 data ScalarType = ScalarType Name (Maybe Text)
 instance Eq ScalarType where
    (ScalarType this _) == (ScalarType that _) = this == that
 instance Show ScalarType where
    show (ScalarType typeName _) = Text.unpack typeName
 -- | Enum type definition.
 --
 -- Some leaf values of requests and input values are Enums. GraphQL serializes
 -- Enum values as strings, however internally Enums can be represented by any
 -- kind of type, often integers.
 data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
 instance Eq EnumType where
    (EnumType this _ _) == (EnumType that _ _) = this == that
 instance Show EnumType where
    show (EnumType typeName _ _) = Text.unpack typeName
 -- | Enum value is a single member of an 'EnumType'.
 newtype EnumValue = EnumValue (Maybe Text)
 -- | The @String@ scalar type represents textual data, represented as UTF-8
 -- character sequences. The String type is most often used by GraphQL to
 -- represent free-form human-readable text.
 string :: ScalarType
 string = ScalarType "String" (Just description)
  where
    description =
        "The `String` scalar type represents textual data, represented as \
        \UTF-8 character sequences. The String type is most often used by \
        \GraphQL to represent free-form human-readable text."
 -- | The @Boolean@ scalar type represents @true@ or @false@.
 boolean :: ScalarType
 boolean = ScalarType "Boolean" (Just description)
  where
    description = "The `Boolean` scalar type represents `true` or `false`."
 -- | The @Int@ scalar type represents non-fractional signed whole numeric
 -- values. Int can represent values between \(-2^{31}\) and \(2^{31 - 1}\).
 int :: ScalarType
 int = ScalarType "Int" (Just description)
  where
    description =
        "The `Int` scalar type represents non-fractional signed whole numeric \
        \values. Int can represent values between -(2^31) and 2^31 - 1."
 -- | The @Float@ scalar type represents signed double-precision fractional
 -- values as specified by
 -- [IEEE 754](https://en.wikipedia.org/wiki/IEEE_floating_point).
 float :: ScalarType
 float = ScalarType "Float" (Just description)
  where
    description =
        "The `Float` scalar type represents signed double-precision fractional \
        \values as specified by \
        \[IEEE 754](https://en.wikipedia.org/wiki/IEEE_floating_point)."
 -- | The @ID@ scalar type represents a unique identifier, often used to refetch
 -- an object or as key for a cache. The ID type appears in a 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.
 id :: ScalarType
 id = ScalarType "ID" (Just description)
  where
    description =
        "The `ID` scalar type represents a unique identifier, often used to \
        \refetch an object or as key for a cache. The ID type appears in a \
        \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'
 showNonNullType :: Show a => a -> String
 showNonNullType = (++ "!") . show
 showNonNullListType :: Show a => a -> String
 showNonNullListType listType =
    let representation = show listType
     in concat ["[", representation, "]!"]
--- a/src/Language/GraphQL/Type/Directive.hs
+++ b/src/Language/GraphQL/Type/Directive.hs
@ -1,50 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.Type.Directive
    ( selection
    ) where
 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL.AST.Core
 -- | 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/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@ -0,0 +1,126 @@
 {- 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 PatternSynonyms #-}
 {-# LANGUAGE Safe #-}
 {-# LANGUAGE ViewPatterns #-}
 -- | Input types and values.
 --
 -- This module is intended to be imported qualified, to avoid name clashes
 -- with 'Language.GraphQL.Type.Out'.
 module Language.GraphQL.Type.In
    ( Argument(..)
    , Arguments
    , InputField(..)
    , InputObjectType(..)
    , Type(..)
    , isNonNullType
    , pattern EnumBaseType
    , pattern ListBaseType
    , pattern InputObjectBaseType
    , pattern ScalarBaseType
    ) where
 import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document (Name)
 import qualified Language.GraphQL.Type.Definition as Definition
 -- | Single field of an 'InputObjectType'.
 data InputField = InputField (Maybe Text) Type (Maybe Definition.Value)
 -- | Input object type definition.
 --
 -- An input object defines a structured collection of fields which may be
 -- supplied to a field argument.
 data InputObjectType = InputObjectType
    Name (Maybe Text) (HashMap Name InputField)
 instance Eq InputObjectType where
    (InputObjectType this _ _) == (InputObjectType that _ _) = this == that
 instance Show InputObjectType where
    show (InputObjectType typeName _ _) = Text.unpack typeName
 -- | These types may be used as input types for arguments and directives.
 --
 -- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
 -- type can wrap other wrapping or named types. Wrapping types are lists and
 -- Non-Null types (named types are nullable by default).
 data Type
    = NamedScalarType Definition.ScalarType
    | NamedEnumType Definition.EnumType
    | NamedInputObjectType InputObjectType
    | ListType Type
    | NonNullScalarType Definition.ScalarType
    | NonNullEnumType Definition.EnumType
    | NonNullInputObjectType InputObjectType
    | NonNullListType Type
    deriving Eq
 instance Show Type where
    show (NamedScalarType scalarType) = show scalarType
    show (NamedEnumType enumType) = show enumType
    show (NamedInputObjectType inputObjectType) = show inputObjectType
    show (ListType baseType) = concat ["[", show baseType, "]"]
    show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType
    show (NonNullEnumType enumType) = Definition.showNonNullType enumType
    show (NonNullInputObjectType inputObjectType) =
        Definition.showNonNullType inputObjectType
    show (NonNullListType baseType) = Definition.showNonNullListType baseType
 -- | Field argument definition.
 data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)
    deriving Eq
 -- | Field argument definitions.
 type Arguments = HashMap Name Argument
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: Definition.ScalarType -> Type
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
 -- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
 pattern EnumBaseType :: Definition.EnumType -> Type
 pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
 -- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'.
 pattern InputObjectBaseType :: InputObjectType -> Type
 pattern InputObjectBaseType objectType <- (isInputObjectType -> Just objectType)
 -- | Matches either 'ListType' or 'NonNullListType'.
 pattern ListBaseType :: Type -> Type
 pattern ListBaseType listType <- (isListType -> Just listType)
 {-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-}
 isScalarType :: Type -> Maybe Definition.ScalarType
 isScalarType (NamedScalarType inputType) = Just inputType
 isScalarType (NonNullScalarType inputType) = Just inputType
 isScalarType _ = Nothing
 isInputObjectType :: Type -> Maybe InputObjectType
 isInputObjectType (NamedInputObjectType inputType) = Just inputType
 isInputObjectType (NonNullInputObjectType inputType) = Just inputType
 isInputObjectType _ = Nothing
 isEnumType :: Type -> Maybe Definition.EnumType
 isEnumType (NamedEnumType inputType) = Just inputType
 isEnumType (NonNullEnumType inputType) = Just inputType
 isEnumType _ = Nothing
 isListType :: Type -> Maybe Type
 isListType (ListType inputType) = Just inputType
 isListType (NonNullListType inputType) = Just inputType
 isListType _ = Nothing
 -- | Checks whether the given input type is a non-null type.
 isNonNullType :: Type -> Bool
 isNonNullType (NonNullScalarType _) = True
 isNonNullType (NonNullEnumType _) = True
 isNonNullType (NonNullInputObjectType _) = True
 isNonNullType (NonNullListType _) = True
 isNonNullType _ = False
--- a/src/Language/GraphQL/Type/Internal.hs
+++ b/src/Language/GraphQL/Type/Internal.hs
@ -0,0 +1,204 @@
 {- 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 #-}
 module Language.GraphQL.Type.Internal
    ( AbstractType(..)
    , CompositeType(..)
    , Directive(..)
    , Directives
    , Schema(..)
    , Type(..)
    , description
    , directives
    , doesFragmentTypeApply
    , implementations
    , instanceOf
    , lookupCompositeField
    , lookupInputType
    , lookupTypeCondition
    , lookupTypeField
    , mutation
    , outToComposite
    , subscription
    , query
    , types
    ) where
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation)
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 -- | These are all of the possible kinds of types.
 data Type m
    = ScalarType Definition.ScalarType
    | EnumType Definition.EnumType
    | ObjectType (Out.ObjectType m)
    | InputObjectType In.InputObjectType
    | InterfaceType (Out.InterfaceType m)
    | UnionType (Out.UnionType m)
    deriving Eq
 -- | Directive definition.
 --
 -- A definition consists of an optional description, arguments, whether the
 -- directive is repeatable, and the allowed directive locations.
 data Directive = Directive (Maybe Text) In.Arguments Bool [DirectiveLocation]
    deriving Eq
 -- | Directive definitions.
 type Directives = HashMap Full.Name Directive
 -- | 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.
 data Schema m = Schema
    (Maybe Text) -- ^ Description.
    (Out.ObjectType m) -- ^ Query.
    (Maybe (Out.ObjectType m)) -- ^ Mutation.
    (Maybe (Out.ObjectType m)) -- ^ Subscription.
    Directives -- ^ Directives
    (HashMap Full.Name (Type m)) -- ^ Types.
    -- Interface implementations (used only for faster access).
    (HashMap Full.Name [Type m])
 -- | Schema description.
 description :: forall m. Schema m -> Maybe Text
 description (Schema description' _ _ _ _ _ _) = description'
 -- | Schema query type.
 query :: forall m. Schema m -> Out.ObjectType m
 query (Schema _ query' _ _ _ _ _) = query'
 -- | Schema mutation type.
 mutation :: forall m. Schema m -> Maybe (Out.ObjectType m)
 mutation (Schema _ _ mutation' _ _ _ _) = mutation'
 -- | Schema subscription type.
 subscription :: forall m. Schema m -> Maybe (Out.ObjectType m)
 subscription (Schema _ _ _ subscription' _ _ _) = subscription'
 -- | Schema directive definitions.
 directives :: forall m. Schema m -> Directives
 directives (Schema _ _ _ _ directives' _ _) = directives'
 -- | Types referenced by the schema.
 types :: forall m. Schema m -> HashMap Full.Name (Type m)
 types (Schema _ _ _ _ _ types' _) = types'
 -- | Interface implementations.
 implementations :: forall m. Schema m -> HashMap Full.Name [Type m]
 implementations (Schema _ _ _ _ _ _ implementations') = implementations'
 -- | 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
 doesFragmentTypeApply :: forall m
    . CompositeType m
    -> Out.ObjectType m
    -> Bool
 doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
    fragmentType == objectType
 doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
    instanceOf objectType $ AbstractInterfaceType fragmentType
 doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
    instanceOf objectType $ AbstractUnionType fragmentType
 instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool
 instanceOf objectType (AbstractInterfaceType interfaceType) =
    let Out.ObjectType _ _ interfaces _ = objectType
     in foldr go False interfaces
  where
    go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =
        acc || foldr go (interfaceType == objectInterfaceType) interfaces
 instanceOf objectType (AbstractUnionType unionType) =
    let Out.UnionType _ _ members = unionType
     in foldr go False members
  where
    go unionMemberType acc = acc || objectType == unionMemberType
 lookupTypeCondition :: forall m
    . Full.Name
    -> HashMap Full.Name (Type m)
    -> Maybe (CompositeType m)
 lookupTypeCondition type' types' =
    case HashMap.lookup type' types' of
        Just (ObjectType objectType) ->
            Just $ CompositeObjectType objectType
        Just (UnionType unionType) -> Just $ CompositeUnionType unionType
        Just (InterfaceType interfaceType) ->
            Just $ CompositeInterfaceType interfaceType
        _ -> Nothing
 lookupInputType :: Full.Type -> HashMap Full.Name (Type m) -> Maybe In.Type
 lookupInputType (Full.TypeNamed name) types' =
    case HashMap.lookup name types' of
        Just (ScalarType scalarType) ->
            Just $ In.NamedScalarType scalarType
        Just (EnumType enumType) ->
            Just $ In.NamedEnumType enumType
        Just (InputObjectType objectType) ->
            Just $ In.NamedInputObjectType objectType
        _ -> Nothing
 lookupInputType (Full.TypeList list) types'
    = In.ListType
    <$> lookupInputType list types'
 lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types' =
    case HashMap.lookup nonNull types' of
        Just (ScalarType scalarType) ->
            Just $ In.NonNullScalarType scalarType
        Just (EnumType enumType) ->
            Just $ In.NonNullEnumType enumType
        Just (InputObjectType objectType) ->
            Just $ In.NonNullInputObjectType objectType
        _ -> Nothing
 lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types'
    = In.NonNullListType
    <$> lookupInputType nonNull types'
 lookupTypeField :: forall a. Full.Name -> Out.Type a -> Maybe (Out.Field a)
 lookupTypeField fieldName outputType =
    outToComposite outputType >>= lookupCompositeField fieldName
 lookupCompositeField :: forall a
    . Full.Name
    -> CompositeType a
    -> Maybe (Out.Field a)
 lookupCompositeField fieldName = \case
    CompositeObjectType objectType -> objectChild objectType
    CompositeInterfaceType interfaceType -> interfaceChild interfaceType
    _ -> Nothing
  where
    objectChild (Out.ObjectType _ _ _ resolvers) =
        resolverType <$> HashMap.lookup fieldName resolvers
    interfaceChild (Out.InterfaceType _ _ _ fields) =
        HashMap.lookup fieldName fields
    resolverType (Out.ValueResolver objectField _) = objectField
    resolverType (Out.EventStreamResolver objectField _ _) = objectField
 outToComposite :: forall a. Out.Type a -> Maybe (CompositeType a)
 outToComposite = \case
    Out.ObjectBaseType objectType -> Just $ CompositeObjectType objectType
    Out.InterfaceBaseType interfaceType ->
        Just $ CompositeInterfaceType interfaceType
    Out.UnionBaseType unionType -> Just $ CompositeUnionType unionType
    Out.ListBaseType listType -> outToComposite listType
    _ -> Nothing
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@ -0,0 +1,236 @@
 {- 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, 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
    ( Context(..)
    , Field(..)
    , InterfaceType(..)
    , ObjectType(..)
    , Resolve
    , Subscribe
    , Resolver(..)
    , SourceEventStream
    , Type(..)
    , UnionType(..)
    , argument
    , isNonNullType
    , pattern EnumBaseType
    , pattern InterfaceBaseType
    , pattern ListBaseType
    , pattern ObjectBaseType
    , pattern ScalarBaseType
    , 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 qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 -- | 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.
 data ObjectType m = ObjectType
    Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
 instance forall a. Eq (ObjectType a) where
    (ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
 instance forall a. Show (ObjectType a) where
    show (ObjectType typeName _ _ _) = Text.unpack typeName
 -- | Interface Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Interface type
 -- is used to describe what types are possible, and what fields are in common
 -- across all types.
 data InterfaceType m = InterfaceType
    Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
 instance forall a. Eq (InterfaceType a) where
    (InterfaceType this _ _ _) == (InterfaceType that _ _ _) = this == that
 instance forall a. Show (InterfaceType a) where
    show (InterfaceType typeName _ _ _) = Text.unpack typeName
 -- | Union Type Definition.
 --
 -- When a field can return one of a heterogeneous set of types, a Union type is
 -- used to describe what types are possible.
 data UnionType m = UnionType Name (Maybe Text) [ObjectType m]
 instance forall a. Eq (UnionType a) where
    (UnionType this _ _) == (UnionType that _ _) = this == that
 instance forall a. Show (UnionType a) where
    show (UnionType typeName _ _) = Text.unpack typeName
 -- | Output object field definition.
 data Field m = Field
    (Maybe Text) -- ^ Description.
    (Type m) -- ^ Field type.
    In.Arguments -- ^ Arguments.
 -- | These types may be used as output types as the result of fields.
 --
 -- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
 -- type can wrap other wrapping or named types. Wrapping types are lists and
 -- Non-Null types (named types are nullable by default).
 data Type m
    = NamedScalarType ScalarType
    | NamedEnumType EnumType
    | NamedObjectType (ObjectType m)
    | NamedInterfaceType (InterfaceType m)
    | NamedUnionType (UnionType m)
    | ListType (Type m)
    | NonNullScalarType ScalarType
    | NonNullEnumType EnumType
    | NonNullObjectType (ObjectType m)
    | NonNullInterfaceType (InterfaceType m)
    | NonNullUnionType (UnionType m)
    | NonNullListType (Type m)
    deriving Eq
 instance forall a. Show (Type a) where
    show (NamedScalarType scalarType) = show scalarType
    show (NamedEnumType enumType) = show enumType
    show (NamedObjectType inputObjectType) = show inputObjectType
    show (NamedInterfaceType interfaceType) = show interfaceType
    show (NamedUnionType unionType) = show unionType
    show (ListType baseType) = concat ["[", show baseType, "]"]
    show (NonNullScalarType scalarType) = showNonNullType scalarType
    show (NonNullEnumType enumType) = showNonNullType enumType
    show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType
    show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType
    show (NonNullUnionType unionType) = showNonNullType unionType
    show (NonNullListType baseType) = showNonNullListType baseType
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
 -- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
 pattern EnumBaseType :: forall m. EnumType -> Type m
 pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
 -- | Matches either 'NamedObjectType' or 'NonNullObjectType'.
 pattern ObjectBaseType :: forall m. ObjectType m -> Type m
 pattern ObjectBaseType objectType <- (isObjectType -> Just objectType)
 -- | Matches either 'NamedInterfaceType' or 'NonNullInterfaceType'.
 pattern InterfaceBaseType :: forall m. InterfaceType m -> Type m
 pattern InterfaceBaseType interfaceType <-
    (isInterfaceType -> Just interfaceType)
 -- | Matches either 'NamedUnionType' or 'NonNullUnionType'.
 pattern UnionBaseType :: forall m. UnionType m -> Type m
 pattern UnionBaseType unionType <- (isUnionType -> Just unionType)
 -- | Matches either 'ListType' or 'NonNullListType'.
 pattern ListBaseType :: forall m. Type m -> Type m
 pattern ListBaseType listType <- (isListType -> Just listType)
 {-# COMPLETE ScalarBaseType
    , EnumBaseType
    , ObjectBaseType
    , ListBaseType
    , InterfaceBaseType
    , UnionBaseType
    #-}
 isScalarType :: forall m. Type m -> Maybe ScalarType
 isScalarType (NamedScalarType outputType) = Just outputType
 isScalarType (NonNullScalarType outputType) = Just outputType
 isScalarType _ = Nothing
 isObjectType :: forall m. Type m -> Maybe (ObjectType m)
 isObjectType (NamedObjectType outputType) = Just outputType
 isObjectType (NonNullObjectType outputType) = Just outputType
 isObjectType _ = Nothing
 isEnumType :: forall m. Type m -> Maybe EnumType
 isEnumType (NamedEnumType outputType) = Just outputType
 isEnumType (NonNullEnumType outputType) = Just outputType
 isEnumType _ = Nothing
 isInterfaceType :: forall m. Type m -> Maybe (InterfaceType m)
 isInterfaceType (NamedInterfaceType interfaceType) = Just interfaceType
 isInterfaceType (NonNullInterfaceType interfaceType) = Just interfaceType
 isInterfaceType _ = Nothing
 isUnionType :: forall m. Type m -> Maybe (UnionType m)
 isUnionType (NamedUnionType unionType) = Just unionType
 isUnionType (NonNullUnionType unionType) = Just unionType
 isUnionType _ = Nothing
 isListType :: forall m. Type m -> Maybe (Type m)
 isListType (ListType outputType) = Just outputType
 isListType (NonNullListType outputType) = Just outputType
 isListType _ = Nothing
 -- | Checks whether the given output type is a non-null type.
 isNonNullType :: forall m. Type m -> Bool
 isNonNullType (NonNullScalarType _) = True
 isNonNullType (NonNullEnumType _) = True
 isNonNullType (NonNullObjectType _) = True
 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
@ -0,0 +1,219 @@
 {- 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 #-}
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Type.Schema
    ( schema
    , schemaWithTypes
    , module Language.GraphQL.Type.Internal
    ) where
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.Type.Internal
    ( Directive(..)
    , Directives
    , Schema
    , Type(..)
    , description
    , directives
    , implementations
    , mutation
    , subscription
    , query
    , types
    )
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Internal as Internal
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 -- | Schema constructor.
 --
 -- __Note:__ When the schema is constructed, by default only the types that
 -- are reachable by traversing the root types are included, other types must
 -- be explicitly referenced using 'schemaWithTypes' instead.
 schema :: forall m
    . Out.ObjectType m -- ^ Query type.
    -> Maybe (Out.ObjectType m) -- ^ Mutation type.
    -> Maybe (Out.ObjectType m) -- ^ Subscription type.
    -> Directives -- ^ Directive definitions.
    -> Schema m -- ^ Schema.
 schema queryRoot mutationRoot subscriptionRoot =
    schemaWithTypes Nothing queryRoot mutationRoot subscriptionRoot mempty
 -- | Constructs a complete schema, including user-defined types not referenced
 -- in the schema directly (for example interface implementations).
 schemaWithTypes :: forall m
    . Maybe Text -- ^ Schema description
    -> Out.ObjectType m -- ^ Query type.
    -> Maybe (Out.ObjectType m) -- ^ Mutation type.
    -> Maybe (Out.ObjectType m) -- ^ Subscription type.
    -> [Type m] -- ^ Additional types.
    -> Directives -- ^ Directive definitions.
    -> Schema m -- ^ Schema.
 schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' directiveDefinitions =
    Internal.Schema description' queryRoot mutationRoot subscriptionRoot
        allDirectives collectedTypes collectedImplementations
  where
    allTypes = foldr addTypeDefinition HashMap.empty types'
    addTypeDefinition type'@(ScalarType (Definition.ScalarType typeName _)) accumulator =
        HashMap.insert typeName type' accumulator
    addTypeDefinition type'@(EnumType (Definition.EnumType typeName _ _)) accumulator =
        HashMap.insert typeName type' accumulator
    addTypeDefinition type'@(ObjectType (Out.ObjectType typeName _ _ _)) accumulator =
        HashMap.insert typeName type' accumulator
    addTypeDefinition type'@(InputObjectType (In.InputObjectType typeName _ _)) accumulator =
        HashMap.insert typeName type' accumulator
    addTypeDefinition type'@(InterfaceType (Out.InterfaceType typeName _ _ _)) accumulator =
        HashMap.insert typeName type' accumulator
    addTypeDefinition type'@(UnionType (Out.UnionType typeName _ _)) accumulator =
        HashMap.insert typeName type' accumulator
    collectedTypes = collectReferencedTypes queryRoot mutationRoot subscriptionRoot allTypes
    collectedImplementations = collectImplementations collectedTypes
    allDirectives = HashMap.union directiveDefinitions defaultDirectives
    defaultDirectives = HashMap.fromList
        [ ("skip", skipDirective)
        , ("include", includeDirective)
        , ("deprecated", deprecatedDirective)
        , ("specifiedBy", specifiedByDirective)
        ]
    includeDirective =
        Directive includeDescription includeArguments False skipIncludeLocations
    includeArguments = HashMap.singleton "if"
        $ In.Argument (Just "Included when true.") ifType Nothing
    includeDescription = Just
        "Directs the executor to include this field or fragment only when the \
        \`if` argument is true."
    skipDirective = Directive skipDescription skipArguments False skipIncludeLocations
    skipArguments = HashMap.singleton "if"
        $ In.Argument (Just "skipped when true.") ifType Nothing
    ifType = In.NonNullScalarType Definition.boolean
    skipDescription = Just
        "Directs the executor to skip this field or fragment when the `if` \
        \argument is true."
    skipIncludeLocations =
        [ ExecutableDirectiveLocation DirectiveLocation.Field
        , ExecutableDirectiveLocation DirectiveLocation.FragmentSpread
        , ExecutableDirectiveLocation DirectiveLocation.InlineFragment
        ]
    deprecatedDirective =
        Directive deprecatedDescription deprecatedArguments False deprecatedLocations
    reasonDescription = Just
        "Explains why this element was deprecated, usually also including a \
        \suggestion for how to access supported similar data. Formatted using \
        \the Markdown syntax, as specified by \
        \[CommonMark](https://commonmark.org/).'"
    deprecatedArguments = HashMap.singleton "reason"
        $ In.Argument reasonDescription (In.NamedScalarType Definition.string)
        $ Just "No longer supported"
    deprecatedDescription = Just
        "Marks an element of a GraphQL schema as no longer supported."
    deprecatedLocations =
        [ TypeSystemDirectiveLocation DirectiveLocation.FieldDefinition
        , TypeSystemDirectiveLocation DirectiveLocation.ArgumentDefinition
        , TypeSystemDirectiveLocation DirectiveLocation.InputFieldDefinition
        , TypeSystemDirectiveLocation DirectiveLocation.EnumValue
        ]
    specifiedByDirective =
        Directive specifiedByDescription specifiedByArguments False specifiedByLocations
    urlDescription = Just
        "The URL that specifies the behavior of this scalar."
    specifiedByArguments = HashMap.singleton "url"
        $ In.Argument urlDescription (In.NonNullScalarType Definition.string) Nothing
    specifiedByDescription = Just
        "Exposes a URL that specifies the behavior of this scalar."
    specifiedByLocations =
        [TypeSystemDirectiveLocation DirectiveLocation.Scalar]
 -- | Traverses the schema and finds all referenced types.
 collectReferencedTypes :: forall m
    . Out.ObjectType m
    -> Maybe (Out.ObjectType m)
    -> Maybe (Out.ObjectType m)
    -> HashMap Full.Name (Type m)
    -> HashMap Full.Name (Type m)
 collectReferencedTypes queryRoot mutationRoot subscriptionRoot extraTypes =
    let queryTypes = traverseObjectType queryRoot extraTypes
        mutationTypes = maybe queryTypes (`traverseObjectType` queryTypes)
            mutationRoot
     in maybe mutationTypes (`traverseObjectType` mutationTypes) subscriptionRoot
  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
 -- | Looks for objects and interfaces under the schema types and collects the
 -- interfaces they implement.
 collectImplementations :: forall m
    . HashMap Full.Name (Type m)
    -> HashMap Full.Name [Type m]
 collectImplementations = HashMap.foldr go HashMap.empty
  where
    go implementation@(InterfaceType interfaceType) accumulator =
        let Out.InterfaceType _ _ interfaces _ = interfaceType
         in foldr (add implementation) accumulator interfaces
    go implementation@(ObjectType objectType) accumulator =
        let Out.ObjectType _ _ interfaces _ = objectType
         in foldr (add implementation) accumulator interfaces
    go _ accumulator = accumulator
    add implementation (Out.InterfaceType typeName _ _ _) =
        HashMap.insertWith (++) typeName [implementation]
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@ -0,0 +1,485 @@
 {- 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 LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | GraphQL validator.
 module Language.GraphQL.Validate
    ( Validation.Error(..)
    , document
    , module Language.GraphQL.Validate.Rules
    ) where
 import Control.Monad (join)
 import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Reader (runReaderT)
 import Data.Foldable (toList)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Sequence (Seq(..), (><), (|>))
 import qualified Data.Sequence as Seq
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 import qualified Language.GraphQL.AST.Document as Full
 import qualified Language.GraphQL.Type.Internal as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema (Schema)
 import qualified Language.GraphQL.Type.Schema as Schema
 import Language.GraphQL.Validate.Rules
 import Language.GraphQL.Validate.Validation (Validation(Validation))
 import qualified Language.GraphQL.Validate.Validation as Validation
 type ApplySelectionRule m a
    = HashMap Full.Name (Schema.Type m)
    -> Validation.Rule m
    -> Maybe (Out.Type m)
    -> a
    -> Seq (Validation.RuleT m)
 type ApplyRule m a = Validation.Rule m -> a -> Seq (Validation.RuleT m)
 -- | 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
    -> [Validation.Rule m]
    -> Full.Document
    -> Seq Validation.Error
 document schema' rules' document' =
    runReaderT reader context
  where
    context = Validation
        { Validation.ast = document'
        , Validation.schema = schema'
        }
    reader = do
        rule' <- lift $ Seq.fromList rules'
        join $ lift $ foldr (definition rule' context) Seq.empty document'
 definition :: Validation.Rule m
    -> Validation m
    -> Full.Definition
    -> Seq (Validation.RuleT m)
    -> Seq (Validation.RuleT m)
 definition (Validation.DefinitionRule rule) _ definition' accumulator =
    accumulator |> rule definition'
 definition rule context (Full.ExecutableDefinition definition') accumulator =
    accumulator >< executableDefinition rule context definition'
 definition rule context (Full.TypeSystemDefinition typeSystemDefinition' _) accumulator =
    accumulator >< typeSystemDefinition context rule typeSystemDefinition'
 definition rule context (Full.TypeSystemExtension extension _) accumulator =
    accumulator >< typeSystemExtension context rule extension
 typeSystemExtension :: forall m
    . Validation m
    -> ApplyRule m Full.TypeSystemExtension
 typeSystemExtension context rule = \case
    Full.SchemaExtension extension -> schemaExtension context rule extension
    Full.TypeExtension extension -> typeExtension context rule extension
 typeExtension :: forall m. Validation m -> ApplyRule m Full.TypeExtension
 typeExtension context rule = \case
    Full.ScalarTypeExtension _ directives' ->
        directives context rule scalarLocation directives'
    Full.ObjectTypeFieldsDefinitionExtension _ _ directives' fields
        -> directives context rule objectLocation directives'
        >< foldMap (fieldDefinition context rule) fields
    Full.ObjectTypeDirectivesExtension _ _ directives' ->
        directives context rule objectLocation directives'
    Full.ObjectTypeImplementsInterfacesExtension _ _ -> mempty
    Full.InterfaceTypeFieldsDefinitionExtension _ directives' fields
        -> directives context rule interfaceLocation directives'
        >< foldMap (fieldDefinition context rule) fields
    Full.InterfaceTypeDirectivesExtension _ directives' ->
        directives context rule interfaceLocation directives'
    Full.UnionTypeUnionMemberTypesExtension _ directives' _ ->
        directives context rule unionLocation directives'
    Full.UnionTypeDirectivesExtension _ directives' ->
        directives context rule unionLocation directives'
    Full.EnumTypeEnumValuesDefinitionExtension _ directives' values
        -> directives context rule enumLocation directives'
        >< foldMap (enumValueDefinition context rule) values
    Full.EnumTypeDirectivesExtension _ directives' ->
        directives context rule enumLocation directives'
    Full.InputObjectTypeInputFieldsDefinitionExtension _ directives' fields
        -> directives context rule inputObjectLocation directives'
        >< foldMap forEachInputFieldDefinition fields
    Full.InputObjectTypeDirectivesExtension _ directives' ->
        directives context rule inputObjectLocation directives'
  where
    forEachInputFieldDefinition =
        inputValueDefinition context rule inputFieldDefinitionLocation
 schemaExtension :: forall m. Validation m -> ApplyRule m Full.SchemaExtension
 schemaExtension context rule = \case
    Full.SchemaOperationExtension directives' _ ->
        directives context rule schemaLocation directives'
    Full.SchemaDirectivesExtension directives' ->
        directives context rule schemaLocation directives'
 schemaLocation :: DirectiveLocation
 schemaLocation = TypeSystemDirectiveLocation DirectiveLocation.Schema
 interfaceLocation :: DirectiveLocation
 interfaceLocation = TypeSystemDirectiveLocation DirectiveLocation.Interface
 objectLocation :: DirectiveLocation
 objectLocation = TypeSystemDirectiveLocation DirectiveLocation.Object
 unionLocation :: DirectiveLocation
 unionLocation = TypeSystemDirectiveLocation DirectiveLocation.Union
 enumLocation :: DirectiveLocation
 enumLocation = TypeSystemDirectiveLocation DirectiveLocation.Enum
 inputObjectLocation :: DirectiveLocation
 inputObjectLocation = TypeSystemDirectiveLocation DirectiveLocation.InputObject
 scalarLocation :: DirectiveLocation
 scalarLocation = TypeSystemDirectiveLocation DirectiveLocation.Scalar
 enumValueLocation :: DirectiveLocation
 enumValueLocation = TypeSystemDirectiveLocation DirectiveLocation.EnumValue
 fieldDefinitionLocation :: DirectiveLocation
 fieldDefinitionLocation =
    TypeSystemDirectiveLocation DirectiveLocation.FieldDefinition
 inputFieldDefinitionLocation :: DirectiveLocation
 inputFieldDefinitionLocation =
    TypeSystemDirectiveLocation DirectiveLocation.InputFieldDefinition
 argumentDefinitionLocation :: DirectiveLocation
 argumentDefinitionLocation =
    TypeSystemDirectiveLocation DirectiveLocation.ArgumentDefinition
 queryLocation :: DirectiveLocation
 queryLocation = ExecutableDirectiveLocation DirectiveLocation.Query
 mutationLocation :: DirectiveLocation
 mutationLocation = ExecutableDirectiveLocation DirectiveLocation.Mutation
 subscriptionLocation :: DirectiveLocation
 subscriptionLocation =
    ExecutableDirectiveLocation DirectiveLocation.Subscription
 fieldLocation :: DirectiveLocation
 fieldLocation = ExecutableDirectiveLocation DirectiveLocation.Field
 fragmentDefinitionLocation :: DirectiveLocation
 fragmentDefinitionLocation =
    ExecutableDirectiveLocation DirectiveLocation.FragmentDefinition
 fragmentSpreadLocation :: DirectiveLocation
 fragmentSpreadLocation =
    ExecutableDirectiveLocation DirectiveLocation.FragmentSpread
 inlineFragmentLocation :: DirectiveLocation
 inlineFragmentLocation =
    ExecutableDirectiveLocation DirectiveLocation.InlineFragment
 executableDefinition :: forall m
    . Validation.Rule m
    -> Validation m
    -> Full.ExecutableDefinition
    -> Seq (Validation.RuleT m)
 executableDefinition rule context (Full.DefinitionOperation operation) =
    operationDefinition rule context operation
 executableDefinition rule context (Full.DefinitionFragment fragment) =
    fragmentDefinition rule context fragment
 typeSystemDefinition :: forall m
    . Validation m
    -> ApplyRule m Full.TypeSystemDefinition
 typeSystemDefinition context rule = \case
    Full.SchemaDefinition directives' _ ->
        directives context rule schemaLocation directives'
    Full.TypeDefinition typeDefinition' ->
        typeDefinition context rule typeDefinition'
    Full.DirectiveDefinition _ _ arguments' _ _ ->
        argumentsDefinition context rule arguments'
 typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
 typeDefinition context rule = \case
    Full.ScalarTypeDefinition _ _ directives' ->
        directives context rule scalarLocation directives'
    Full.ObjectTypeDefinition _ _ _ directives' fields
        -> directives context rule objectLocation directives'
        >< foldMap (fieldDefinition context rule) fields
    Full.InterfaceTypeDefinition _ _ _ directives' fields
        -> directives context rule interfaceLocation directives'
        >< foldMap (fieldDefinition context rule) fields
    Full.UnionTypeDefinition _ _ directives' _ ->
        directives context rule unionLocation directives'
    Full.EnumTypeDefinition _ _ directives' values
        -> directives context rule enumLocation directives'
        >< foldMap (enumValueDefinition context rule) values
    Full.InputObjectTypeDefinition _ _ directives' fields
        -> directives context rule inputObjectLocation directives'
        <> foldMap forEachInputFieldDefinition fields
  where
    forEachInputFieldDefinition =
        inputValueDefinition context rule inputFieldDefinitionLocation
 enumValueDefinition :: forall m
    . Validation m
    -> ApplyRule m Full.EnumValueDefinition
 enumValueDefinition context rule (Full.EnumValueDefinition _ _ directives') =
    directives context rule enumValueLocation directives'
 fieldDefinition :: forall m. Validation m -> ApplyRule m Full.FieldDefinition
 fieldDefinition context rule (Full.FieldDefinition _ _ arguments' _ directives')
    = directives context rule fieldDefinitionLocation directives'
    >< argumentsDefinition context rule arguments'
 argumentsDefinition :: forall m
    . Validation m
    -> ApplyRule m Full.ArgumentsDefinition
 argumentsDefinition context rule (Full.ArgumentsDefinition definitions) =
    foldMap forEachArgument definitions
  where
    forEachArgument =
        inputValueDefinition context rule argumentDefinitionLocation
 inputValueDefinition :: forall m
    . Validation m
    -> Validation.Rule m
    -> DirectiveLocation
    -> Full.InputValueDefinition
    -> Seq (Validation.RuleT m)
 inputValueDefinition context rule directiveLocation definition' =
    let Full.InputValueDefinition _ _ _ _ directives' = definition'
     in directives context rule directiveLocation directives'
 operationDefinition :: forall m
    . Validation.Rule m
    -> Validation m
    -> Full.OperationDefinition
    -> Seq (Validation.RuleT m)
 operationDefinition rule context operation
    | Validation.OperationDefinitionRule operationRule <- rule =
        pure $ operationRule operation
    | Validation.VariablesRule variablesRule <- rule
    , Full.OperationDefinition _ _ variables _ _ _ <- operation =
        foldMap (variableDefinition context rule) variables |> variablesRule variables
    | Full.SelectionSet selections _ <- operation =
        selectionSet context types' rule queryRoot selections
    | Full.OperationDefinition Full.Query _ _ directives' selections _  <- operation
        = selectionSet context types' rule queryRoot selections
        >< directives context rule queryLocation directives'
    | Full.OperationDefinition Full.Mutation _ _ directives' selections _  <- operation =
        let root = Out.NamedObjectType <$> Schema.mutation schema'
         in selectionSet context types' rule root selections
        >< directives context rule mutationLocation directives'
    | Full.OperationDefinition Full.Subscription _ _ directives' selections _  <- operation =
        let root = Out.NamedObjectType <$> Schema.subscription schema'
         in selectionSet context types' rule root selections
        >< directives context rule subscriptionLocation directives'
  where
    schema' = Validation.schema context
    queryRoot = Just $ Out.NamedObjectType $ Schema.query schema'
    types' = Schema.types schema'
 typeToOut :: forall m. Schema.Type m -> Maybe (Out.Type m)
 typeToOut (Schema.ObjectType objectType) =
    Just $ Out.NamedObjectType objectType
 typeToOut (Schema.InterfaceType interfaceType) =
    Just $ Out.NamedInterfaceType interfaceType
 typeToOut (Schema.UnionType unionType) = Just $ Out.NamedUnionType unionType
 typeToOut (Schema.EnumType enumType) = Just $ Out.NamedEnumType enumType
 typeToOut (Schema.ScalarType scalarType) = Just $ Out.NamedScalarType scalarType
 typeToOut _ = Nothing
 variableDefinition :: forall m
    . Validation m
    -> ApplyRule m Full.VariableDefinition
 variableDefinition context rule (Full.VariableDefinition _ typeName value' _)
    | Just defaultValue' <- value'
    , types <- Schema.types $ Validation.schema context
    , variableType <- Type.lookupInputType typeName types =
        constValue rule variableType defaultValue'
 variableDefinition _ _ _ = mempty
 constValue :: forall m
    . Validation.Rule m
    -> Maybe In.Type
    -> Full.Node Full.ConstValue
    -> Seq (Validation.RuleT m)
 constValue (Validation.ValueRule _ rule) valueType = go valueType
  where
    go inputObjectType value'@(Full.Node (Full.ConstObject fields) _)
        = foldMap (forEach inputObjectType) (Seq.fromList fields)
        |> rule inputObjectType value'
    go anotherValue value' = pure $ rule anotherValue value'
    forEach inputObjectType Full.ObjectField{value = value', ..} =
        go (valueTypeByName name inputObjectType) value'
 constValue _ _ = const mempty
 inputFieldType :: In.InputField -> In.Type
 inputFieldType (In.InputField _ inputFieldType' _) = inputFieldType'
 valueTypeByName :: Full.Name -> Maybe In.Type -> Maybe In.Type
 valueTypeByName fieldName (Just( In.InputObjectBaseType inputObjectType)) =
    let In.InputObjectType _ _ fieldTypes = inputObjectType
     in inputFieldType <$> HashMap.lookup fieldName fieldTypes
 valueTypeByName _ _ = Nothing
 fragmentDefinition :: forall m
    . Validation.Rule m
    -> Validation m
    -> Full.FragmentDefinition
    -> Seq (Validation.RuleT m)
 fragmentDefinition (Validation.FragmentDefinitionRule rule) _ definition' =
    pure $ rule definition'
 fragmentDefinition rule context definition'
    | Full.FragmentDefinition _ typeCondition directives' selections _ <- definition'
    , Validation.FragmentRule definitionRule _ <- rule
        = applyToChildren typeCondition directives' selections
        |> definitionRule definition'
    | Full.FragmentDefinition _ typeCondition directives' selections _ <- definition'
        = applyToChildren typeCondition directives' selections
  where
    types' = Schema.types $ Validation.schema context
    applyToChildren typeCondition directives' selections
        = selectionSet context types' rule (lookupType' typeCondition) selections
        >< directives context rule fragmentDefinitionLocation directives'
    lookupType' = flip lookupType types'
 lookupType :: forall m
    . Full.TypeCondition
    -> HashMap Full.Name (Schema.Type m)
    -> Maybe (Out.Type m)
 lookupType typeCondition types' = HashMap.lookup typeCondition types'
    >>= typeToOut
 selectionSet :: Traversable t
    => forall m
    . Validation m
    -> ApplySelectionRule m (t Full.Selection)
 selectionSet context types' rule = foldMap . selection context types' rule
 selection :: forall m. Validation m -> ApplySelectionRule m Full.Selection
 selection context types' rule objectType selection'
    | Validation.SelectionRule selectionRule <- rule =
        applyToChildren |> selectionRule objectType selection'
    | otherwise = applyToChildren
  where
    applyToChildren =
        case selection' of
            Full.FieldSelection field' ->
                field context types' rule objectType field'
            Full.InlineFragmentSelection inlineFragment' ->
                inlineFragment context types' rule objectType inlineFragment'
            Full.FragmentSpreadSelection fragmentSpread' ->
                fragmentSpread context rule fragmentSpread'
 field :: forall m. Validation m -> ApplySelectionRule m Full.Field
 field context types' rule objectType field' = go field'
  where
    go (Full.Field _ fieldName _ _ _ _)
        | Validation.FieldRule fieldRule <- rule =
            applyToChildren fieldName |> fieldRule objectType field'
        | Validation.ArgumentsRule argumentsRule _  <- rule =
            applyToChildren fieldName |> argumentsRule objectType field'
        | otherwise = applyToChildren fieldName
    typeFieldType (Out.Field _ type' _) = type'
    typeFieldArguments (Out.Field _ _ argumentTypes) = argumentTypes
    applyToChildren fieldName =
        let Full.Field _ _ arguments' directives' selections _ = field'
            typeField = objectType >>= Type.lookupTypeField fieldName
            argumentTypes = maybe mempty typeFieldArguments typeField
         in selectionSet context types' rule (typeFieldType <$> typeField) selections
            >< directives context rule fieldLocation directives'
            >< arguments rule argumentTypes arguments'
 arguments :: forall m
    . Validation.Rule m
    -> In.Arguments
    -> [Full.Argument]
    -> Seq (Validation.RuleT m)
 arguments rule argumentTypes = foldMap forEach . Seq.fromList
  where
    forEach argument'@(Full.Argument argumentName _ _) =
       let argumentType = HashMap.lookup argumentName argumentTypes
        in argument rule argumentType argument'
 argument :: forall m
    . Validation.Rule m
    -> Maybe In.Argument
    -> Full.Argument
    -> Seq (Validation.RuleT m)
 argument rule argumentType (Full.Argument _ value' _) =
    value rule (valueType <$> argumentType) value'
  where
    valueType (In.Argument _ valueType' _) = valueType'
 value :: forall m
    . Validation.Rule m
    -> Maybe In.Type
    -> Full.Node Full.Value
    -> Seq (Validation.RuleT m)
 value (Validation.ValueRule rule _) valueType = go valueType
  where
    go inputObjectType value'@(Full.Node (Full.Object fields) _)
        = foldMap (forEach inputObjectType) (Seq.fromList fields)
        |> rule inputObjectType value'
    go anotherValue value' = pure $ rule anotherValue value'
    forEach inputObjectType Full.ObjectField{value = value', ..} =
        go (valueTypeByName name inputObjectType) value'
 value _ _ = const mempty
 inlineFragment :: forall m
    . Validation m
    -> ApplySelectionRule m Full.InlineFragment
 inlineFragment context types' rule objectType inlineFragment' =
    go inlineFragment'
  where
    go (Full.InlineFragment optionalType directives' selections _)
        | Validation.FragmentRule _ fragmentRule <- rule
            = applyToChildren (refineTarget optionalType) directives' selections
            |> fragmentRule inlineFragment'
        | otherwise = applyToChildren (refineTarget optionalType) directives' selections
    refineTarget (Just typeCondition) = lookupType typeCondition types'
    refineTarget Nothing = objectType
    applyToChildren objectType' directives' selections
        = selectionSet context types' rule objectType' selections
        >< directives context rule inlineFragmentLocation directives'
 fragmentSpread :: forall m. Validation m -> ApplyRule m Full.FragmentSpread
 fragmentSpread context rule fragmentSpread'@(Full.FragmentSpread _ directives' _)
    | Validation.FragmentSpreadRule fragmentRule <- rule =
        applyToChildren |> fragmentRule fragmentSpread'
    | otherwise = applyToChildren
  where
    applyToChildren = directives context rule fragmentSpreadLocation directives'
 directives :: Traversable t
    => forall m
    . Validation m
    -> Validation.Rule m
    -> DirectiveLocation
    -> t Full.Directive
    -> Seq (Validation.RuleT m)
 directives context rule directiveLocation directives'
    | Validation.DirectivesRule directivesRule <- rule =
        applyToChildren |> directivesRule directiveLocation directiveList
    | otherwise = applyToChildren
  where
    directiveList = toList directives'
    applyToChildren = foldMap (directive context rule) directiveList
 directive :: forall m. Validation m -> ApplyRule m Full.Directive
 directive _ (Validation.ArgumentsRule _ argumentsRule) directive' =
    pure $ argumentsRule directive'
 directive context rule (Full.Directive directiveName arguments' _) =
    let argumentTypes = maybe HashMap.empty directiveArguments
            $ HashMap.lookup directiveName
            $ Schema.directives
            $ Validation.schema context
     in arguments rule argumentTypes arguments'
  where
    directiveArguments (Schema.Directive _ argumentTypes _ _) = argumentTypes
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
--- a/src/Language/GraphQL/Validate/Validation.hs
+++ b/src/Language/GraphQL/Validate/Validation.hs
@ -0,0 +1,50 @@
 {- 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/. -}
 -- | Definitions used by the validation rules and the validator itself.
 module Language.GraphQL.Validate.Validation
    ( Error(..)
    , Rule(..)
    , RuleT
    , Validation(..)
    ) where
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Sequence (Seq)
 import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
 import Language.GraphQL.AST.Document
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema (Schema)
 -- | Validation error.
 data Error = Error
    { message :: String
    , locations :: [Location]
    } deriving (Eq, Show)
 -- | Validation rule context.
 data Validation m = Validation
    { ast :: Document
    , schema :: Schema m
    }
 -- | '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.
 data Rule m
    = DefinitionRule (Definition -> RuleT m)
    | OperationDefinitionRule (OperationDefinition -> RuleT m)
    | FragmentDefinitionRule (FragmentDefinition -> RuleT m)
    | SelectionRule (Maybe (Out.Type m) -> Selection -> RuleT m)
    | FragmentRule (FragmentDefinition -> RuleT m) (InlineFragment -> RuleT m)
    | FragmentSpreadRule (FragmentSpread -> RuleT m)
    | FieldRule (Maybe (Out.Type m) -> Field -> RuleT m)
    | ArgumentsRule (Maybe (Out.Type m) -> Field -> RuleT m) (Directive -> RuleT m)
    | DirectivesRule (DirectiveLocation -> [Directive] -> RuleT m)
    | VariablesRule ([VariableDefinition] -> RuleT m)
    | ValueRule (Maybe In.Type -> Node Value -> RuleT m) (Maybe In.Type -> Node ConstValue -> RuleT m)
 -- | Monad transformer used by the rules.
 type RuleT m = ReaderT (Validation m) Seq Error
--- a/stack.yaml
+++ b/stack.yaml
@ -1,9 +0,0 @@
 resolver: lts-14.18
 packages:
 - .
 extra-deps: []
 flags: {}
 pvp-bounds: both
--- a/tests/Language/GraphQL/AST/Arbitrary.hs
+++ b/tests/Language/GraphQL/AST/Arbitrary.hs
@ -0,0 +1,130 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.AST.Arbitrary
    ( AnyArgument(..)
    , AnyLocation(..)
    , AnyName(..)
    , AnyNode(..)
    , AnyObjectField(..)
    , AnyValue(..)
    , printArgument
    ) where
 import qualified Language.GraphQL.AST.Document as Doc
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
 import Test.QuickCheck.Gen (Gen (..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Functor ((<&>))
 newtype AnyPrintableChar = AnyPrintableChar
    { getAnyPrintableChar :: Char
    } deriving (Eq, Show)
 alpha :: String
 alpha = ['a'..'z'] <> ['A'..'Z']
 num :: String
 num = ['0'..'9']
 instance Arbitrary AnyPrintableChar where
    arbitrary = AnyPrintableChar <$> elements chars
        where
           chars = alpha <> num <> ['_']
 newtype AnyPrintableText = AnyPrintableText
    { getAnyPrintableText :: Text
    } deriving (Eq, Show)
 instance Arbitrary AnyPrintableText where
    arbitrary = do
        nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
        pure $ AnyPrintableText
            $ Text.pack
            $ map getAnyPrintableChar nonEmptyStr
 -- https://spec.graphql.org/June2018/#Name
 newtype AnyName = AnyName
    { getAnyName :: Text
    } deriving (Eq, Show)
 instance Arbitrary AnyName where
    arbitrary = do
        firstChar <- elements $ alpha <> ['_']
        rest <- (arbitrary :: Gen [AnyPrintableChar])
        pure $ AnyName
            $ Text.pack
            $ firstChar : map getAnyPrintableChar rest
 newtype AnyLocation = AnyLocation
    { getAnyLocation :: Doc.Location
    } deriving (Eq, Show)
 instance Arbitrary AnyLocation where
    arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
 newtype AnyNode a = AnyNode
    { getAnyNode :: Doc.Node a
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyNode a) where
    arbitrary = do
        (AnyLocation location') <- arbitrary
        node' <- flip Doc.Node location' <$> arbitrary
        pure $ AnyNode node'
 newtype AnyObjectField a = AnyObjectField
    { getAnyObjectField :: Doc.ObjectField a
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyObjectField a) where
    arbitrary = do
        name' <- getAnyName <$> arbitrary
        value' <- getAnyNode <$> arbitrary
        location' <- getAnyLocation <$> arbitrary
        pure $ AnyObjectField $ Doc.ObjectField name' value' location'
 newtype AnyValue = AnyValue
    { getAnyValue :: Doc.Value
    } deriving (Eq, Show)
 instance Arbitrary AnyValue
  where
    arbitrary =
        let variableGen :: Gen Doc.Value
            variableGen = Doc.Variable . getAnyName <$> arbitrary
            listGen :: Gen [Doc.Node Doc.Value]
            listGen = (resize 5 . listOf) nodeGen
            nodeGen :: Gen (Doc.Node Doc.Value)
            nodeGen = fmap getAnyNode arbitrary <&> fmap getAnyValue
            objectGen :: Gen [Doc.ObjectField Doc.Value]
            objectGen = resize 1
                $ fmap getNonEmpty arbitrary
                <&> map (fmap getAnyValue . getAnyObjectField)
         in AnyValue <$> oneof
            [ variableGen
            , Doc.Int <$> arbitrary
            , Doc.Float <$> arbitrary
            , Doc.String . getAnyPrintableText <$> arbitrary
            , Doc.Boolean <$> arbitrary
            , MkGen $ \_ _ -> Doc.Null
            , Doc.Enum . getAnyName <$> arbitrary
            , Doc.List <$> listGen
            , Doc.Object <$> objectGen
            ]
 newtype AnyArgument a = AnyArgument
    { getAnyArgument :: Doc.Argument
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyArgument a) where
    arbitrary = do
        name' <- getAnyName <$> arbitrary
        (AnyValue value') <- arbitrary
        (AnyLocation location') <- arbitrary
        pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
 printArgument :: AnyArgument AnyValue -> Text
 printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
    name' <> ": " <> (Text.pack . show) value'
--- a/tests/Language/GraphQL/AST/DocumentSpec.hs
+++ b/tests/Language/GraphQL/AST/DocumentSpec.hs
@ -0,0 +1,26 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.AST.DocumentSpec
    ( spec
    ) where
 import Language.GraphQL.AST.Document
 import Test.Hspec (Spec, describe, it, shouldBe)
 spec :: Spec
 spec = do
    describe "Document" $ do
        it "shows objects" $
            let zero = Location 0 0
                object = ConstObject
                    [ ObjectField "field1" (Node (ConstFloat 1.2) zero) zero
                    , ObjectField "field2" (Node ConstNull zero) zero
                    ]
                expected = "{ field1: 1.2, field2: null }"
             in show object `shouldBe` expected
    describe "Description" $
        it "keeps content when merging with no description" $
            let expected = Description $ Just "Left description"
                actual = expected <> Description Nothing
             in actual `shouldBe` expected
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@ -1,46 +1,254 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.EncoderSpec
    ( spec
    ) where
-import Language.GraphQL.AST
+import Data.List.NonEmpty (NonEmpty(..))
 import qualified Language.GraphQL.AST.Document as Full
 import Language.GraphQL.AST.Encoder
-import Test.Hspec (Spec, context, describe, it, shouldBe)
+import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
-import Text.RawString.QQ (r)
+import Test.QuickCheck (choose, oneof, forAll)
 import qualified Data.Text.Lazy as Text.Lazy
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 spec :: Spec
 spec = do
    describe "value" $ do
        context "minified" $ do
            it "encodes null" $
                value minified Full.Null `shouldBe` "null"
            it "escapes \\" $
-                value minified (String "\\") `shouldBe` "\"\\\\\""
+                value minified (Full.String "\\") `shouldBe` "\"\\\\\""
-            it "escapes quotes" $
+            it "escapes double quotes" $
-                value minified (String "\"") `shouldBe` "\"\\\"\""
+                value minified (Full.String "\"") `shouldBe` "\"\\\"\""
            it "escapes \\f" $
                value minified (Full.String "\f") `shouldBe` "\"\\f\""
            it "escapes \\n" $
                value minified (Full.String "\n") `shouldBe` "\"\\n\""
            it "escapes \\r" $
                value minified (Full.String "\r") `shouldBe` "\"\\r\""
            it "escapes \\t" $
                value minified (Full.String "\t") `shouldBe` "\"\\t\""
            it "escapes backspace" $
-                value minified (String "a\bc") `shouldBe` "\"a\\bc\""
+                value minified (Full.String "a\bc") `shouldBe` "\"a\\bc\""
-            it "escapes Unicode" $
+            context "escapes Unicode for chars less than 0010" $ do
-                value minified (String "\0") `shouldBe` "\"\\u0000\""
+                it "Null" $ value minified (Full.String "\x0000") `shouldBe` "\"\\u0000\""
                it "bell" $ value minified (Full.String "\x0007") `shouldBe` "\"\\u0007\""
            context "escapes Unicode for char less than 0020" $ do
                it "DLE" $ value minified (Full.String "\x0010") `shouldBe` "\"\\u0010\""
                it "EM" $ value minified (Full.String "\x0019") `shouldBe` "\"\\u0019\""
            context "encodes without escape" $ do
                it "space" $ value minified (Full.String "\x0020") `shouldBe` "\" \""
                it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
        context "pretty" $ do
            it "encodes null" $
                value pretty Full.Null `shouldBe` "null"
            it "uses strings for short string values" $
-                value pretty (String "Short text") `shouldBe` "\"Short text\""
+                value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
-            it "uses block strings for text with new lines" $
+            it "uses block strings for text with new lines, with newline symbol" $
-                value pretty (String "Line 1\nLine 2")
+                let expected = "\"\"\"\n\
-                    `shouldBe` "\"\"\"\n  Line 1\n  Line 2\n\"\"\""
+                        \  Line 1\n\
-            it "escapes \\ in short strings" $
+                        \  Line 2\n\
-                value pretty (String "\\") `shouldBe` "\"\\\\\""
+                        \\"\"\""
                    actual = value pretty $ Full.String "Line 1\nLine 2"
                 in actual `shouldBe` expected
            it "uses block strings for text with new lines, with CR symbol" $
                let expected = "\"\"\"\n\
                        \  Line 1\n\
                        \  Line 2\n\
                        \\"\"\""
                    actual = value pretty $ Full.String "Line 1\rLine 2"
                 in actual `shouldBe` expected
            it "uses block strings for text with new lines, with CR symbol followed by newline" $
                let expected = "\"\"\"\n\
                        \  Line 1\n\
                        \  Line 2\n\
                        \\"\"\""
                    actual = value pretty $ Full.String "Line 1\r\nLine 2"
                 in actual `shouldBe` expected
            it "encodes as one line string if has escaped symbols" $ do
                let genNotAllowedSymbol = oneof
                        [ choose ('\x0000', '\x0008')
                        , choose ('\x000B', '\x000C')
                        , choose ('\x000E', '\x001F')
                        , pure '\x007F'
                        ]
                forAll genNotAllowedSymbol $ \x -> do
                    let rawValue = "Short \n" <> Text.Lazy.cons x "text"
                        encoded = Text.Lazy.unpack
                            $ value pretty
                            $ Full.String
                            $ Text.Lazy.toStrict rawValue
                    shouldStartWith encoded "\""
                    shouldEndWith encoded "\""
                    shouldNotContain encoded "\"\"\""
            it "Hello world" $
                let actual = value pretty
                        $ Full.String "Hello,\n  World!\n\nYours,\n  GraphQL."
                    expected = "\"\"\"\n\
                        \  Hello,\n\
                        \    World!\n\
                        \\n\
                        \  Yours,\n\
                        \    GraphQL.\n\
                        \\"\"\""
                  in actual `shouldBe` expected
            it "has only newlines" $
                let actual = value pretty $ Full.String "\n"
                    expected = "\"\"\"\n\n\n\"\"\""
                 in actual `shouldBe` expected
            it "has newlines and one symbol at the begining" $
                let actual = value pretty $ Full.String "a\n\n"
                    expected = "\"\"\"\n\
                        \  a\n\
                        \\n\
                        \\n\
                        \\"\"\""
                 in actual `shouldBe` expected
            it "has newlines and one symbol at the end" $
                let actual = value pretty $ Full.String "\n\na"
                    expected = "\"\"\"\n\
                        \\n\
                        \\n\
                        \  a\n\
                        \\"\"\""
                 in actual `shouldBe` expected
            it "has newlines and one symbol in the middle" $
                let actual = value pretty $ Full.String "\na\n"
                    expected = "\"\"\"\n\
                        \\n\
                        \  a\n\
                        \\n\
                        \\"\"\""
                 in actual `shouldBe` expected
            it "skip trailing whitespaces" $
                let actual = value pretty $ Full.String "  Short\ntext    "
                    expected = "\"\"\"\n\
                        \  Short\n\
                        \  text\n\
                        \\"\"\""
                 in actual `shouldBe` expected
    describe "definition" $
        it "indents block strings in arguments" $
-            let arguments = [Argument "message" (String "line1\nline2")]
+            let location = Full.Location 0 0
-                field = Field Nothing "field" arguments [] []
+                argumentValue = Full.Node (Full.String "line1\nline2") location
-                set = OperationSelectionSet $ pure $ SelectionField field
+                arguments = [Full.Argument "message" argumentValue location]
-                operation = DefinitionOperation set
+                field = Full.Field Nothing "field" arguments [] [] location
-             in definition pretty operation `shouldBe` [r|{
+                fieldSelection = pure $ Full.FieldSelection field
-  field(message: """
+                operation = Full.DefinitionOperation
-    line1
+                    $ Full.SelectionSet fieldSelection location
-    line2
+                expected = "{\n\
-  """)
+                    \  field(message: \"\"\"\n\
-}
+                    \    line1\n\
-|]
+                    \    line2\n\
                    \  \"\"\")\n\
                    \}\n"
                actual = definition pretty operation
             in actual `shouldBe` expected
    describe "operationType" $
        it "produces lowercase mutation operation type" $
            let actual = operationType pretty Full.Mutation
             in actual `shouldBe` "mutation"
    describe "typeSystemDefinition" $ do
        it "produces a schema with an indented operation type definition" $
            let queryType = Full.OperationTypeDefinition Full.Query "QueryRootType"
                mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType"
                operations = queryType :| pure mutationType
                definition' = Full.SchemaDefinition [] operations
                expected = "schema {\n\
                    \  query: QueryRootType\n\
                    \  mutation: MutationType\n\
                    \}\n"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        it "encodes a scalar type definition" $
            let uuidType = Full.ScalarTypeDefinition mempty "UUID" mempty
                definition' = Full.TypeDefinition uuidType
                expected = "scalar UUID"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        it "encodes an interface definition" $
            let someType = Full.TypeNamed "String"
                argument = Full.InputValueDefinition mempty "arg" someType Nothing mempty
                arguments = Full.ArgumentsDefinition [argument]
                definition' = Full.TypeDefinition
                    $ Full.InterfaceTypeDefinition mempty "UUID" (Full.ImplementsInterfaces []) mempty
                    $ pure
                    $ Full.FieldDefinition mempty "value" arguments someType mempty
                expected = "interface UUID {\n\
                    \  value(arg: String): String\n\
                    \}"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        it "encodes an union definition" $
            let definition' = Full.TypeDefinition
                    $ Full.UnionTypeDefinition mempty "SearchResult" mempty
                    $ Full.UnionMemberTypes ["Photo", "Person"]
                expected = "union SearchResult =\n\
                    \  | Photo\n\
                    \  | Person"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        it "encodes an enum definition" $
            let values =
                    [ Full.EnumValueDefinition mempty "NORTH" mempty
                    , Full.EnumValueDefinition mempty "EAST" mempty
                    , Full.EnumValueDefinition mempty "SOUTH" mempty
                    , Full.EnumValueDefinition mempty "WEST" mempty
                    ]
                definition' = Full.TypeDefinition
                    $ Full.EnumTypeDefinition mempty "Direction" mempty values
                expected = "enum Direction {\n\
                    \  NORTH\n\
                    \  EAST\n\
                    \  SOUTH\n\
                    \  WEST\n\
                    \}"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        it "encodes an input type" $
            let intType = Full.TypeNonNull $ Full.NonNullTypeNamed "Int"
                stringType = Full.TypeNamed "String"
                fields =
                    [ Full.InputValueDefinition mempty "a" stringType Nothing mempty
                    , Full.InputValueDefinition mempty "b" intType Nothing mempty
                    ]
                definition' = Full.TypeDefinition
                    $ Full.InputObjectTypeDefinition mempty "ExampleInputObject" mempty fields
                expected = "input ExampleInputObject {\n\
                    \  a: String\n\
                    \  b: Int!\n\
                    \}"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
        context "directive definition" $ do
            it "encodes a directive definition" $ do
                let definition' = Full.DirectiveDefinition mempty "example" mempty False
                        $ pure
                        $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
                    expected = "@example() on\n\
                        \  | FIELD"
                    actual = typeSystemDefinition pretty definition'
                 in actual `shouldBe` expected
            it "encodes a repeatable directive definition" $ do
                let definition' = Full.DirectiveDefinition mempty "example" mempty True
                        $ pure
                        $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
                    expected = "@example() repeatable on\n\
                        \  | FIELD"
                    actual = typeSystemDefinition pretty definition'
                 in actual `shouldBe` expected
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.LexerSpec
    ( spec
    ) where
@ -8,9 +7,8 @@ import Data.Text (Text)
 import Data.Void (Void)
 import Language.GraphQL.AST.Lexer
 import Test.Hspec (Spec, context, describe, it)
-import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
+import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
 import Text.Megaparsec (ParseErrorBundle, parse)
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Lexer" $ do
@ -19,38 +17,39 @@ spec = describe "Lexer" $ do
            parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
        it "lexes strings" $ do
-            parse string "" [r|"simple"|] `shouldParse` "simple"
+            parse string "" "\"simple\"" `shouldParse` "simple"
-            parse string "" [r|" white space "|] `shouldParse` " white space "
+            parse string "" "\" white space \"" `shouldParse` " white space "
-            parse string "" [r|"quote \""|] `shouldParse` [r|quote "|]
+            parse string "" "\"quote \\\"\"" `shouldParse` "quote \""
-            parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n"
+            parse string "" "\"escaped \\n\"" `shouldParse` "escaped \n"
-            parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|]
+            parse string "" "\"slashes \\\\ \\/\"" `shouldParse` "slashes \\ /"
-            parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
+            parse string "" "\"unicode \\u1234\\u5678\\u90AB\\uCDEF\""
                `shouldParse` "unicode ሴ噸邫췯"
        it "lexes block string" $ do
-            parse blockString "" [r|"""simple"""|] `shouldParse` "simple"
+            parse blockString "" "\"\"\"simple\"\"\"" `shouldParse` "simple"
-            parse blockString "" [r|""" white space """|]
+            parse blockString "" "\"\"\" white space \"\"\""
                `shouldParse` " white space "
-            parse blockString "" [r|"""contains " quote"""|]
+            parse blockString "" "\"\"\"contains \" quote\"\"\""
-                `shouldParse` [r|contains " quote|]
+                `shouldParse` "contains \" quote"
-            parse blockString "" [r|"""contains \""" triplequote"""|]
+            parse blockString "" "\"\"\"contains \\\"\"\" triplequote\"\"\""
-                `shouldParse` [r|contains """ triplequote|]
+                `shouldParse` "contains \"\"\" triplequote"
            parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
-            parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|]
+            parse blockString "" "\"\"\"unescaped \\n\\r\\b\\t\\f\\u1234\"\"\""
-                `shouldParse` [r|unescaped \n\r\b\t\f\u1234|]
+                `shouldParse` "unescaped \\n\\r\\b\\t\\f\\u1234"
-            parse blockString "" [r|"""slashes \\ \/"""|]
+            parse blockString "" "\"\"\"slashes \\\\ \\/\"\"\""
-                `shouldParse` [r|slashes \\ \/|]
+                `shouldParse` "slashes \\\\ \\/"
-            parse blockString "" [r|"""
+            parse blockString "" "\"\"\"\n\
-
+                \\n\
-                spans
+                \  spans\n\
-                  multiple
+                \    multiple\n\
-                    lines
+                \      lines\n\
-
+                \\n\
-                """|] `shouldParse` "spans\n  multiple\n    lines"
+                \\"\"\""
                `shouldParse` "spans\n  multiple\n    lines"
        it "lexes numbers" $ do
            parse integer "" "4" `shouldParse` (4 :: Int)
@ -75,18 +74,25 @@ spec = describe "Lexer" $ do
            parse dollar "" "$" `shouldParse` "$"
            runBetween parens `shouldSucceedOn` "()"
            parse spread "" "..." `shouldParse` "..."
-            parse colon "" ":" `shouldParse` ":"
+            parse colon "" `shouldSucceedOn` ":"
            parse equals "" "=" `shouldParse` "="
-            parse at "" "@" `shouldParse` '@'
+            parse at "" `shouldSucceedOn` "@"
            runBetween brackets `shouldSucceedOn` "[]"
            runBetween braces `shouldSucceedOn` "{}"
            parse pipe "" "|" `shouldParse` "|"
    context "Implementation tests" $ do
        it "lexes empty block strings" $
-            parse blockString "" [r|""""""|] `shouldParse` ""
+            parse blockString "" "\"\"\"\"\"\"" `shouldParse` ""
        it "lexes ampersand" $
            parse amp "" "&" `shouldParse` "&"
        it "lexes schema extensions" $
            parseExtend "schema" `shouldSucceedOn` "extend schema"
        it "fails if the given token doesn't match" $
            parseExtend "schema" `shouldFailOn` "extend shema"
 parseExtend :: Text -> (Text -> Either (ParseErrorBundle Text Void) ())
 parseExtend extension = parse (extend extension "" $ pure $ pure ()) ""
 runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
 runBetween parser = parse (parser $ pure ()) ""
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -1,44 +1,228 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.ParserSpec
    ( spec
    ) where
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
 import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
 import Language.GraphQL.AST.Parser
-import Test.Hspec (Spec, describe, it)
+import Test.Hspec (Spec, describe, it, context)
-import Test.Hspec.Megaparsec (shouldSucceedOn)
+import Test.Hspec.Megaparsec
    ( shouldParse
    , shouldFailOn
    , parseSatisfies
    , shouldSucceedOn
    )
 import Text.Megaparsec (parse)
-import Text.RawString.QQ (r)
+import Test.QuickCheck (property, NonEmptyList (..), mapSize)
 import Language.GraphQL.AST.Arbitrary
 spec :: Spec
 spec = describe "Parser" $ do
    it "accepts BOM header" $
        parse document "" `shouldSucceedOn` "\xfeff{foo}"
-    it "accepts block strings as argument" $
+    context "Arguments" $ do
-        parse document "" `shouldSucceedOn` [r|{
+        it "accepts block strings as argument" $
-              hello(text: """Argument""")
+            parse document "" `shouldSucceedOn`
-            }|]
+                "{ hello(text: \"\"\"Argument\"\"\") }"
-    it "accepts strings as argument" $
+        it "accepts strings as argument" $
-        parse document "" `shouldSucceedOn` [r|{
+            parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
              hello(text: "Argument")
            }|]
-    it "accepts two required arguments" $
+        it "accepts int as argument" $
-        parse document "" `shouldSucceedOn` [r|
+            parse document "" `shouldSucceedOn` "{ user(id: 4) }"
            mutation auth($username: String!, $password: String!){
                test
            }|]
-    it "accepts two string arguments" $
+        it "accepts boolean as argument" $
-        parse document "" `shouldSucceedOn` [r|
+            parse document "" `shouldSucceedOn`
-            mutation auth{
+                "{ hello(flag: true) { field1 } }"
                test(username: "username", password: "password")
            }|]
-    it "accepts two block string arguments" $
+        it "accepts float as argument" $
-        parse document "" `shouldSucceedOn` [r|
+            parse document "" `shouldSucceedOn`
-            mutation auth{
+                "{ body(height: 172.5) { height } }"
-                test(username: """username""", password: """password""")
+
-            }|]
+        it "accepts empty list as argument" $
            parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
        it "accepts two required arguments" $
            parse document "" `shouldSucceedOn`
                "mutation auth($username: String!, $password: String!) { test }"
        it "accepts two string arguments" $
            parse document "" `shouldSucceedOn`
                "mutation auth { test(username: \"username\", password: \"password\") }"
        it "accepts two block string arguments" $
            let given = "mutation auth {\n\
                    \  test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
                    \}"
             in parse document "" `shouldSucceedOn` given
        it "fails to parse an empty argument list in parens" $
            parse document "" `shouldFailOn` "{ test() }"
        it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
            let arguments' = map printArgument
                    $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
                query' = "query(" <> Text.intercalate ", " arguments' <> ")"
             in parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
    it "parses minimal schema definition" $
        parse document "" `shouldSucceedOn` "schema { query: Query }"
    it "parses minimal scalar definition" $
        parse document "" `shouldSucceedOn` "scalar Time"
    it "parses ImplementsInterfaces" $
        parse document "" `shouldSucceedOn`
            "type Person implements NamedEntity & ValuedEntity {\n\
            \  name: String\n\
            \}"
    it "parses a  type without ImplementsInterfaces" $
        parse document "" `shouldSucceedOn`
            "type Person {\n\
            \  name: String\n\
            \}"
    it "parses ArgumentsDefinition in an ObjectDefinition" $
        parse document "" `shouldSucceedOn`
            "type Person {\n\
            \  name(first: String, last: String): String\n\
            \}"
    it "parses minimal union type definition" $
        parse document "" `shouldSucceedOn`
            "union SearchResult = Photo | Person"
    it "parses minimal interface type definition" $
        parse document "" `shouldSucceedOn`
            "interface NamedEntity {\n\
            \  name: String\n\
            \}"
    it "parses ImplementsInterfaces on interfaces" $
        parse document "" `shouldSucceedOn`
            "interface Person implements NamedEntity & ValuedEntity {\n\
            \  name: String\n\
            \}"
    it "parses minimal enum type definition" $
        parse document "" `shouldSucceedOn`
            "enum Direction {\n\
            \  NORTH\n\
            \  EAST\n\
            \  SOUTH\n\
            \  WEST\n\
            \}"
    it "parses minimal input object type definition" $
        parse document "" `shouldSucceedOn`
            "input Point2D {\n\
            \  x: Float\n\
            \  y: Float\n\
            \}"
    it "parses minimal input enum definition with an optional pipe" $
        parse document "" `shouldSucceedOn`
            "directive @example on\n\
            \  | FIELD\n\
            \  | FRAGMENT_SPREAD"
    it "parses two minimal directive definitions" $
        let directive name' loc = TypeSystemDefinition
                $ DirectiveDefinition
                    (Description Nothing)
                    name'
                    (ArgumentsDefinition [])
                    False
                    (loc :| [])
            example1 = directive "example1"
                (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
                (Location {line = 1, column = 1})
            example2 = directive "example2"
                (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
                (Location {line = 2, column = 1})
            testSchemaExtension = example1 :| [example2]
            query = Text.unlines
                [ "directive @example1 on FIELD_DEFINITION"
                , "directive @example2 on FIELD"
                ]
         in parse document "" query `shouldParse` testSchemaExtension
    it "parses a directive definition with a default empty list argument" $
        let argumentValue = Just
                $ Node (ConstList [])
                $ Location{ line = 1, column = 33 }
            loc = DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition
            argumentValueDefinition = InputValueDefinition
                (Description Nothing)
                "foo"
                (TypeList (TypeNamed "String"))
                argumentValue
                []
            definition = DirectiveDefinition
                (Description Nothing)
                "test"
                (ArgumentsDefinition [argumentValueDefinition])
                False
                (loc :| [])
            directive = TypeSystemDefinition definition
                $ Location{ line = 1, column = 1 }
            query = "directive @test(foo: [String] = []) on FIELD_DEFINITION"
         in parse document "" query `shouldParse` (directive :| [])
    it "parses schema extension with a new directive" $
        parse document "" `shouldSucceedOn` "extend schema @newDirective"
    it "parses schema extension with an operation type definition" $
        parse document "" `shouldSucceedOn` "extend schema { query: Query }"
    it "parses schema extension with an operation type and directive" $
        let newDirective = Directive "newDirective" [] $ Location 1 15
            schemaExtension = SchemaExtension
                $ SchemaOperationExtension [newDirective]
                $ OperationTypeDefinition Query "Query" :| []
            testSchemaExtension = TypeSystemExtension schemaExtension
                $ Location 1 1
            query = "extend schema @newDirective { query: Query }"
         in parse document "" query `shouldParse` (testSchemaExtension :| [])
    it "parses a repeatable directive definition" $
        let given = "directive @test repeatable on FIELD_DEFINITION"
            isRepeatable (TypeSystemDefinition definition' _ :| [])
                | DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
            isRepeatable _ = False
         in parse document "" given `parseSatisfies` isRepeatable
    it "parses an object extension" $
        parse document "" `shouldSucceedOn`
            "extend type Story { isHiddenLocally: Boolean }"
    it "rejects variables in DefaultValue" $
        parse document "" `shouldFailOn`
            "query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
            \  title\n\
            \}"
    it "rejects empty selection set" $
       parse document "" `shouldFailOn` "query { innerField {} }"
    it "parses documents beginning with a comment" $
        parse document "" `shouldSucceedOn`
            "\"\"\"\n\
            \Query\n\
            \\"\"\"\n\
            \type Query {\n\
            \  queryField: String\n\
            \}"
    it "parses subscriptions" $
        parse document "" `shouldSucceedOn`
            "subscription NewMessages {\n\
            \  newMessage(roomId: 123) {\n\
            \    sender\n\
            \  }\n\
            \}"
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@ -1,24 +1,36 @@
 {- 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.ErrorSpec
    ( spec
    ) where
-import qualified Data.Aeson as Aeson
+import Data.List.NonEmpty (NonEmpty (..))
 import Language.GraphQL.Error
-import Test.Hspec ( Spec
+import qualified Language.GraphQL.Type as Type
-                  , describe
+import Test.Hspec
-                  , it
+    ( Spec
-                  , shouldBe
+    , describe
-                  )
+    , it
    , shouldBe
    )
 import Text.Megaparsec (PosState(..))
 import Text.Megaparsec.Error (ParseError(..), ParseErrorBundle(..))
 import Text.Megaparsec.Pos (SourcePos(..), mkPos)
 spec :: Spec
-spec = describe "singleError" $
+spec = describe "parseError" $
-    it "constructs an error with the given message" $
+    it "generates response with a single error" $ do
-        let expected = Aeson.object
+        let parseErrors = TrivialError 0 Nothing mempty :| []
-                [
+            posState = PosState
-                    ("errors", Aeson.toJSON
+                { pstateInput = ""
-                        [ Aeson.object [("message", "Message.")]
+                , pstateOffset = 0
-                        ]
+                , pstateSourcePos = SourcePos "" (mkPos 1) (mkPos 1)
-                    )
+                , pstateTabWidth = mkPos 1
-                ]
+                , pstateLinePrefix = ""
-         in singleError "Message." `shouldBe` expected
+                }
        Response Type.Null actual <-
            parseError (ParseErrorBundle parseErrors posState)
        length actual `shouldBe` 1
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@ -0,0 +1,52 @@
 {- 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.Execute.CoerceSpec
    ( spec
    ) where
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (isNothing)
 import qualified Language.GraphQL.Execute.Coerce as Coerce
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import Prelude hiding (id)
 import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
 direction :: EnumType
 direction = EnumType "Direction" Nothing  $ HashMap.fromList
    [ ("NORTH", EnumValue Nothing)
    , ("EAST", EnumValue Nothing)
    , ("SOUTH", EnumValue Nothing)
    , ("WEST", EnumValue Nothing)
    ]
 namedIdType :: In.Type
 namedIdType = In.NamedScalarType id
 spec :: Spec
 spec =
    describe "coerceInputLiteral" $ do
        it "coerces enums" $
            let expected = Just (Enum "NORTH")
                actual = Coerce.coerceInputLiteral
                    (In.NamedEnumType direction) (Enum "NORTH")
             in actual `shouldBe` expected
        it "fails with non-existing enum value" $
            let actual = Coerce.coerceInputLiteral
                    (In.NamedEnumType direction) (Enum "NORTH_EAST")
             in actual `shouldSatisfy` isNothing
        it "coerces integers to IDs" $
            let expected = Just (String "1234")
                actual = Coerce.coerceInputLiteral namedIdType (Int 1234)
             in actual `shouldBe` expected
        it "coerces nulls" $ do
            let actual = Coerce.coerceInputLiteral namedIdType Null
             in actual `shouldBe` Just Null
        it "wraps singleton lists" $ do
            let expected = Just $ List [List [String "1"]]
                embeddedType = In.ListType $ In.ListType namedIdType
                actual = Coerce.coerceInputLiteral embeddedType (String "1")
             in actual `shouldBe` expected
--- a/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
+++ b/tests/Language/GraphQL/Execute/OrderedMapSpec.hs
@ -0,0 +1,72 @@
 {- 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.Execute.OrderedMapSpec
    ( spec
    ) where
 import Language.GraphQL.Execute.OrderedMap (OrderedMap)
 import qualified Language.GraphQL.Execute.OrderedMap as OrderedMap
 import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
 spec :: Spec
 spec =
    describe "OrderedMap" $ do
        it "creates an empty map" $
            (mempty :: OrderedMap String) `shouldSatisfy` null
        it "creates a singleton" $
            let value :: String
                value = "value"
             in OrderedMap.size (OrderedMap.singleton "key" value) `shouldBe` 1
        it "combines inserted vales" $
            let key = "key"
                map1 = OrderedMap.singleton key ("1" :: String)
                map2 = OrderedMap.singleton key ("2" :: String)
             in OrderedMap.lookup key (map1 <> map2) `shouldBe` Just "12"
        it "shows the map" $
            let actual = show
                    $ OrderedMap.insert "key1" "1"
                    $ OrderedMap.singleton "key2" ("2" :: String)
                expected = "fromList [(\"key2\",\"2\"),(\"key1\",\"1\")]"
             in actual `shouldBe` expected
        it "traverses a map of just values" $
            let actual = sequence
                    $ OrderedMap.insert "key1" (Just "2")
                    $ OrderedMap.singleton "key2" $ Just ("1" :: String)
                expected = Just
                    $ OrderedMap.insert "key1" "2"
                    $ OrderedMap.singleton "key2" ("1" :: String)
             in actual `shouldBe` expected
        it "traverses a map with a Nothing" $
            let actual = sequence
                    $ OrderedMap.insert "key1" Nothing
                    $ OrderedMap.singleton "key2" $ Just ("1" :: String)
                expected = Nothing
             in actual `shouldBe` expected
        it "combines two maps preserving the order of the second one" $
            let map1 :: OrderedMap String
                map1 = OrderedMap.insert "key2" "2"
                    $ OrderedMap.singleton "key1" "1"
                map2 :: OrderedMap String
                map2 = OrderedMap.insert "key4" "4"
                    $ OrderedMap.singleton "key3" "3"
                expected = OrderedMap.insert "key4" "4"
                    $ OrderedMap.insert "key3" "3"
                    $ OrderedMap.insert "key2" "2"
                    $ OrderedMap.singleton "key1" "1"
             in (map1 <> map2) `shouldBe` expected
        it "replaces existing values" $
            let key = "key"
                actual = OrderedMap.replace key ("2" :: String)
                        $ OrderedMap.singleton key ("1" :: String)
             in OrderedMap.lookup key actual `shouldBe` Just "2"
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@ -0,0 +1,470 @@
 {- 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 DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.ExecuteSpec
    ( spec
    ) where
 import Control.Exception (Exception(..))
 import Control.Monad.Catch (throwM)
 import Data.Conduit
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Typeable (cast)
 import Language.GraphQL.AST (Document, Location(..), Name)
 import Language.GraphQL.AST.Parser (document)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute (execute)
 import qualified Language.GraphQL.Type.Schema as Schema
 import qualified Language.GraphQL.Type as Type
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Prelude hiding (id)
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.Megaparsec (parse, errorBundlePretty)
 import Schemas.HeroSchema (heroSchema)
 import Data.Maybe (fromJust)
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Test.Hspec.Expectations
    ( Expectation
    , expectationFailure
    )
 import Data.Either (fromRight)
 data PhilosopherException = PhilosopherException
    deriving Show
 instance Exception PhilosopherException where
    toException = toException. ResolverException
    fromException e = do
        ResolverException resolverException <- fromException e
        cast resolverException
 philosopherSchema :: Schema IO
 philosopherSchema =
    schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty
  where
    subscriptionRoot = Just subscriptionType
    extraTypes =
        [ Schema.ObjectType bookType
        , Schema.ObjectType bookCollectionType
        ]
 queryType :: Out.ObjectType IO
 queryType = Out.ObjectType "Query" Nothing []
    $ HashMap.fromList
    [ ("philosopher", ValueResolver philosopherField philosopherResolver)
    , ("throwing", ValueResolver throwingField throwingResolver)
    , ("count", ValueResolver countField countResolver)
    , ("sequence", ValueResolver sequenceField sequenceResolver)
    , ("withInputObject", ValueResolver withInputObjectField withInputObjectResolver)
    ]
  where
    philosopherField =
        Out.Field Nothing (Out.NamedObjectType philosopherType)
        $ HashMap.singleton "id"
        $ In.Argument Nothing (In.NamedScalarType id) Nothing
    philosopherResolver = pure $ Object mempty
    throwingField =
        let fieldType = Out.ListType $ Out.NonNullScalarType string
         in Out.Field Nothing fieldType HashMap.empty
    throwingResolver :: Resolve IO
    throwingResolver = throwM PhilosopherException
    countField =
        let fieldType = Out.NonNullScalarType int
         in Out.Field Nothing fieldType HashMap.empty
    countResolver = pure ""
    sequenceField =
        let fieldType = Out.ListType $ Out.NonNullScalarType int
         in Out.Field Nothing fieldType HashMap.empty
    sequenceResolver = pure intSequence
    withInputObjectResolver = pure $ Type.Int 0
    withInputObjectField =
        Out.Field Nothing (Out.NonNullScalarType int) $ HashMap.fromList
            [("values", In.Argument Nothing withInputObjectArgumentType Nothing)]
    withInputObjectArgumentType = In.NonNullListType
        $ In.NonNullInputObjectType inputObjectType
 inputObjectType :: In.InputObjectType
 inputObjectType = In.InputObjectType "InputObject" Nothing $
    HashMap.singleton "name" $
        In.InputField Nothing (In.NonNullScalarType int) Nothing
 intSequence :: Value
 intSequence = Type.List [Type.Int 1, Type.Int 2, Type.Int 3]
 musicType :: Out.ObjectType IO
 musicType = Out.ObjectType "Music" Nothing []
    $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("instrument", ValueResolver instrumentField instrumentResolver)
        ]
    instrumentResolver = pure $ String "piano"
    instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 poetryType :: Out.ObjectType IO
 poetryType = Out.ObjectType "Poetry" Nothing []
    $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("genre", ValueResolver genreField genreResolver)
        ]
    genreResolver = pure $ String "Futurism"
    genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 interestType :: Out.UnionType IO
 interestType = Out.UnionType "Interest" Nothing [musicType, poetryType]
 philosopherType :: Out.ObjectType IO
 philosopherType = Out.ObjectType "Philosopher" Nothing []
    $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("firstName", ValueResolver firstNameField firstNameResolver)
        , ("lastName", ValueResolver lastNameField lastNameResolver)
        , ("school", ValueResolver schoolField schoolResolver)
        , ("interest", ValueResolver interestField interestResolver)
        , ("majorWork", ValueResolver majorWorkField majorWorkResolver)
        , ("century", ValueResolver centuryField centuryResolver)
        , ("firstLanguage", ValueResolver firstLanguageField firstLanguageResolver)
        ]
    firstNameField =
        Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
    firstNameResolver = pure $ String "Friedrich"
    lastNameField
        = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
    lastNameResolver = pure $ String "Nietzsche"
    schoolField
       = Out.Field Nothing (Out.NonNullEnumType schoolType) HashMap.empty
    schoolResolver = pure $ Enum "EXISTENTIALISM"
    interestField
        = Out.Field Nothing (Out.NonNullUnionType interestType) HashMap.empty
    interestResolver = pure
        $ Object
        $ HashMap.fromList [("instrument", "piano")]
    majorWorkField
        = Out.Field Nothing (Out.NonNullInterfaceType workType) HashMap.empty
    majorWorkResolver = pure
        $ Object
        $ HashMap.fromList
            [ ("title", "Also sprach Zarathustra: Ein Buch für Alle und Keinen")
            ]
    centuryField =
        Out.Field Nothing (Out.NonNullScalarType int) HashMap.empty
    centuryResolver = pure $ Float 18.5
    firstLanguageField
        = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
    firstLanguageResolver = pure Null
 workType :: Out.InterfaceType IO
 workType = Out.InterfaceType "Work" Nothing []
    $ HashMap.fromList fields
  where
    fields = [("title", titleField)]
    titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 bookType :: Out.ObjectType IO
 bookType = Out.ObjectType "Book" Nothing [workType]
    $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("title", ValueResolver titleField titleResolver)
        ]
    titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
    titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen"
 bookCollectionType :: Out.ObjectType IO
 bookCollectionType = Out.ObjectType "Book" Nothing [workType]
    $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("title", ValueResolver titleField titleResolver)
        ]
    titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
    titleResolver = pure "The Three Critiques"
 subscriptionType :: Out.ObjectType IO
 subscriptionType = Out.ObjectType "Subscription" Nothing []
    $ HashMap.singleton "newQuote"
    $ EventStreamResolver quoteField (pure $ Object mempty)
    $ pure $ yield $ Object mempty
  where
    quoteField =
        Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
 quoteType :: Out.ObjectType IO
 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
 schoolType :: Type.EnumType
 schoolType = EnumType "School" Nothing $ HashMap.fromList
    [ ("NOMINALISM", EnumValue Nothing)
    , ("REALISM", EnumValue Nothing)
    , ("IDEALISM", EnumValue Nothing)
    ]
 type EitherStreamOrValue = Either
    (ResponseEventStream IO Type.Value)
    (Response Type.Value)
 -- Asserts that a query resolves to a value.
 shouldResolveTo :: Text.Text -> Response Type.Value -> Expectation
 shouldResolveTo querySource expected =
    case parse document "" querySource of
        (Right parsedDocument) ->
            execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) parsedDocument >>= go
        (Left errorBundle) -> expectationFailure $ errorBundlePretty errorBundle
  where
    go = \case
        Right result -> shouldBe result expected
        Left _ -> expectationFailure
            "the query is expected to resolve to a value, but it resolved to an event stream"
 -- Asserts that the executor produces an error that starts with a string.
 shouldContainError :: Either (ResponseEventStream IO Type.Value) (Response Type.Value)
    -> Text
    -> Expectation
 shouldContainError streamOrValue expected =
    case streamOrValue of
        Right response -> respond response
        Left _ -> expectationFailure
            "the query is expected to resolve to a value, but it resolved to an event stream"
  where
    startsWith :: Text.Text -> Text.Text -> Bool
    startsWith xs ys = Text.take (Text.length ys) xs == ys
    respond :: Response Type.Value -> Expectation
    respond Response{ errors }
        | any ((`startsWith` expected) . message) errors = pure ()
        | otherwise = expectationFailure
            "the query is expected to execute with errors, but the response doesn't contain any errors"
 parseAndExecute :: Schema IO
    -> Maybe Text
    -> HashMap Name Type.Value
    -> Text
    -> IO (Either (ResponseEventStream IO Type.Value) (Response Type.Value))
 parseAndExecute schema' operation variables
    = either (pure . parseError) (execute schema' operation variables)
    . parse document ""
 spec :: Spec
 spec =
    describe "execute" $ do
        it "rejects recursive fragments" $
            let sourceQuery = "\
              \{\n\
              \  ...cyclicFragment\n\
              \}\n\
              \\n\
              \fragment cyclicFragment on Query {\n\
              \  ...cyclicFragment\n\
              \}\
              \"
                expected = Response (Object mempty) mempty
             in sourceQuery `shouldResolveTo` expected
        context "Query" $ do
            it "skips unknown fields" $
                let data'' = Object
                        $ HashMap.singleton "philosopher"
                        $ Object
                        $ HashMap.singleton "firstName"
                        $ String "Friedrich"
                    expected = Response data'' mempty
                    sourceQuery = "{ philosopher { firstName surname } }"
                in sourceQuery `shouldResolveTo` expected
            it "merges selections" $
                let data'' = Object
                        $ HashMap.singleton "philosopher"
                        $ Object
                        $ HashMap.fromList
                            [ ("firstName", String "Friedrich")
                            , ("lastName", String "Nietzsche")
                            ]
                    expected = Response data'' mempty
                    sourceQuery = "{ philosopher { firstName } philosopher { lastName } }"
                in sourceQuery `shouldResolveTo` expected
            it "errors on invalid output enum values" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message =
                            "Value completion error. Expected type School!, found: EXISTENTIALISM."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "school"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher { school } }"
                 in sourceQuery `shouldResolveTo` expected
            it "gives location information for non-null unions" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message =
                            "Value completion error. Expected type Interest!, found: { instrument: \"piano\" }."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "interest"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher { interest } }"
                 in sourceQuery `shouldResolveTo` expected
            it "gives location information for invalid interfaces" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message
                            = "Value completion error. Expected type Work!, found:\
                            \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "majorWork"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher { majorWork { title } } }"
                 in sourceQuery `shouldResolveTo` expected
            it "gives location information for failed result coercion" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message = "Unable to coerce result to Int!."
                        , locations = [Location 1 26]
                        , path = [Segment "philosopher", Segment "century"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher(id: \"1\") { century } }"
                in sourceQuery `shouldResolveTo` expected
            it "gives location information for failed result coercion" $
                let data'' = Object $ HashMap.singleton "throwing" Null
                    executionErrors = pure $ Error
                        { message = "PhilosopherException"
                        , locations = [Location 1 3]
                        , path = [Segment "throwing"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ throwing }"
                in sourceQuery `shouldResolveTo` expected
            it "sets data to null if a root field isn't nullable" $
                let executionErrors = pure $ Error
                        { message = "Unable to coerce result to Int!."
                        , locations = [Location 1 3]
                        , path = [Segment "count"]
                        }
                    expected = Response Null executionErrors
                    sourceQuery = "{ count }"
                in sourceQuery `shouldResolveTo` expected
            it "detects nullability errors" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message = "Value completion error. Expected type String!, found: null."
                        , locations = [Location 1 26]
                        , path = [Segment "philosopher", Segment "firstLanguage"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }"
                in sourceQuery `shouldResolveTo` expected
            it "returns list elements in the original order" $
                let data'' = Object $ HashMap.singleton "sequence" intSequence
                    expected = Response data'' mempty
                    sourceQuery = "{ sequence }"
                in sourceQuery `shouldResolveTo` expected
            context "Arguments" $ do
                it "gives location information for invalid scalar arguments" $
                    let data'' = Object $ HashMap.singleton "philosopher" Null
                        executionErrors = pure $ Error
                            { message =
                                "Argument \"id\" has invalid type. Expected type ID, found: True."
                            , locations = [Location 1 15]
                            , path = [Segment "philosopher"]
                            }
                        expected = Response data'' executionErrors
                        sourceQuery = "{ philosopher(id: true) { lastName } }"
                    in sourceQuery `shouldResolveTo` expected
                it "puts an object in a list if needed" $
                    let data'' = Object $ HashMap.singleton "withInputObject" $ Type.Int 0
                        expected = Response data'' mempty
                        sourceQuery = "{ withInputObject(values: { name: 0 }) }"
                    in sourceQuery `shouldResolveTo` expected
            context "queryError" $ do
                let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
                    twoQueries = namedQuery "A" <> " " <> namedQuery "B"
                it "throws operation name is required error" $ do
                    let expectedErrorMessage = "Operation name is required"
                    actual <- parseAndExecute philosopherSchema Nothing mempty twoQueries
                    actual `shouldContainError` expectedErrorMessage
                it "throws operation not found error" $ do
                    let expectedErrorMessage = "Operation \"C\" is not found"
                    actual <- parseAndExecute philosopherSchema (Just "C") mempty twoQueries
                    actual `shouldContainError` expectedErrorMessage
                it "throws variable coercion error" $ do
                    let data'' = Null
                        executionErrors = pure $ Error
                            { message = "Failed to coerce the variable $id: String."
                            , locations =[Location 1 7]
                            , path = []
                            }
                        expected = Response data'' executionErrors
                        executeWithVars = execute philosopherSchema Nothing (HashMap.singleton "id" (Type.Int 1))
                    Right actual <- either (pure . parseError) executeWithVars
                        $ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }"
                    actual `shouldBe` expected
                it "throws variable unkown input type error" $
                    let data'' = Null
                        executionErrors = pure $ Error
                            { message = "Variable $id has unknown type Cat."
                            , locations =[Location 1 7]
                            , path = []
                            }
                        expected = Response data'' executionErrors
                        sourceQuery = "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"
                     in sourceQuery `shouldResolveTo` expected
            context "Error path" $ do
                let executeHero :: Document -> IO EitherStreamOrValue
                    executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Type.Value)
                it "at the beggining of the list" $ do
                    Right actual <- either (pure . parseError) executeHero
                        $ parse document "" "{ hero(id: \"1\") { friends { name } } }"
                    let Response _ errors' = actual
                        Error _ _ path' = fromJust $ Seq.lookup 0 errors'
                        expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]
                     in path' `shouldBe` expected
        context "Subscription" $
            it "subscribes" $ do
                let data'' = Object
                        $ HashMap.singleton "newQuote"
                        $ Object
                        $ HashMap.singleton "quote"
                        $ String "Naturam expelles furca, tamen usque recurret."
                    expected = Response data'' mempty
                Left stream <- execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)
                    $ fromRight (error "Parse error")
                    $ parse document "" "subscription { newQuote { quote } }"
                Just actual <- runConduit $ stream .| await
                actual `shouldBe` expected
--- a/tests/Language/GraphQL/Type/OutSpec.hs
+++ b/tests/Language/GraphQL/Type/OutSpec.hs
@ -0,0 +1,18 @@
 {- 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.Type.OutSpec
    ( spec
    ) where
 import Language.GraphQL.Type
 import Test.Hspec (Spec, describe, it, shouldBe)
 spec :: Spec
 spec =
    describe "Value" $
        it "supports overloaded strings" $
            let nietzsche = "Goldstaub abblasen." :: Value
             in nietzsche `shouldBe` String "Goldstaub abblasen."
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/tests/Language/GraphQL/Validate/RulesSpec.hs
@ -0,0 +1,938 @@
 {- 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.Validate.RulesSpec
    ( spec
    ) where
 import Data.Foldable (toList)
 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.Schema as Schema
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Validate
 import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain, xit)
 import Text.Megaparsec (parse, errorBundlePretty)
 petSchema :: Schema IO
 petSchema = schema queryType Nothing (Just subscriptionType)
    $ HashMap.singleton "repeat"
    $ Schema.Directive Nothing mempty True [DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field]
 queryType :: ObjectType IO
 queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
    [ ("dog", dogResolver)
    , ("cat", catResolver)
    , ("findDog", findDogResolver)
    , ("findCats", findCatsResolver)
    ]
  where
    dogField = Field Nothing (Out.NamedObjectType dogType) mempty
    dogResolver = ValueResolver dogField $ pure Null
    findDogArguments = HashMap.singleton "complex"
        $ In.Argument Nothing (In.NonNullInputObjectType dogDataType) Nothing
    findDogField = Field Nothing (Out.NamedObjectType dogType) findDogArguments
    findDogResolver = ValueResolver findDogField $ pure Null
    catField = Field Nothing (Out.NamedObjectType catType) mempty
    catResolver = ValueResolver catField $ pure Null
    findCatsArguments = HashMap.singleton "commands"
        $ In.Argument Nothing (In.NonNullListType $ In.NonNullEnumType catCommandType)
        $ Just $ List []
    findCatsField = Field Nothing (Out.NonNullListType $ Out.NonNullObjectType catType) findCatsArguments
    findCatsResolver = ValueResolver findCatsField $ 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)
    , ("doesKnowCommands", doesKnowCommandsResolver)
    , ("meowVolume", meowVolumeResolver)
    ]
  where
    meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty
    meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 3
    doesKnowCommandsType = In.NonNullListType
        $ In.NonNullEnumType catCommandType
    doesKnowCommandsField = Field Nothing (Out.NonNullScalarType boolean)
        $ HashMap.singleton "catCommands"
        $ In.Argument Nothing doesKnowCommandsType Nothing
    doesKnowCommandsResolver = ValueResolver doesKnowCommandsField
        $ pure $ Boolean True
 nameResolver :: Resolver IO
 nameResolver = ValueResolver nameField $ pure "Name"
  where
    nameField = Field Nothing (Out.NonNullScalarType string) mempty
 nicknameResolver :: Resolver IO
 nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
  where
    nicknameField = Field Nothing (Out.NamedScalarType string) mempty
 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
    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
 dogDataType :: InputObjectType
 dogDataType = InputObjectType "DogData" Nothing
    $ HashMap.singleton "name" nameInputField
  where
    nameInputField = InputField Nothing (In.NonNullScalarType string) Nothing
 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
 subscriptionType :: ObjectType IO
 subscriptionType = ObjectType "Subscription" Nothing [] $ HashMap.fromList
    [ ("newMessage", newMessageResolver)
    , ("disallowedSecondRootField", newMessageResolver)
    ]
  where
    newMessageField = Field Nothing (Out.NonNullObjectType messageType) mempty
    newMessageResolver = ValueResolver newMessageField
        $ pure $ Object HashMap.empty
 messageType :: ObjectType IO
 messageType = ObjectType "Message" Nothing [] $ HashMap.fromList
    [ ("sender", senderResolver)
    , ("body", bodyResolver)
    ]
  where
    senderField = Field Nothing (Out.NonNullScalarType string) mempty
    senderResolver = ValueResolver senderField $ pure "Sender"
    bodyField = Field Nothing (Out.NonNullScalarType string) mempty
    bodyResolver = ValueResolver bodyField $ pure "Message body."
 humanType :: ObjectType IO
 humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("pets", petsResolver)
    ]
  where
    petsField =
        Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty
    petsResolver = ValueResolver petsField $ pure $ List []
 validate :: Text -> [Error]
 validate queryString =
    case parse AST.document "" queryString of
        Left parseErrors -> error $ errorBundlePretty parseErrors
        Right ast -> toList $ document petSchema specifiedRules ast
 spec :: Spec
 spec =
    describe "document" $ do
        context "executableDefinitionsRule" $
            it "rejects type definitions" $
                let queryString = "query getDogName {\n\
                        \  dog {\n\
                        \    name\n\
                        \    color\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \extend type Dog {\n\
                        \  color: String\n\
                        \}"
                    expected = Error
                        { message =
                            "Definition must be OperationDefinition or \
                            \FragmentDefinition."
                        , locations = [AST.Location 8 1]
                        }
                 in validate queryString `shouldContain` [expected]
        context "singleFieldSubscriptionsRule" $ do
            it "rejects multiple subscription root fields" $
                let queryString = "subscription sub {\n\
                        \  newMessage {\n\
                        \    body\n\
                        \    sender\n\
                        \  }\n\
                        \  disallowedSecondRootField\n\
                        \}"
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldContain` [expected]
            xit "rejects an introspection field as the subscription root" $
                let queryString = "subscription sub {\n\
                        \  __typename\n\
                        \}"
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldContain` [expected]
            it "rejects multiple subscription root fields coming from a fragment" $
                let queryString = "subscription sub {\n\
                        \  ...multipleSubscriptions\n\
                        \}\n\
                        \\n\
                        \fragment multipleSubscriptions on Subscription {\n\
                        \  newMessage {\n\
                        \    body\n\
                        \    sender\n\
                        \  }\n\
                        \  disallowedSecondRootField\n\
                        \}"
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldContain` [expected]
            it "finds corresponding subscription fragment" $
                let queryString = "subscription sub {\n\
                        \  ...anotherSubscription\n\
                        \  ...multipleSubscriptions\n\
                        \}\n\
                        \fragment multipleSubscriptions on Subscription {\n\
                        \  newMessage {\n\
                        \    body\n\
                        \  }\n\
                        \  disallowedSecondRootField {\n\
                        \    sender\n\
                        \  }\n\
                        \}\n\
                        \fragment anotherSubscription on Subscription {\n\
                        \  newMessage {\n\
                        \    body\n\
                        \    sender\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldBe` [expected]
        context "loneAnonymousOperationRule" $
            it "rejects multiple anonymous operations" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    name\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \query getName {\n\
                        \  dog {\n\
                        \    owner {\n\
                        \      name\n\
                        \    }\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "This anonymous operation must be the only defined \
                            \operation."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueOperationNamesRule" $
            it "rejects operations with the same name" $
                let queryString = "query dogOperation {\n\
                        \  dog {\n\
                        \    name\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \mutation dogOperation {\n\
                        \  mutateDog {\n\
                        \    id\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one operation named \
                            \\"dogOperation\"."
                        , locations = [AST.Location 1 1, AST.Location 7 1]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueFragmentNamesRule" $
            it "rejects fragments with the same name" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ...fragmentOne\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \fragment fragmentOne on Dog {\n\
                        \  name\n\
                        \}\n\
                        \\n\
                        \fragment fragmentOne on Dog {\n\
                        \  owner {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one fragment named \
                            \\"fragmentOne\"."
                        , locations = [AST.Location 7 1, AST.Location 11 1]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentSpreadTargetDefinedRule" $
            it "rejects the fragment spread without a target" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ...undefinedFragment\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment target \"undefinedFragment\" is \
                            \undefined."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentSpreadTypeExistenceRule" $ do
            it "rejects fragment spreads without an unknown target type" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ...notOnExistingType\n\
                        \  }\n\
                        \}\n\
                        \fragment notOnExistingType on NotInSchema {\n\
                        \  name\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment \"notOnExistingType\" is specified on \
                            \type \"NotInSchema\" which doesn't exist in the \
                            \schema."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects inline fragments without a target" $
                let queryString = "{\n\
                        \  ... on NotInSchema {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Inline fragment is specified on type \
                            \\"NotInSchema\" which doesn't exist in the schema."
                        , locations = [AST.Location 2 3]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentsOnCompositeTypesRule" $ do
            it "rejects fragments on scalar types" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ...fragOnScalar\n\
                        \  }\n\
                        \}\n\
                        \fragment fragOnScalar on Int {\n\
                        \  name\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment cannot condition on non composite type \
                            \\"Int\"."
                        , locations = [AST.Location 6 1]
                        }
                 in validate queryString `shouldContain` [expected]
            it "rejects inline fragments on scalar types" $
                let queryString = "{\n\
                        \  ... on Boolean {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment cannot condition on non composite type \
                            \\"Boolean\"."
                        , locations = [AST.Location 2 3]
                        }
                in validate queryString `shouldContain` [expected]
        context "noUnusedFragmentsRule" $
            it "rejects unused fragments" $
                let queryString = "fragment nameFragment on Dog { # unused\n\
                        \  name\n\
                        \}\n\
                        \\n\
                        \{\n\
                        \  dog {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment \"nameFragment\" is never used."
                        , locations = [AST.Location 1 1]
                        }
                 in validate queryString `shouldBe` [expected]
        context "noFragmentCyclesRule" $
            it "rejects spreads that form cycles" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ...nameFragment\n\
                        \  }\n\
                        \}\n\
                        \fragment nameFragment on Dog {\n\
                        \  name\n\
                        \  ...barkVolumeFragment\n\
                        \}\n\
                        \fragment barkVolumeFragment on Dog {\n\
                        \  barkVolume\n\
                        \  ...nameFragment\n\
                        \}"
                    error1 = Error
                        { message =
                            "Cannot spread fragment \"barkVolumeFragment\" \
                            \within itself (via barkVolumeFragment -> \
                            \nameFragment -> barkVolumeFragment)."
                        , locations = [AST.Location 10 1]
                        }
                    error2 = Error
                        { message =
                            "Cannot spread fragment \"nameFragment\" within \
                            \itself (via nameFragment -> barkVolumeFragment -> \
                            \nameFragment)."
                        , locations = [AST.Location 6 1]
                        }
                 in validate queryString `shouldBe` [error1, error2]
        context "uniqueArgumentNamesRule" $
            it "rejects duplicate field arguments" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: true, atOtherHomes: true)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one argument named \
                            \\"atOtherHomes\"."
                        , locations = [AST.Location 3 20, AST.Location 3 40]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueDirectiveNamesRule" $ do
            it "rejects more than one directive per location" $
                let queryString = "query ($foo: Boolean = true, $bar: Boolean = false) {\n\
                        \  dog @skip(if: $foo) @skip(if: $bar) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one directive named \"skip\"."
                        , locations = [AST.Location 2 7, AST.Location 2 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "allows repeating repeatable directives" $
                let queryString = "query {\n\
                        \  dog @repeat @repeat {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                 in validate queryString `shouldBe` []
        context "uniqueVariableNamesRule" $
            it "rejects duplicate variables" $
                let queryString = "query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: $atOtherHomes)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one variable named \
                            \\"atOtherHomes\"."
                        , locations = [AST.Location 1 25, AST.Location 1 49]
                        }
                 in validate queryString `shouldBe` [expected]
        context "variablesAreInputTypesRule" $
            it "rejects non-input types as variables" $
                let queryString = "query takesDogBang($dog: Dog!) {\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: $dog)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Variable \"$dog\" cannot be non-input type \
                            \\"Dog\"."
                        , locations = [AST.Location 1 20]
                        }
                 in validate queryString `shouldContain` [expected]
        context "noUndefinedVariablesRule" $ do
            it "rejects undefined variables" $
                let queryString = "query variableIsNotDefinedUsedInSingleFragment {\n\
                        \  dog {\n\
                        \    ...isHouseTrainedFragment\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \fragment isHouseTrainedFragment on Dog {\n\
                        \  isHouseTrained(atOtherHomes: $atOtherHomes)\n\
                        \}"
                    expected = Error
                        { message =
                            "Variable \"$atOtherHomes\" is not defined by \
                            \operation \
                            \\"variableIsNotDefinedUsedInSingleFragment\"."
                        , locations = [AST.Location 8 32]
                        }
                 in validate queryString `shouldBe` [expected]
            it "gets variable location inside an input object" $
                let queryString = "query {\n\
                        \  findDog (complex: { name: $name }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message = "Variable \"$name\" is not defined."
                        , locations = [AST.Location 2 29]
                        }
                 in validate queryString `shouldBe` [expected]
            it "gets variable location inside an array" $
                let queryString = "query {\n\
                        \  findCats (commands: [JUMP, $command]) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message = "Variable \"$command\" is not defined."
                        , locations = [AST.Location 2 30]
                        }
                 in validate queryString `shouldBe` [expected]
        context "noUnusedVariablesRule" $ do
            it "rejects unused variables" $
                let queryString = "query variableUnused($atOtherHomes: Boolean) {\n\
                        \  dog {\n\
                        \    isHouseTrained\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Variable \"$atOtherHomes\" is never used in \
                            \operation \"variableUnused\"."
                        , locations = [AST.Location 1 22]
                        }
                 in validate queryString `shouldBe` [expected]
            it "detects variables in properties of input objects" $
                let queryString = "query withVar ($name: String!) {\n\
                        \  findDog (complex: { name: $name }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                 in validate queryString `shouldBe` []
        context "uniqueInputFieldNamesRule" $
            it "rejects duplicate fields in input objects" $
                let queryString = "{\n\
                        \  findDog(complex: { name: \"Fido\", name: \"Jack\" }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "There can be only one input field named \"name\"."
                        , locations = [AST.Location 2 22, AST.Location 2 36]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fieldsOnCorrectTypeRule" $
            it "rejects undefined fields" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    meowVolume\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Cannot query field \"meowVolume\" on type \"Dog\"."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "scalarLeafsRule" $
            it "rejects scalar fields with not empty selection set" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    barkVolume {\n\
                        \      sinceWhen\n\
                        \    }\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Field \"barkVolume\" must not have a selection \
                            \since type \"Int\" has no subfields."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownArgumentNamesRule" $ do
            it "rejects field arguments missing in the type" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Unknown argument \"command\" on field \
                            \\"Dog.doesKnowCommand\"."
                        , locations = [AST.Location 3 21]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects directive arguments missing in the definition" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: true) @include(unless: false, if: true)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Unknown argument \"unless\" on directive \
                            \\"@include\"."
                        , locations = [AST.Location 3 49]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownDirectiveNamesRule" $
            it "rejects undefined directives" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: true) @ignore(if: true)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message = "Unknown directive \"@ignore\"."
                        , locations = [AST.Location 3 40]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownInputFieldNamesRule" $
            it "rejects undefined input object fields" $
                let queryString = "{\n\
                        \  findDog(complex: { favoriteCookieFlavor: \"Bacon\", name: \"Jack\" }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Field \"favoriteCookieFlavor\" is not defined \
                            \by type \"DogData\"."
                        , locations = [AST.Location 2 22]
                        }
                 in validate queryString `shouldBe` [expected]
        context "directivesInValidLocationsRule" $
            it "rejects directives in invalid locations" $
                let queryString = "query @skip(if: $foo) {\n\
                        \  dog {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Directive \"@skip\" may not be used on QUERY."
                        , locations = [AST.Location 1 7]
                        }
                 in validate queryString `shouldBe` [expected]
        context "overlappingFieldsCanBeMergedRule" $ do
            it "fails to merge fields of mismatching types" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    name: nickname\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fields \"name\" conflict because \"nickname\" and \
                            \\"name\" are different fields. Use different \
                            \aliases on the fields to fetch both if this was \
                            \intentional."
                        , locations = [AST.Location 3 5, AST.Location 4 5]
                        }
                 in validate queryString `shouldBe` [expected]
            it "fails if the arguments of the same field don't match" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    doesKnowCommand(dogCommand: SIT)\n\
                        \    doesKnowCommand(dogCommand: HEEL)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fields \"doesKnowCommand\" conflict because they \
                            \have different arguments. Use different aliases \
                            \on the fields to fetch both if this was \
                            \intentional."
                        , locations = [AST.Location 3 5, AST.Location 4 5]
                        }
                 in validate queryString `shouldBe` [expected]
            it "fails to merge same-named field and alias" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    doesKnowCommand(dogCommand: SIT)\n\
                        \    doesKnowCommand: isHouseTrained(atOtherHomes: true)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fields \"doesKnowCommand\" conflict because \
                            \\"doesKnowCommand\" and \"isHouseTrained\" are \
                            \different fields. Use different aliases on the \
                            \fields to fetch both if this was intentional."
                        , locations = [AST.Location 3 5, AST.Location 4 5]
                        }
                 in validate queryString `shouldBe` [expected]
            it "looks for fields after a successfully merged field pair" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    name\n\
                        \    doesKnowCommand(dogCommand: SIT)\n\
                        \  }\n\
                        \  dog {\n\
                        \    name\n\
                        \    doesKnowCommand: isHouseTrained(atOtherHomes: true)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fields \"doesKnowCommand\" conflict because \
                            \\"doesKnowCommand\" and \"isHouseTrained\" are \
                            \different fields. Use different aliases on the \
                            \fields to fetch both if this was intentional."
                        , locations = [AST.Location 4 5, AST.Location 8 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "possibleFragmentSpreadsRule" $ do
            it "rejects object inline spreads outside object scope" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ... on Cat {\n\
                        \      meowVolume\n\
                        \    }\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment cannot be spread here as objects of type \
                            \\"Dog\" can never be of type \"Cat\"."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects object named spreads outside object scope" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    ... catInDogFragmentInvalid\n\
                        \  }\n\
                        \}\n\
                        \\n\
                        \fragment catInDogFragmentInvalid on Cat {\n\
                        \  meowVolume\n\
                        \}"
                    expected = Error
                        { message =
                            "Fragment \"catInDogFragmentInvalid\" cannot be \
                            \spread here as objects of type \"Dog\" can never \
                            \be of type \"Cat\"."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "providedRequiredInputFieldsRule" $
            it "rejects missing required input fields" $
                let queryString = "{\n\
                        \  findDog(complex: { name: null }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Input field \"name\" of type \"DogData\" is \
                            \required, but it was not provided."
                        , locations = [AST.Location 2 20]
                        }
                 in validate queryString `shouldBe` [expected]
        context "providedRequiredArgumentsRule" $ do
            it "checks for (non-)nullable arguments" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    doesKnowCommand(dogCommand: null)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Field \"doesKnowCommand\" argument \"dogCommand\" \
                            \of type \"DogCommand\" is required, but it was \
                            \not provided."
                        , locations = [AST.Location 3 5]
                        }
                 in validate queryString `shouldBe` [expected]
        context "variablesInAllowedPositionRule" $ do
            it "rejects wrongly typed variable arguments" $
                let queryString = "query dogCommandArgQuery($dogCommandArg: DogCommand) {\n\
                        \  dog {\n\
                        \    doesKnowCommand(dogCommand: $dogCommandArg)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Variable \"$dogCommandArg\" of type \
                            \\"DogCommand\" used in position expecting type \
                            \\"DogCommand!\"."
                        , locations = [AST.Location 1 26]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects wrongly typed variable arguments" $
                let queryString = "query intCannotGoIntoBoolean($intArg: Int) {\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: $intArg)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Variable \"$intArg\" of type \"Int\" used in \
                            \position expecting type \"Boolean\"."
                        , locations = [AST.Location 1 30]
                        }
                 in validate queryString `shouldBe` [expected]
        context "valuesOfCorrectTypeRule" $ do
            it "rejects values of incorrect types" $
                let queryString = "{\n\
                        \  dog {\n\
                        \    isHouseTrained(atOtherHomes: 3)\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Value 3 cannot be coerced to type \"Boolean\"."
                        , locations = [AST.Location 3 34]
                        }
                 in validate queryString `shouldBe` [expected]
            it "uses the location of a single list value" $
                let queryString = "{\n\
                        \  cat {\n\
                        \    doesKnowCommands(catCommands: [3])\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Value 3 cannot be coerced to type \"CatCommand!\"."
                        , locations = [AST.Location 3 36]
                        }
                 in validate queryString `shouldBe` [expected]
            it "validates input object properties once" $
                let queryString = "{\n\
                        \  findDog(complex: { name: 3 }) {\n\
                        \    name\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "Value 3 cannot be coerced to type \"String!\"."
                        , locations = [AST.Location 2 28]
                        }
                 in validate queryString `shouldBe` [expected]
            it "checks for required list members" $
                let queryString = "{\n\
                        \  cat {\n\
                        \    doesKnowCommands(catCommands: [null])\n\
                        \  }\n\
                        \}"
                    expected = Error
                        { message =
                            "List of non-null values of type \"CatCommand\" \
                            \cannot contain null values."
                        , locations = [AST.Location 3 36]
                        }
                 in validate queryString `shouldBe` [expected]
--- a/tests/Schemas/HeroSchema.hs
+++ b/tests/Schemas/HeroSchema.hs
@ -0,0 +1,70 @@
 {- 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 Schemas.HeroSchema (heroSchema) where
 import Control.Exception (Exception(..))
 import Control.Monad.Catch (throwM)
 import Language.GraphQL.Error (ResolverException (..))
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Schema (schemaWithTypes)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Typeable (cast)
 import qualified Language.GraphQL.Type.Out as Out
 data HeroException = HeroException
    deriving Show
 instance Exception HeroException where
    toException = toException. ResolverException
    fromException e = do
        ResolverException resolverException <- fromException e
        cast resolverException
 heroSchema :: Type.Schema IO
 heroSchema =
    schemaWithTypes Nothing queryType Nothing Nothing [] mempty
 type ObjectType = Out.ObjectType IO
 queryType :: ObjectType
 queryType = Out.ObjectType "Query" Nothing []
    $ HashMap.fromList
        [ ("hero", Out.ValueResolver heroField heroResolver)
        ]
  where
    heroField = Out.Field Nothing (Out.NamedObjectType heroType)
        $ HashMap.singleton "id"
        $ In.Argument Nothing (In.NamedScalarType Type.id) Nothing
    heroResolver = pure $ Type.Object mempty
 stringField :: Out.Field IO
 stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty
 heroType :: ObjectType
 heroType = Out.ObjectType "Hero" Nothing [] $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("id", Out.ValueResolver stringField (pure $ Type.String "4111"))
        , ("name", Out.ValueResolver stringField (pure $ Type.String "R2D2"))
        , ("friends", Out.ValueResolver friendsField (pure $ Type.List [luke]))
        ]
    friendsField = Out.Field Nothing (Out.ListType $ Out.NonNullObjectType lukeType) HashMap.empty
    -- This list values are ignored because of current realisation (types and resolvers are the same entity)
    -- The values from lukeType will be used
    luke = Type.Object $ HashMap.fromList
        [ ("id", "dfdfdf")
        , ("name", "dfdfdff")
        ]
 lukeType :: ObjectType
 lukeType = Out.ObjectType "Luke" Nothing [] $ HashMap.fromList resolvers
  where
    resolvers =
        [ ("id", Out.ValueResolver stringField (pure $ Type.String "1000"))
        , ("name", Out.ValueResolver stringField (throwM HeroException))
        ]
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@ -1,84 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.DirectiveSpec
    ( spec
    ) where
 import Data.Aeson (Value, object, (.=))
 import Data.List.NonEmpty (NonEmpty(..))
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.RawString.QQ (r)
 experimentalResolver :: Schema.Resolver IO
 experimentalResolver = Schema.scalar "experimentalField" $ pure (5 :: Int) 
 emptyObject :: Value
 emptyObject = object
    [ "data" .= object []
    ]
 spec :: Spec
 spec =
    describe "Directive executor" $ do
        it "should be able to @skip fields" $ do
            let query = [r|
              {
                experimentalField @skip(if: true)
              }
            |]
            actual <- graphql (experimentalResolver :| []) query
            actual `shouldBe` emptyObject
        it "should not skip fields if @skip is false" $ do
            let query = [r|
              {
                experimentalField @skip(if: false)
              }
            |]
                expected = object
                    [ "data" .= object
                        [ "experimentalField" .= (5 :: Int)
                        ]
                    ]
            actual <- graphql (experimentalResolver :| []) query
            actual `shouldBe` expected
        it "should skip fields if @include is false" $ do
            let query = [r|
              {
                experimentalField @include(if: false)
              }
            |]
            actual <- graphql (experimentalResolver :| []) query
            actual `shouldBe` emptyObject
        it "should be able to @skip a fragment spread" $ do
            let query = [r|
              {
                ...experimentalFragment @skip(if: true)
              }
              fragment experimentalFragment on ExperimentalType {
                experimentalField
              }
            |]
            actual <- graphql (experimentalResolver :| []) query
            actual `shouldBe` emptyObject
        it "should be able to @skip an inline fragment" $ do
            let query = [r|
              {
                ... on ExperimentalType @skip(if: true) {
                  experimentalField
                }
              }
            |]
            actual <- graphql (experimentalResolver :| []) query
            actual `shouldBe` emptyObject
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@ -1,191 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.FragmentSpec
    ( spec
    ) where
 import Data.Aeson (Value(..), object, (.=))
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
 import Test.Hspec ( Spec
                  , describe
                  , it
                  , shouldBe
                  , shouldSatisfy
                  , shouldNotSatisfy
                  )
 import Text.RawString.QQ (r)
 size :: Schema.Resolver IO
 size = Schema.scalar "size" $ return ("L" :: Text)
 circumference :: Schema.Resolver IO
 circumference = Schema.scalar "circumference" $ return (60 :: Int)
 garment :: Text -> Schema.Resolver IO
 garment typeName = Schema.object "garment" $ return
    [ if typeName == "Hat" then circumference else size
    , Schema.scalar "__typename" $ return typeName
    ]
 inlineQuery :: Text
 inlineQuery = [r|{
  garment {
    ... on Hat {
      circumference
    }
    ... on Shirt {
      size
    }
  }
 }|]
 hasErrors :: Value -> Bool
 hasErrors (Object object') = HashMap.member "errors" object'
 hasErrors _ = True
 spec :: Spec
 spec = do
    describe "Inline fragment executor" $ do
        it "chooses the first selection if the type matches" $ do
            actual <- graphql (garment "Hat" :| []) inlineQuery
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "chooses the last selection if the type matches" $ do
            actual <- graphql (garment "Shirt" :| []) inlineQuery
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "size" .= ("L" :: Text)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "embeds inline fragments without type" $ do
            let query = [r|{
              garment {
                circumference
                ... {
                  size
                }
              }
            }|]
                resolvers = Schema.object "garment" $ return [circumference,  size]
            actual <- graphql (resolvers :| []) query
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            , "size" .= ("L" :: Text)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "evaluates fragments on Query" $ do
            let query = [r|{
              ... {
                size
              }
            }|]
            actual <- graphql (size :| []) query
            actual `shouldNotSatisfy` hasErrors
    describe "Fragment spread executor" $ do
        it "evaluates fragment spreads" $ do
            let query = [r|
              {
                ...circumferenceFragment
              }
              fragment circumferenceFragment on Hat {
                circumference
              }
            |]
            actual <- graphql (circumference :| []) query
            let expected = object
                    [ "data" .= object
                        [ "circumference" .= (60 :: Int)
                        ]
                    ]
             in actual `shouldBe` expected
        it "evaluates nested fragments" $ do
            let query = [r|
              {
                garment {
                  ...circumferenceFragment
                }
              }
              fragment circumferenceFragment on Hat {
                ...hatFragment
              }
              fragment hatFragment on Hat {
                circumference
              }
            |]
            actual <- graphql (garment "Hat" :| []) query
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "rejects recursive fragments" $ do
            let query = [r|
              {
                ...circumferenceFragment
              }
              fragment circumferenceFragment on Hat {
                ...circumferenceFragment
              }
            |]
            actual <- graphql (circumference :| []) query
            actual `shouldSatisfy` hasErrors
        it "considers type condition" $ do
            let query = [r|
              {
                garment {
                  ...circumferenceFragment
                  ...sizeFragment
                }
              }
              fragment circumferenceFragment on Hat {
                circumference
              }
              fragment sizeFragment on Shirt {
                size
              }
            |]
                expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
            actual <- graphql (garment "Hat" :| []) query
            actual `shouldBe` expected
--- a/tests/Test/KitchenSinkSpec.hs
+++ b/tests/Test/KitchenSinkSpec.hs
@ -1,69 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.KitchenSinkSpec
    ( spec
    ) where
 import qualified Data.Text.IO as Text.IO
 import qualified Data.Text.Lazy.IO as Text.Lazy.IO
 import qualified Data.Text.Lazy as Lazy (Text)
 import qualified Language.GraphQL.AST.Encoder as Encoder
 import qualified Language.GraphQL.AST.Parser as Parser
 import Paths_graphql (getDataFileName)
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Megaparsec (parseSatisfies)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Kitchen Sink" $ do
    it "minifies the query" $ do
        dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
        minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"
        expected <- Text.Lazy.IO.readFile minFileName
        shouldNormalize Encoder.minified dataFileName expected
    it "pretty prints the query" $ do
        dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
        let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) {
  whoever123is: node(id: [123, 456]) {
    id
    ... on User @defer {
      field2 {
        id
        alias: field1(first: 10, after: $foo) @include(if: $foo) {
          id
          ...frag
        }
      }
    }
  }
 }
 mutation likeStory {
  like(story: 123) @defer {
    story {
      id
    }
  }
 }
 fragment frag on Friend {
  foo(size: $size, bar: $b, obj: {key: "value"})
 }
 {
  unnamed(truthy: true, falsey: false)
  query
 }
 |]
        shouldNormalize Encoder.pretty dataFileName expected
 shouldNormalize :: Encoder.Formatter -> FilePath -> Lazy.Text -> IO ()
 shouldNormalize formatter dataFileName expected = do
    actual <- Text.IO.readFile dataFileName
    parse Parser.document dataFileName actual `parseSatisfies` condition
      where
        condition = (expected ==) . Encoder.document formatter
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@ -1,198 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data
    ( Character
    , appearsIn
    , artoo
    , getDroid
    , getDroid'
    , getEpisode
    , getFriends
    , getHero
    , getHeroIO
    , getHuman
    , id_
    , homePlanet
    , name
    , secretBackstory
    , typeName
    ) where
 import Data.Monoid (mempty)
 import Control.Applicative ( Alternative(..)
                           , liftA2 
                           )
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
 -- ** Characters
 type ID = Text
 data CharCommon = CharCommon
  { _id_        :: ID
  , _name       :: Text
  , _friends    :: [ID]
  , _appearsIn  :: [Int]
  } deriving (Show)
 data Human = Human
  { _humanChar  :: CharCommon
  , homePlanet :: Text
  }
 data Droid = Droid
  { _droidChar       :: CharCommon
  , primaryFunction :: Text
  }
 type Character = Either Droid Human
 id_ :: Character -> ID
 id_ (Left  x) = _id_ . _droidChar $ x
 id_ (Right x) = _id_ . _humanChar $ x
 name :: Character -> Text
 name (Left  x) = _name . _droidChar $ x
 name (Right x) = _name . _humanChar $ x
 friends :: Character -> [ID]
 friends (Left  x) = _friends . _droidChar $ x
 friends (Right x) = _friends . _humanChar $ x
 appearsIn :: Character -> [Int]
 appearsIn (Left  x) = _appearsIn . _droidChar $ x
 appearsIn (Right x) = _appearsIn . _humanChar $ x
 secretBackstory :: MonadIO m => Character -> ActionT m Text
 secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
 typeName :: Character -> Text
 typeName = either (const "Droid") (const "Human")
 luke :: Character
 luke = Right luke'
 luke' :: Human
 luke' = Human
  { _humanChar = CharCommon
      { _id_        = "1000"
      , _name       = "Luke Skywalker"
      , _friends    = ["1002","1003","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 vader :: Human
 vader = Human
  { _humanChar = CharCommon
      { _id_        = "1001"
      , _name       = "Darth Vader"
      , _friends    = ["1004"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 han :: Human
 han = Human
  { _humanChar = CharCommon
      { _id_        = "1002"
      , _name       = "Han Solo"
      , _friends    = ["1000","1003","2001" ]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = mempty
  }
 leia :: Human
 leia = Human
  { _humanChar = CharCommon
      { _id_        = "1003"
      , _name       = "Leia Organa"
      , _friends    = ["1000","1002","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Alderaan"
  }
 tarkin :: Human
 tarkin = Human
  { _humanChar = CharCommon
    { _id_        = "1004"
    , _name       = "Wilhuff Tarkin"
    , _friends    = ["1001"]
    , _appearsIn  = [4]
    }
  , homePlanet = mempty
  }
 threepio :: Droid
 threepio = Droid
  { _droidChar = CharCommon
      { _id_ = "2000"
      , _name = "C-3PO"
      , _friends = ["1000","1002","1003","2001" ]
      , _appearsIn = [ 4, 5, 6 ]
      }
  , primaryFunction = "Protocol"
  }
 artoo :: Character
 artoo = Left artoo'
 artoo' :: Droid
 artoo' = Droid
  { _droidChar = CharCommon
      { _id_        = "2001"
      , _name       = "R2-D2"
      , _friends    = ["1000","1002","1003"]
      , _appearsIn  = [4,5,6]
      }
  , primaryFunction = "Astrometch"
  }
 -- ** Helper functions
 getHero :: Int -> Character
 getHero 5 = luke
 getHero _ = artoo
 getHeroIO :: Int -> IO Character
 getHeroIO = pure . getHero
 getHuman :: Alternative f => ID -> f Character
 getHuman = fmap Right . getHuman'
 getHuman' :: Alternative f => ID -> f Human
 getHuman' "1000" = pure luke'
 getHuman' "1001" = pure vader
 getHuman' "1002" = pure han
 getHuman' "1003" = pure leia
 getHuman' "1004" = pure tarkin
 getHuman' _      = empty
 getDroid :: Alternative f => ID -> f Character
 getDroid = fmap Left . getDroid'
 getDroid' :: Alternative f => ID -> f Droid
 getDroid' "2000" = pure threepio
 getDroid' "2001" = pure artoo'
 getDroid' _      = empty
 getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 getEpisode :: Int -> Maybe (Type.Wrapping Text)
 getEpisode 4 = pure $ Type.Named "NEWHOPE"
 getEpisode 5 = pure $ Type.Named "EMPIRE"
 getEpisode 6 = pure $ Type.Named "JEDI"
 getEpisode _ = empty
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@ -1,351 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.StarWars.QuerySpec
    ( spec
    ) where
 import qualified Data.Aeson as Aeson
 import Data.Aeson ( object
                  , (.=)
                  )
 import Data.Text (Text)
 import Language.GraphQL
 import Language.GraphQL.Schema (Subs)
 import Text.RawString.QQ (r)
 import Test.Hspec.Expectations ( Expectation
                               , shouldBe
                               )
 import Test.Hspec ( Spec
                  , describe
                  , it
                  )
 import Test.StarWars.Schema
 -- * Test
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
 spec :: Spec
 spec = describe "Star Wars Query Tests" $ do
    describe "Basic Queries" $ do
      it "R2-D2 hero" $ testQuery
        [r| query HeroNameQuery {
            hero {
                id
            }
            }
        |]
        $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
      it "R2-D2 ID and friends" $ testQuery
        [r| query HeroNameAndFriendsQuery {
            hero {
                id
                name
                friends {
                name
                }
            }
            }
        |]
        $ object [ "data" .= object [
            "hero" .= object
                [ "id" .= ("2001" :: Text)
                , r2d2Name
                , "friends" .=
                    [ object [lukeName]
                    , object [hanName]
                    , object [leiaName]
                    ]
                ]
        ]]
    describe "Nested Queries" $ do
      it "R2-D2 friends" $ testQuery
        [r| query NestedQuery {
              hero {
                name
                friends {
                  name
                  appearsIn
                    friends {
                      name
                    }
                }
              }
            }
        |]
        $ object [ "data" .= object [
          "hero" .= object [
              "name" .= ("R2-D2" :: Text)
            , "friends" .= [
                  object [
                      "name" .= ("Luke Skywalker" :: Text)
                    , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [hanName]
                        , object [leiaName]
                        , object [c3poName]
                        , object [r2d2Name]
                        ]
                    ]
                , object [
                      hanName
                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [lukeName]
                        , object [leiaName]
                        , object [r2d2Name]
                        ]
                    ]
                , object [
                      leiaName
                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [lukeName]
                        , object [hanName]
                        , object [c3poName]
                        , object [r2d2Name]
                        ]
                    ]
                ]
            ]
        ]]
      it "Luke ID" $ testQuery
        [r| query FetchLukeQuery {
              human(id: "1000") {
                name
              }
            }
        |]
        $ object [ "data" .= object [
          "human" .= object [lukeName]
        ]]
    it "Luke ID with variable" $ testQueryParams
      (\v -> if v == "someId" then Just "1000" else Nothing)
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "human" .= object [lukeName]
      ]]
    it "Han ID with variable" $ testQueryParams
      (\v -> if v == "someId" then Just "1002" else Nothing)
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "human" .= object [hanName]
      ]]
    it "Invalid ID" $ testQueryParams
      (\v -> if v == "id" then Just "Not a valid ID" else Nothing)
      [r| query humanQuery($id: String!) {
            human(id: $id) {
              name
            }
          }
      |] $ object ["data" .= object ["human" .= Aeson.Null]]
    it "Luke aliased" $ testQuery
      [r| query FetchLukeAliased {
            luke: human(id: "1000") {
              name
            }
          }
      |]
      $ object [ "data" .= object [
       "luke" .= object [lukeName]
      ]]
    it "R2-D2 ID and friends aliased" $ testQuery
      [r| query HeroNameAndFriendsQuery {
            hero {
              id
              name
              friends {
                friendName: name
              }
            }
          }
      |]
      $ object [ "data" .= object [
        "hero" .= object [
            "id" .= ("2001" :: Text)
          , r2d2Name
          , "friends" .= [
                object ["friendName" .= ("Luke Skywalker" :: Text)]
              , object ["friendName" .= ("Han Solo" :: Text)]
              , object ["friendName" .= ("Leia Organa" :: Text)]
              ]
          ]
      ]]
    it "Luke and Leia aliased" $ testQuery
      [r| query FetchLukeAndLeiaAliased {
            luke: human(id: "1000") {
              name
            }
            leia: human(id: "1003") {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "luke" .= object [lukeName]
      , "leia" .= object [leiaName]
      ]]
    describe "Fragments for complex queries" $ do
      it "Aliases to query for duplicate content" $ testQuery
        [r| query DuplicateFields {
              luke: human(id: "1000") {
                name
                homePlanet
              }
              leia: human(id: "1003") {
                name
                homePlanet
              }
            }
        |]
        $ object [ "data" .= object [
          "luke" .= object [lukeName, tatooine]
        , "leia" .= object [leiaName, alderaan]
        ]]
      it "Fragment for duplicate content" $ testQuery
        [r|  query UseFragment {
              luke: human(id: "1000") {
                ...HumanFragment
              }
              leia: human(id: "1003") {
                ...HumanFragment
              }
            }
            fragment HumanFragment on Human {
              name
              homePlanet
            }
        |]
        $ object [ "data" .= object [
          "luke" .= object [lukeName, tatooine]
        , "leia" .= object [leiaName, alderaan]
        ]]
    describe "__typename" $ do
      it "R2D2 is a Droid" $ testQuery
        [r| query CheckTypeOfR2 {
              hero {
                __typename
                name
              }
            }
          |]
        $ object ["data" .= object [
            "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
        ]]
      it "Luke is a human" $ testQuery
        [r| query CheckTypeOfLuke {
              hero(episode: EMPIRE) {
                __typename
                name
              }
            }
          |]
        $ object ["data" .= object [
            "hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
        ]]
    describe "Errors in resolvers" $ do
        it "error on secretBackstory" $ testQuery
          [r|
            query HeroNameQuery {
              hero {
                name
                  secretBackstory
              }
            }
          |]
          $ object
              [ "data" .= object
                  [ "hero" .= object
                      [ "name" .= ("R2-D2" :: Text)
                      , "secretBackstory" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ object
                      ["message" .= ("secretBackstory is secret." :: Text)]
                  ]
              ]
        it "Error in a list" $ testQuery
          [r| query HeroNameQuery {
                hero {
                  name
                  friends {
                    name
                    secretBackstory
                  }
                }
              }
            |]
          $ object ["data" .= object
            [ "hero" .= object
                [ "name" .= ("R2-D2" :: Text)
                , "friends" .=
                    [ object
                        [ "name" .= ("Luke Skywalker" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , object
                        [ "name" .= ("Han Solo" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , object
                        [ "name" .= ("Leia Organa" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    ]
                ]
            ]
            , "errors" .=
                [ object ["message" .= ("secretBackstory is secret." :: Text)]
                , object ["message" .= ("secretBackstory is secret." :: Text)]
                , object ["message" .= ("secretBackstory is secret." :: Text)]
                ]
            ]
        it "error on secretBackstory with alias" $ testQuery
          [r| query HeroNameQuery {
                mainHero: hero {
                  name
                  story: secretBackstory
                }
              }
            |]
          $ object
              [ "data" .= object
                  [ "mainHero" .= object
                      [ "name" .= ("R2-D2" :: Text)
                      , "story" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ object ["message" .= ("secretBackstory is secret." :: Text)]
                  ]
              ]
  where
    lukeName = "name" .= ("Luke Skywalker" :: Text)
    leiaName = "name" .= ("Leia Organa" :: Text)
    hanName = "name" .= ("Han Solo" :: Text)
    r2d2Name = "name" .= ("R2-D2" :: Text)
    c3poName = "name" .= ("C-3PO" :: Text)
    tatooine = "homePlanet" .= ("Tatooine" :: Text)
    alderaan = "homePlanet" .= ("Alderaan" :: Text)
 testQuery :: Text -> Aeson.Value -> Expectation
 testQuery q expected = graphql schema q >>= flip shouldBe expected
 testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -1,59 +0,0 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Schema
    ( character
    , droid
    , hero
    , human
    , schema
    ) where
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
 import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 import Test.StarWars.Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 schema :: MonadIO m => NonEmpty (Schema.Resolver m)
 schema = hero :| [human, droid]
 hero :: MonadIO m => Schema.Resolver m
 hero = Schema.objectA "hero" $ \case
  [] -> character artoo
  [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4
  [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5
  [Schema.Argument "episode" (Schema.Enum "JEDI"   )] -> character $ getHero 6
  _ -> ActionT $ throwE "Invalid arguments."
 human :: MonadIO m => Schema.Resolver m
 human = Schema.wrappedObjectA "human" $ \case
  [Schema.Argument "id" (Schema.String i)] -> do
      humanCharacter <- lift $ return $ getHuman i >>= Just
      case humanCharacter of
        Nothing -> return Type.Null
        Just e -> Type.Named <$> character e
  _ -> ActionT $ throwE "Invalid arguments."
 droid :: MonadIO m => Schema.Resolver m
 droid = Schema.objectA "droid" $ \case
   [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i)
   _ -> ActionT $ throwE "Invalid arguments."
 character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
 character char = return
    [ Schema.scalar "id" $ return $ id_ char
    , Schema.scalar "name" $ return $ name char
    , Schema.wrappedObject "friends"
        $ traverse character $ Type.List $ Type.Named <$> getFriends char
    , Schema.wrappedScalar "appearsIn" $ return . Type.List
        $ catMaybes (getEpisode <$> appearsIn char)
    , Schema.scalar "secretBackstory" $ secretBackstory char
    , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
    , Schema.scalar "__typename" $ return $ typeName char
    ]
--- a/tests/data/kitchen-sink.graphql
+++ b/tests/data/kitchen-sink.graphql
@ -1,38 +0,0 @@
 # Copyright (c) 2015, Facebook, Inc.
 # All rights reserved.
 #
 # This source code is licensed under the BSD-style license found in the
 # LICENSE file in the root directory of this source tree. An additional grant
 # of patent rights can be found in the PATENTS file in the same directory.
 query queryName($foo: ComplexType, $site: Site = MOBILE) {
  whoever123is: node(id: [123, 456]) {
    id, # Inline test comment
    ... on User @defer {
      field2 {
        id,
        alias: field1(first: 10, after: $foo) @include(if: $foo) {
          id,
          ...frag
        }
      }
    }
  }
 }
 mutation likeStory {
  like(story: 123) @defer {
    story {
      id
    }
  }
 }
 fragment frag on Friend {
  foo(size: $size, bar: $b, obj: {key: "value"})
 }
 {
  unnamed(truthy: true, falsey: false),
  query
 }
--- a/tests/data/kitchen-sink.min.graphql
+++ b/tests/data/kitchen-sink.min.graphql
@ -1 +0,0 @@
 query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}
		`@ -1 +0,0 @@`
			`query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}`