Release 0.9.0.0

2020-07-24 21:34:31 +02:00
50 changed files with 2170 additions and 4721 deletions
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@ -0,0 +1,63 @@
 name: Haskell CI
 on:
  push: ~
  pull_request:
    branches: [master]
 jobs:
  test:
    runs-on: ubuntu-latest
    steps:
    - uses: actions/checkout@v2
    - uses: actions/setup-haskell@v1
      with:
        enable-stack: true
        stack-no-global: true
        stack-version: latest
    - name: Cache
      uses: actions/cache@v2
      with:
        path: |
          ~/.stack
          stack.yaml.lock
        key: ${{ runner.os }}-test-${{ hashFiles('**/stack.yaml') }}
        restore-keys: ${{ runner.os }}-test-
    - name: Install dependencies
      run: stack --no-terminal test --only-snapshot
    - name: Run tests
      run: stack --no-terminal test --pedantic
    - name: Build the documentation
      run: |
        stack --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
        stack --no-terminal haddock --no-haddock-deps
  lint:
    runs-on: ubuntu-latest
    steps:
    - uses: actions/checkout@v2
    - uses: actions/setup-haskell@v1
      with:
        enable-stack: true
        stack-no-global: true
        stack-version: latest
    - name: Cache
      uses: actions/cache@v2
      with:
        path: |
          ~/.stack
          stack.yaml.lock
        key: ${{ runner.os }}-lint-${{ hashFiles('**/stack.yaml') }}
        restore-keys: ${{ runner.os }}-lint-
    - name: Build HLint
      run: stack --no-terminal build hlint
    - name: Install HLint
      run: stack --no-terminal install hlint
    - name: Lint
      run: stack --no-terminal exec hlint -- src tests docs
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -6,114 +6,22 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
-## [0.11.1.0] - 2021-02-07
+## [Unreleased]
-### Added
+## Fixed
 - `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
+## 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.
+- Parsing subscriptions (the execution always fails yet).
 - `Error.ResponseEventStream`, `Type.Out.Resolve`, `Type.Out.Subscribe` and
  `Type.Out.SourceEventStream` define subscription resolvers.
 - `Error.ResolverException` is an exception that can be thrown by (field value
@ -122,7 +30,7 @@ and this project adheres to
 - `Test.Hspec.GraphQL` contains some test helpers.
 - `Validate` contains the validator and standard rules.
-### Changed
+## 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
@ -146,9 +54,11 @@ and this project adheres to
 - The constraint of the base monad was changed to `MonadCatch` (and it implies
  `MonadThrow`).
-### Removed
+## Removed
 - `Trans.ActionT` is an unneeded layer of complexity. `Type.Out.Resolver`
  represents possible resolver configurations.
 - `Type.Out.Resolver`: It . Resolvers are a
  part of the fields and are called `Trans.ResolverT`.
 - `Execute.executeWithName`. `Execute.execute` takes the operation name and
   completely replaces `executeWithName`.
@ -413,18 +323,15 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.
-[0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0
+[Unreleased]: https://github.com/caraus-ecms/graphql/compare/v0.8.0.0...HEAD
-[0.11.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.0.0&rev_to=v0.10.0.0
+[0.8.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.7.0.0...v0.8.0.0
-[0.10.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.10.0.0&rev_to=v0.9.0.0
+[0.7.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...v0.7.0.0
-[0.9.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.9.0.0&rev_to=v0.8.0.0
+[0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
-[0.8.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.8.0.0&rev_to=v0.7.0.0
+[0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
-[0.7.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.7.0.0&rev_to=v0.6.1.0
+[0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0
-[0.6.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.6.1.0&rev_to=v0.6.0.0
+[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
-[0.6.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.6.0.0&rev_to=v0.5.1.0
+[0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0
-[0.5.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.5.1.0&rev_to=v0.5.0.1
+[0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
-[0.5.0.1]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.5.0.1&rev_to=v0.5.0.0
+[0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
-[0.5.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.5.0.0&rev_to=v0.4.0.0
+[0.2.1]: https://github.com/caraus-ecms/graphql/compare/v0.2...v0.2.1
-[0.4.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.4.0.0&rev_to=v0.3
+[0.2]: https://github.com/caraus-ecms/graphql/compare/v0.1...v0.2
 [0.3]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.3&rev_to=v0.2.1
 [0.2.1]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.2.1&rev_to=v0.2
 [0.2]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.2&rev_to=v0.1
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@ -0,0 +1,31 @@
 # Contributing guidelines
 ## Testing
 To ensure all code changes adhere to existing code quality standards, some
 automatic checks can be run locally.
 Ensure that the code builds without warnings and passes the tests:
 ```sh
 stack test --pedantic
 ```
 And also run the linter on your code:
 ```sh
 stack build hlint
 stack exec hlint -- src tests
 ```
 Build the documentation and check if you get any warnings:
 ```sh
 stack haddock
 ```
 Validate that literate Haskell (tutorials) files compile without any warnings:
 ```sh
 stack ghc -- -Wall -fno-code docs/tutorial/*.lhs
 ```
--- a/LICENSE.MPL
+++ b/LICENSE.MPL
@ -1,373 +0,0 @@
 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,15 +1,48 @@
-# GraphQL implementation in Haskell
+# Haskell GraphQL
-[![Simple Haskell](https://www.simplehaskell.org/badges/badge.svg)](https://www.simplehaskell.org)
+[![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql)
-[![CI/CD](https://img.shields.io/badge/CI-CD-brightgreen)](https://build.caraus.tech/go/pipelines)
+[![Build Status](https://github.com/caraus-ecms/graphql/workflows/Haskell%20CI/badge.svg)](https://github.com/caraus-ecms/graphql/actions?query=workflow%3A%22Haskell+CI%22)
 [![License](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](https://raw.githubusercontent.com/caraus-ecms/graphql/master/LICENSE)
-See https://www.caraus.tech/projects/pub-graphql.
+GraphQL implementation in Haskell.
-Report issues on the
+This implementation is relatively low-level by design, it doesn't provide any
-[bug tracker](https://www.caraus.tech/projects/pub-graphql/issues).
+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 using the given schema, but without
 the validation step. But the idea is to be a Haskell port of
 [`graphql-js`](https://github.com/graphql/graphql-js).
 For the list of currently missing features see issues marked as
 "[not implemented](https://github.com/caraus-ecms/graphql/labels/not%20implemented)".
 ## Documentation
 API documentation is available through
 [Hackage](https://hackage.haskell.org/package/graphql).
-Further documentation will be made available in the
+You'll also find a small tutorial with some examples under
-[Wiki](https://www.caraus.tech/projects/pub-graphql/wiki).
+[docs/tutorial](https://github.com/caraus-ecms/graphql/tree/master/docs/tutorial).
 ## Further information
 - [Contributing guidelines](CONTRIBUTING.md).
 - [Changelog](CHANGELOG.md) – this one contains the most recent changes; 
  individual changelogs for specific versions can be found on
  [Hackage](https://hackage.haskell.org/package/graphql).
 ## 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
@ -0,0 +1,152 @@
 ---
 title: GraphQL Haskell Tutorial
 ---
 == Getting started ==
 Welcome to GraphQL!
 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 #-}
 > module Main where
 >
 > import Control.Monad.IO.Class (liftIO)
 > import Data.Aeson (encode)
 > import Data.ByteString.Lazy.Char8 (putStrLn)
 > import qualified Data.HashMap.Strict as HashMap
 > import Data.Text (Text)
 > import qualified Data.Text as Text
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
 > import Language.GraphQL.Type
 > import qualified Language.GraphQL.Type.Out as Out
 >
 > import Prelude hiding (putStrLn)
 === First example ===
 Now, as our first example, we are going to look at the example from
 [graphql.js](https://github.com/graphql/graphql-js).
 First we build a GraphQL schema.
 > schema1 :: Schema IO
 > schema1 = Schema
 >   { query = queryType , mutation = Nothing , subscription = Nothing }
 >
 > queryType :: ObjectType IO
 > queryType = ObjectType "Query" Nothing []
 >   $ HashMap.singleton "hello"
 >   $ ValueResolver helloField hello
 >
 > helloField :: Field IO
 > helloField = Field Nothing (Out.NamedScalarType string) mempty
 >
 > hello :: Resolve IO
 > hello = pure $ String "it's me"
 This defines a simple schema with one type and one field, that resolves to a
 fixed value.
 Next we define our query.
 > query1 :: Text
 > query1 = "{ hello }"
 To run the query, we call the `graphql` with the schema and the query.
 > main1 :: IO ()
 > main1 = graphql schema1 query1
 >   >>= either (const $ pure ()) (putStrLn . encode)
 This runs the query by fetching the one field defined, returning
 ```{"data" : {"hello":"it's me"}}```
 === Monadic actions ===
 For this example, we're going to be using time.
 > schema2 :: Schema IO
 > schema2 = Schema
 >   { query = queryType2, mutation = Nothing, subscription = Nothing }
 >
 > queryType2 :: ObjectType IO
 > queryType2 = ObjectType "Query" Nothing []
 >   $ HashMap.singleton "time"
 >   $ ValueResolver timeField time
 >
 > timeField :: Field IO
 > timeField = Field Nothing (Out.NamedScalarType string) mempty
 >
 > time :: Resolve IO
 > time = do
 >   t <- liftIO getCurrentTime
 >   pure $ String $ Text.pack $ show t
 This defines a simple schema with one type and one field, which resolves to the
 current time.
 Next we define our query.
 > query2 :: Text
 > query2 = "{ time }"
 >
 > main2 :: IO ()
 > main2 = graphql schema2 query2
 >   >>= either (const $ pure ()) (putStrLn . encode)
 This runs the query, returning the current time
 ```{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}```
 === Combining resolvers ===
 Now that we have two resolvers, we can define a schema which uses them both.
 > schema3 :: Schema IO
 > schema3 = Schema
 >   { query = queryType3, mutation = Nothing, subscription = Nothing }
 >
 > queryType3 :: ObjectType IO
 > queryType3 = ObjectType "Query" Nothing [] $ HashMap.fromList
 >   [ ("hello", ValueResolver helloField hello)
 >   , ("time", ValueResolver timeField time)
 >   ]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
 > main3 = graphql schema3 query3
 >   >>= either (const $ pure ()) (putStrLn . encode)
 This queries for both time and hello, returning
 ```{ "data": {"hello":"it's me","time":"2016-03-08 23:29:11.62108 UTC"}}```
 Notice that we can name our queries, as we did with `timeAndHello`. Since we
 have only been using single queries, we can use the shorthand `{ time hello }`,
 as we have been doing in the previous examples.
 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 >> main3
--- a/graphql.cabal
+++ b/graphql.cabal
@ -1,35 +1,39 @@
-cabal-version: 2.2
+cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
 --
-- hash: 15a0880180192f918ba0bd3b3e955c57232f1efe8993745d505fcb6e1aab1451
+-- hash: ba234bcfff46df053a3466359e32682c4592b88894911ecbe78bd00fa00929b5
 name:           graphql
-version:        0.11.1.0
+version:        0.8.0.0
 synopsis:       Haskell GraphQL implementation
-description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
+description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 category:       Language
-homepage:       https://www.caraus.tech/projects/pub-graphql
+homepage:       https://github.com/caraus-ecms/graphql#readme
-bug-reports:    https://www.caraus.tech/projects/pub-graphql/issues
+bug-reports:    https://github.com/caraus-ecms/graphql/issues
 author:         Danny Navarro <j@dannynavarro.net>,
                Matthías Páll Gissurarson <mpg@mpg.is>,
                Sólrún Halla Einarsdóttir <she@mpg.is>
 maintainer:     belka@caraus.de
-copyright:      (c) 2019-2021 Eugen Wissner,
+copyright:      (c) 2019-2020 Eugen Wissner,
                (c) 2015-2017 J. Daniel Navarro
-license:        MPL-2.0 AND BSD-3-Clause
+license:        BSD3
-license-files:  LICENSE,
+license-file:   LICENSE
                LICENSE.MPL
 build-type:     Simple
 extra-source-files:
    CHANGELOG.md
    README.md
    LICENSE
    docs/tutorial/tutorial.lhs
 data-files:
    tests/data/kitchen-sink.graphql
    tests/data/kitchen-sink.min.graphql
 source-repository head
  type: git
-  location: git://caraus.tech/pub/graphql.git
+  location: https://github.com/caraus-ecms/graphql
 library
  exposed-modules:
@ -48,7 +52,6 @@ library
      Language.GraphQL.Type.Out
      Language.GraphQL.Type.Schema
      Language.GraphQL.Validate
      Language.GraphQL.Validate.Validation
      Test.Hspec.GraphQL
  other-modules:
      Language.GraphQL.Execute.Execution
@ -74,11 +77,10 @@ library
    , unordered-containers
  default-language: Haskell2010
-test-suite graphql-test
+test-suite tasty
  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
@ -86,12 +88,14 @@ test-suite graphql-test
      Language.GraphQL.Execute.CoerceSpec
      Language.GraphQL.ExecuteSpec
      Language.GraphQL.Type.OutSpec
-      Language.GraphQL.Validate.RulesSpec
+      Language.GraphQL.ValidateSpec
      Test.DirectiveSpec
      Test.FragmentSpec
      Test.KitchenSinkSpec
      Test.RootOperationSpec
-      Paths_graphql
+      Test.StarWars.Data
-  autogen-modules:
+      Test.StarWars.QuerySpec
      Test.StarWars.Schema
      Paths_graphql
  hs-source-dirs:
      tests
--- a/package.yaml
+++ b/package.yaml
@ -1,29 +1,29 @@
-name: graphql
+name:                graphql
-version: 0.11.1.0
+version:             0.9.0.0
-synopsis: Haskell GraphQL implementation
+synopsis:            Haskell GraphQL implementation
 description:
-  Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
+  This package provides a rudimentary parser for the
-maintainer: belka@caraus.de
+  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
-git: git://caraus.tech/pub/graphql.git
+maintainer:          belka@caraus.de
-homepage: https://www.caraus.tech/projects/pub-graphql
+github:              caraus-ecms/graphql
-bug-reports: https://www.caraus.tech/projects/pub-graphql/issues
+category:            Language
 category: Language
 license: MPL-2.0 AND BSD-3-Clause
 copyright:
- (c) 2019-2021 Eugen Wissner
+- (c) 2019-2020 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>
 license-file:
 - LICENSE
 - LICENSE.MPL
 extra-source-files:
 - CHANGELOG.md
 - README.md
 - LICENSE
 - docs/tutorial/tutorial.lhs
 data-files:
 - tests/data/*.graphql
 - tests/data/*.min.graphql
 dependencies:
 - aeson
@ -50,7 +50,7 @@ library:
  - Language.GraphQL.Validate.Rules
 tests:
-  graphql-test:
+  tasty:
    main: Spec.hs
    source-dirs: tests
    ghc-options:
@ -63,5 +63,3 @@ tests:
    - hspec-megaparsec
    - QuickCheck
    - raw-strings-qq
    generated-other-modules:
    - Paths_graphql
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@ -11,14 +11,13 @@ import Control.Monad.Catch (MonadCatch)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import Language.GraphQL.AST
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import qualified Language.GraphQL.Validate as Validate
-import Language.GraphQL.Type.Schema (Schema)
+import Language.GraphQL.Type.Schema
 import Text.Megaparsec (parse)
 -- | If the text parses correctly as a @GraphQL@ query the query is
@ -56,19 +55,24 @@ graphqlSubs schema operationName variableValues document' =
        [ ("data", data'')
        , ("errors", Aeson.toJSON $ fromError <$> errors')
        ]
-    fromError Error{..} = Aeson.object $ catMaybes
+    fromError Error{ locations = [], ..} =
-        [ Just ("message", Aeson.toJSON message)
+        Aeson.object [("message", Aeson.toJSON message)]
-        , toMaybe fromLocation "locations" locations
+    fromError Error{..} = Aeson.object
        , toMaybe fromPath "path" path
        ]
    fromValidationError Validate.Error{..} = Aeson.object
        [ ("message", Aeson.toJSON message)
        , ("locations", Aeson.listValue fromLocation locations)
        ]
-    toMaybe _ _ [] = Nothing
+    fromValidationError Validate.Error{..}
-    toMaybe f key xs = Just (key, Aeson.listValue f xs)
+        | [] <- path = Aeson.object
-    fromPath (Segment segment) = Aeson.String segment
+            [ ("message", Aeson.toJSON message)
-    fromPath (Index index) = Aeson.toJSON index
+            , ("locations", Aeson.listValue fromLocation locations)
            ]
        | otherwise = Aeson.object
            [ ("message", Aeson.toJSON message)
            , ("locations", Aeson.listValue fromLocation locations)
            , ("path", Aeson.listValue fromPath path)
            ]
    fromPath (Validate.Segment segment) = Aeson.String segment
    fromPath (Validate.Index index) = Aeson.toJSON index
    fromLocation Location{..} = Aeson.object
        [ ("line", Aeson.toJSON line)
        , ("column", Aeson.toJSON column)
--- a/src/Language/GraphQL/AST.hs
+++ b/src/Language/GraphQL/AST.hs
@ -1,7 +1,3 @@
 {- 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/. -}
 -- | Target AST for parser.
 module Language.GraphQL.AST
    ( module Language.GraphQL.AST.Document
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@ -1,11 +1,5 @@
 {- 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 Safe #-}
 -- | Various parts of a GraphQL document can be annotated with directives. 
-- This module describes locations in a document where directives can appear.
+--   This module describes locations in a document where directives can appear.
 module Language.GraphQL.AST.DirectiveLocation
    ( DirectiveLocation(..)
    , ExecutableDirectiveLocation(..)
@ -13,18 +7,12 @@ module Language.GraphQL.AST.DirectiveLocation
    ) 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
+--   various parts of executable definitions and the ones used in the schema
-- definition.
+--   definition.
 data DirectiveLocation
    = ExecutableDirectiveLocation ExecutableDirectiveLocation
    | TypeSystemDirectiveLocation TypeSystemDirectiveLocation
-    deriving Eq
+    deriving (Eq, Show)
 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
@ -35,16 +23,7 @@ data ExecutableDirectiveLocation
    | FragmentDefinition
    | FragmentSpread
    | InlineFragment
-    deriving Eq
+    deriving (Eq, Show)
 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
@ -59,17 +38,4 @@ data TypeSystemDirectiveLocation
    | EnumValue
    | InputObject
    | InputFieldDefinition
-    deriving Eq
+    deriving (Eq, Show)
 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
@ -1,16 +1,12 @@
 {-# 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(..)
+    ( Alias
    , Argument(..)
    , ArgumentsDefinition(..)
    , ConstValue(..)
    , Definition(..)
@ -19,17 +15,13 @@ module Language.GraphQL.AST.Document
    , Document
    , EnumValueDefinition(..)
    , ExecutableDefinition(..)
    , Field(..)
    , FieldDefinition(..)
    , FragmentDefinition(..)
    , FragmentSpread(..)
    , ImplementsInterfaces(..)
    , InlineFragment(..)
    , InputValueDefinition(..)
    , Location(..)
    , Name
    , NamedType
    , Node(..)
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
@ -48,18 +40,14 @@ module Language.GraphQL.AST.Document
    , UnionMemberTypes(..)
    , Value(..)
    , VariableDefinition(..)
    , escape
    ) 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)
+import Language.GraphQL.AST.DirectiveLocation
 -- * Language
@ -74,24 +62,6 @@ data Location = Location
    , 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.
@ -99,7 +69,7 @@ type Document = NonEmpty Definition
 -- | All kinds of definitions that can occur in a GraphQL document.
 data Definition
-    = ExecutableDefinition ExecutableDefinition
+    = ExecutableDefinition ExecutableDefinition Location
    | TypeSystemDefinition TypeSystemDefinition Location
    | TypeSystemExtension TypeSystemExtension Location
    deriving (Eq, Show)
@ -114,14 +84,13 @@ data ExecutableDefinition
 -- | Operation definition.
 data OperationDefinition
-    = SelectionSet SelectionSet Location
+    = SelectionSet SelectionSet
    | OperationDefinition
        OperationType
        (Maybe Name)
        [VariableDefinition]
        [Directive]
        SelectionSet
        Location
    deriving (Eq, Show)
 -- | GraphQL has 3 operation types:
@ -140,15 +109,10 @@ type SelectionSet = NonEmpty Selection
 -- | Field selection.
 type SelectionSetOpt = [Selection]
-- | Selection is a single entry in a selection set. It can be a single 'Field',
+-- | Selection is a single entry in a selection set. It can be a single field,
-- 'FragmentSpread' or an 'InlineFragment'.
+-- fragment spread or inline fragment.
-data Selection
+--
-    = FieldSelection Field
+-- The only required property of a field is its name. Optionally it can also
    | 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":
@ -161,27 +125,8 @@ data Selection
 --   }
 -- }
 -- @
 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.
 --
-- @
+-- A fragment spread refers to a fragment defined outside the operation and is
 -- {
 --   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.
 --
 -- @
@ -196,7 +141,23 @@ data InlineFragment = InlineFragment
 --   name
 -- }
 -- @
-data FragmentSpread = FragmentSpread Name [Directive] Location
+--
 -- Inline fragments are similar but they don't have any name and the type
 -- condition ("on UserType") is optional.
 --
 -- @
 -- {
 --   user {
 --     ... on UserType {
 --       id
 --       name
 --     }
 -- }
 -- @
 data Selection
    = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
    | FragmentSpread Name [Directive]
    | InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
    deriving (Eq, Show)
 -- ** Arguments
@ -212,13 +173,29 @@ data FragmentSpread = FragmentSpread Name [Directive] Location
 -- @
 --
 --  Here "id" is an argument for the field "user" and its value is 4.
-data Argument = Argument Name (Node Value) Location deriving (Eq, Show)
+data Argument = Argument Name Value deriving (Eq,Show)
 -- ** Field Alias
 -- | 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
 -- ** Fragments
 -- | Fragment definition.
 data FragmentDefinition
-    = FragmentDefinition Name TypeCondition [Directive] SelectionSet Location
+    = FragmentDefinition Name TypeCondition [Directive] SelectionSet
    deriving (Eq, Show)
 -- | Type condition.
@ -226,28 +203,6 @@ type TypeCondition = Name
 -- ** Input Values
 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
@ -259,19 +214,7 @@ data Value
    | Enum Name
    | List [Value]
    | Object [ObjectField Value]
-    deriving Eq
+    deriving (Eq, Show)
 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
@ -283,33 +226,13 @@ data ConstValue
    | ConstEnum Name
    | ConstList [ConstValue]
    | ConstObject [ObjectField ConstValue]
-    deriving Eq
+    deriving (Eq, Show)
 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
+data ObjectField a = ObjectField Name a
-    { name :: Name
+    deriving (Eq, Show)
    , 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
@ -329,8 +252,7 @@ instance Functor ObjectField where
 --
 -- Variables are usually passed along with the query, but not in the query
 -- itself. They make queries reusable.
-data VariableDefinition =
+data VariableDefinition = VariableDefinition Name Type (Maybe ConstValue)
    VariableDefinition Name Type (Maybe (Node ConstValue)) Location
    deriving (Eq, Show)
 -- ** Type References
@ -340,12 +262,7 @@ data Type
    = TypeNamed Name
    | TypeList Type
    | TypeNonNull NonNullType
-    deriving Eq
+    deriving (Eq, Show)
 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
@ -354,11 +271,7 @@ type NamedType = Name
 data NonNullType
    = NonNullTypeNamed Name
    | NonNullTypeList Type
-    deriving Eq
+    deriving (Eq, Show)
 instance Show NonNullType where
    show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName
    show (NonNullTypeList listType) =  concat ["![", show listType, "]"]
 -- ** Directives
@ -366,7 +279,7 @@ instance Show NonNullType where
 --
 -- Directives begin with "@", can accept arguments, and can be applied to the
 -- most GraphQL elements, providing additional information.
-data Directive = Directive Name [Argument] Location deriving (Eq, Show)
+data Directive = Directive Name [Argument] deriving (Eq, Show)
 -- * Type System
@ -565,8 +478,8 @@ instance Monoid ArgumentsDefinition where
 -- @
 --
 -- The input type "Point2D" contains two value definitions: "x" and "y".
-data InputValueDefinition = InputValueDefinition
+data InputValueDefinition
-    Description Name Type (Maybe (Node ConstValue)) [Directive]
+    = InputValueDefinition Description Name Type (Maybe ConstValue) [Directive]
    deriving (Eq, Show)
 -- ** Unions
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@ -1,8 +1,6 @@
 {-# 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
@ -16,6 +14,7 @@ module Language.GraphQL.AST.Encoder
    , value
    ) where
 import Data.Char (ord)
 import Data.Foldable (fold)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text (Text)
@ -24,9 +23,9 @@ 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)
+import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
 import Data.Text.Lazy.Builder.RealFloat (realFloat)
-import qualified Language.GraphQL.AST.Document as Full
+import Language.GraphQL.AST.Document
 -- | Instructs the encoder whether the GraphQL document should be minified or
 --   pretty printed.
@ -45,78 +44,77 @@ minified :: Formatter
 minified = Minified
 -- | Converts a Document' into a string.
-document :: Formatter -> Full.Document -> Lazy.Text
+document :: Formatter -> Document -> Lazy.Text
 document formatter defs
    | Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
    | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
  where
    encodeDocument = foldr executableDefinition [] defs
-    executableDefinition (Full.ExecutableDefinition executableDefinition') acc =
+    executableDefinition (ExecutableDefinition x _) acc =
-        definition formatter executableDefinition' : acc
+        definition formatter x : acc
    executableDefinition _ acc = acc
-- | Converts a t'Full.ExecutableDefinition' into a string.
+-- | Converts a t'ExecutableDefinition' into a string.
-definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
+definition :: Formatter -> ExecutableDefinition -> Lazy.Text
 definition formatter x
    | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
    | Minified <- formatter = encodeDefinition x
  where
-    encodeDefinition (Full.DefinitionOperation operation)
+    encodeDefinition (DefinitionOperation operation)
        = operationDefinition formatter operation
-    encodeDefinition (Full.DefinitionFragment fragment)
+    encodeDefinition (DefinitionFragment fragment)
        = fragmentDefinition formatter fragment
-- | Converts a 'Full.OperationDefinition into a string.
+-- | Converts a 'OperationDefinition into a string.
-operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
+operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text
 operationDefinition formatter = \case
-    Full.SelectionSet sels _ -> selectionSet formatter sels
+    SelectionSet sels -> selectionSet formatter sels
-    Full.OperationDefinition Full.Query name vars dirs sels _ ->
+    OperationDefinition Query name vars dirs sels ->
-        "query " <> root name vars dirs sels
+        "query " <> node formatter name vars dirs sels
-    Full.OperationDefinition Full.Mutation name vars dirs sels _ ->
+    OperationDefinition Mutation name vars dirs sels ->
-        "mutation " <> root name vars dirs sels
+        "mutation " <> node formatter name vars dirs sels
-    Full.OperationDefinition Full.Subscription name vars dirs sels _ ->
+    OperationDefinition Subscription name vars dirs sels ->
-        "subscription " <> root name vars dirs sels
+        "subscription " <> node formatter name vars dirs sels
  where
    -- | Converts a Query or Mutation into a string.
    root :: Maybe Full.Name ->
        [Full.VariableDefinition] ->
        [Full.Directive] ->
        Full.SelectionSet ->
        Lazy.Text
    root name vars dirs sels
        = Lazy.Text.fromStrict (fold name)
        <> optempty (variableDefinitions formatter) vars
        <> optempty (directives formatter) dirs
        <> eitherFormat formatter " " mempty
        <> selectionSet formatter sels
-variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
+-- | Converts a Query or Mutation into a string.
 node :: Formatter ->
    Maybe Name ->
    [VariableDefinition] ->
    [Directive] ->
    SelectionSet ->
    Lazy.Text
 node formatter name vars dirs sels
    = Lazy.Text.fromStrict (fold name)
    <> optempty (variableDefinitions formatter) vars
    <> optempty (directives formatter) dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 variableDefinitions :: Formatter -> [VariableDefinition] -> Lazy.Text
 variableDefinitions formatter
    = parensCommas formatter $ variableDefinition formatter
-variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
+variableDefinition :: Formatter -> VariableDefinition -> Lazy.Text
-variableDefinition formatter variableDefinition' =
+variableDefinition formatter (VariableDefinition var ty defaultValue')
-    let Full.VariableDefinition variableName variableType defaultValue' _ =
+    = variable var
            variableDefinition'
     in variable variableName
    <> eitherFormat formatter ": " ":"
-    <> type' variableType
+    <> type' ty
-    <> maybe mempty (defaultValue formatter) (Full.node <$> defaultValue')
+    <> maybe mempty (defaultValue formatter) defaultValue'
-defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text
+defaultValue :: Formatter -> ConstValue -> Lazy.Text
 defaultValue formatter val
    = eitherFormat formatter " = " "="
    <> value formatter (fromConstValue val)
-variable :: Full.Name -> Lazy.Text
+variable :: Name -> Lazy.Text
 variable var = "$" <> Lazy.Text.fromStrict var
-selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
+selectionSet :: Formatter -> SelectionSet -> Lazy.Text
 selectionSet formatter
    = bracesList formatter (selection formatter)
    . NonEmpty.toList
-selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
+selectionSetOpt :: Formatter -> SelectionSetOpt -> Lazy.Text
 selectionSetOpt formatter = bracesList formatter $ selection formatter
 indentSymbol :: Lazy.Text
@ -125,15 +123,15 @@ indentSymbol = "  "
 indent :: (Integral a) => a -> Lazy.Text
 indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
-selection :: Formatter -> Full.Selection -> Lazy.Text
+selection :: Formatter -> Selection -> Lazy.Text
 selection formatter = Lazy.Text.append indent' . encodeSelection
  where
-    encodeSelection (Full.FieldSelection fieldSelection) =
+    encodeSelection (Field alias name args directives' selections) =
-        field incrementIndent fieldSelection
+        field incrementIndent alias name args directives' selections
-    encodeSelection (Full.InlineFragmentSelection fragmentSelection) =
+    encodeSelection (InlineFragment typeCondition directives' selections) =
-        inlineFragment incrementIndent fragmentSelection
+        inlineFragment incrementIndent typeCondition directives' selections
-    encodeSelection (Full.FragmentSpreadSelection fragmentSelection) =
+    encodeSelection (FragmentSpread name directives') =
-        fragmentSpread incrementIndent fragmentSelection
+        fragmentSpread incrementIndent name directives'
    incrementIndent
        | Pretty indentation <- formatter = Pretty $ indentation + 1
        | otherwise = Minified
@ -144,9 +142,15 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
 colon :: Formatter -> Lazy.Text
 colon formatter = eitherFormat formatter ": " ":"
-- | Converts Field into a string.
+-- | Converts Field into a string
-field :: Formatter -> Full.Field -> Lazy.Text
+field :: Formatter ->
-field formatter (Full.Field alias name args dirs set _)
+    Maybe Name ->
    Name ->
    [Argument] ->
    [Directive] ->
    [Selection] ->
    Lazy.Text
 field formatter alias name args dirs set
    = optempty prependAlias (fold alias)
    <> Lazy.Text.fromStrict name
    <> optempty (arguments formatter) args
@ -157,32 +161,36 @@ field formatter (Full.Field alias name args dirs set _)
    selectionSetOpt' = (eitherFormat formatter " " "" <>)
        . selectionSetOpt formatter
-arguments :: Formatter -> [Full.Argument] -> Lazy.Text
+arguments :: Formatter -> [Argument] -> Lazy.Text
 arguments formatter = parensCommas formatter $ argument formatter
-argument :: Formatter -> Full.Argument -> Lazy.Text
+argument :: Formatter -> Argument -> Lazy.Text
-argument formatter (Full.Argument name value' _)
+argument formatter (Argument name value')
    = Lazy.Text.fromStrict name
    <> colon formatter
-    <> value formatter (Full.node value')
+    <> value formatter value'
 -- * Fragments
-fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
+fragmentSpread :: Formatter -> Name -> [Directive] -> Lazy.Text
-fragmentSpread formatter (Full.FragmentSpread name directives' _)
+fragmentSpread formatter name directives'
    = "..." <> Lazy.Text.fromStrict name
    <> optempty (directives formatter) directives'
-inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
+inlineFragment ::
-inlineFragment formatter (Full.InlineFragment typeCondition directives' selections _)
+    Formatter ->
-    = "... on "
+    Maybe TypeCondition ->
-    <> Lazy.Text.fromStrict (fold typeCondition)
+    [Directive] ->
-    <> directives formatter directives'
+    SelectionSet ->
    Lazy.Text
 inlineFragment formatter tc dirs sels = "... on "
    <> Lazy.Text.fromStrict (fold tc)
    <> directives formatter dirs
    <> eitherFormat formatter " " mempty
-    <> selectionSet formatter selections
+    <> selectionSet formatter sels
-fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
+fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
-fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _)
+fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
    = "fragment " <> Lazy.Text.fromStrict name
    <> " on " <> Lazy.Text.fromStrict tc
    <> optempty (directives formatter) dirs
@ -191,39 +199,39 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels _)
 -- * Miscellaneous
-- | Converts a 'Full.Directive' into a string.
+-- | Converts a 'Directive' into a string.
-directive :: Formatter -> Full.Directive -> Lazy.Text
+directive :: Formatter -> Directive -> Lazy.Text
-directive formatter (Full.Directive name args _)
+directive formatter (Directive name args)
    = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
-directives :: Formatter -> [Full.Directive] -> Lazy.Text
+directives :: Formatter -> [Directive] -> Lazy.Text
 directives Minified = spaces (directive Minified)
 directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
-- | Converts a 'Full.Value' into a string.
+-- | Converts a 'Value' into a string.
-value :: Formatter -> Full.Value -> Lazy.Text
+value :: Formatter -> Value -> Lazy.Text
-value _ (Full.Variable x) = variable x
+value _ (Variable x) = variable x
-value _ (Full.Int x) = Builder.toLazyText $ decimal x
+value _ (Int x) = Builder.toLazyText $ decimal x
-value _ (Full.Float x) = Builder.toLazyText $ realFloat x
+value _ (Float x) = Builder.toLazyText $ realFloat x
-value _ (Full.Boolean  x) = booleanValue x
+value _ (Boolean  x) = booleanValue x
-value _ Full.Null = "null"
+value _ Null = "null"
-value formatter (Full.String string) = stringValue formatter string
+value formatter (String string) = stringValue formatter string
-value _ (Full.Enum x) = Lazy.Text.fromStrict x
+value _ (Enum x) = Lazy.Text.fromStrict x
-value formatter (Full.List x) = listValue formatter x
+value formatter (List x) = listValue formatter x
-value formatter (Full.Object x) = objectValue formatter x
+value formatter (Object x) = objectValue formatter x
-fromConstValue :: Full.ConstValue -> Full.Value
+fromConstValue :: ConstValue -> Value
-fromConstValue (Full.ConstInt x) = Full.Int x
+fromConstValue (ConstInt x) = Int x
-fromConstValue (Full.ConstFloat x) = Full.Float x
+fromConstValue (ConstFloat x) = Float x
-fromConstValue (Full.ConstBoolean  x) = Full.Boolean x
+fromConstValue (ConstBoolean  x) = Boolean x
-fromConstValue Full.ConstNull = Full.Null
+fromConstValue ConstNull = Null
-fromConstValue (Full.ConstString string) = Full.String string
+fromConstValue (ConstString string) = String string
-fromConstValue (Full.ConstEnum x) = Full.Enum x
+fromConstValue (ConstEnum x) = Enum x
-fromConstValue (Full.ConstList x) = Full.List $ fromConstValue <$> x
+fromConstValue (ConstList x) = List $ fromConstValue <$> x
-fromConstValue (Full.ConstObject x) = Full.Object $ fromConstObjectField <$> x
+fromConstValue (ConstObject x) = Object $ fromConstObjectField <$> x
  where
-    fromConstObjectField Full.ObjectField{value = value', ..} =
+    fromConstObjectField (ObjectField key value') =
-        Full.ObjectField name (fromConstValue <$> value') location
+        ObjectField key $ fromConstValue value'
 booleanValue :: Bool -> Lazy.Text
 booleanValue True  = "true"
@ -233,12 +241,11 @@ quote :: Builder.Builder
 quote = Builder.singleton '\"'
 oneLine :: Text -> Builder
-oneLine string = quote <> Text.foldr merge quote string
+oneLine string = quote <> Text.foldr (mappend . escape) quote string
  where
    merge = mappend . Builder.fromString . Full.escape
 stringValue :: Formatter -> Text -> Lazy.Text
-stringValue Minified string = Builder.toLazyText $ oneLine string
+stringValue Minified string = Builder.toLazyText
    $ quote <> Text.foldr (mappend . escape) quote string
 stringValue (Pretty indentation) string =
  if hasEscaped string
  then stringValue Minified string
@ -266,10 +273,25 @@ stringValue (Pretty indentation) string =
            = Builder.fromLazyText (indent (indentation + 1))
            <> line' <> newline <> acc
-listValue :: Formatter -> [Full.Value] -> Lazy.Text
+escape :: Char -> Builder
 escape char'
    | char' == '\\' = Builder.fromString "\\\\"
    | char' == '\"' = Builder.fromString "\\\""
    | char' == '\b' = Builder.fromString "\\b"
    | char' == '\f' = Builder.fromString "\\f"
    | char' == '\n' = Builder.fromString "\\n"
    | char' == '\r' = Builder.fromString "\\r"
    | char' == '\t' = Builder.fromString "\\t"
    | 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 -> [Value] -> Lazy.Text
 listValue formatter = bracketsCommas formatter $ value formatter
-objectValue :: Formatter -> [Full.ObjectField Full.Value] -> Lazy.Text
+objectValue :: Formatter -> [ObjectField Value] -> Lazy.Text
 objectValue formatter = intercalate $ objectField formatter
  where
    intercalate f
@ -277,22 +299,22 @@ objectValue formatter = intercalate $ objectField formatter
        . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
        . fmap f
-objectField :: Formatter -> Full.ObjectField Full.Value -> Lazy.Text
+objectField :: Formatter -> ObjectField Value -> Lazy.Text
-objectField formatter (Full.ObjectField name (Full.Node value' _) _) =
+objectField formatter (ObjectField name value') =
    Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
-- | Converts a 'Full.Type' a type into a string.
+-- | Converts a 'Type' a type into a string.
-type' :: Full.Type -> Lazy.Text
+type' :: Type -> Lazy.Text
-type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
+type' (TypeNamed   x) = Lazy.Text.fromStrict x
-type' (Full.TypeList x) = listType x
+type' (TypeList    x) = listType x
-type' (Full.TypeNonNull x) = nonNullType x
+type' (TypeNonNull x) = nonNullType x
-listType :: Full.Type -> Lazy.Text
+listType :: Type -> Lazy.Text
 listType x = brackets (type' x)
-nonNullType :: Full.NonNullType -> Lazy.Text
+nonNullType :: NonNullType -> Lazy.Text
-nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
+nonNullType (NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
-nonNullType (Full.NonNullTypeList x) = listType x <> "!"
+nonNullType (NonNullTypeList  x) = listType x <> "!"
 -- * Internal
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@ -92,16 +92,16 @@ dollar :: Parser T.Text
 dollar = symbol "$"
 -- | Parser for "@".
-at :: Parser ()
+at :: Parser Text
-at = symbol "@" >> pure ()
+at = symbol "@"
 -- | Parser for "&".
 amp :: Parser T.Text
 amp = symbol "&"
 -- | Parser for ":".
-colon :: Parser ()
+colon :: Parser T.Text
-colon = symbol ":" >> pure ()
+colon = symbol ":"
 -- | Parser for "=".
 equals :: Parser T.Text
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@ -1,4 +1,3 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@ -19,11 +18,10 @@ import Language.GraphQL.AST.DirectiveLocation
    , ExecutableDirectiveLocation
    , TypeSystemDirectiveLocation
    )
-import qualified Language.GraphQL.AST.Document as Full
+import Language.GraphQL.AST.Document
 import Language.GraphQL.AST.Lexer
 import Text.Megaparsec
-    ( MonadParsec(..)
+    ( SourcePos(..)
    , SourcePos(..)
    , getSourcePos
    , lookAhead
    , option
@ -33,55 +31,59 @@ import Text.Megaparsec
    )
 -- | Parser for the GraphQL documents.
-document :: Parser Full.Document
+document :: Parser Document
 document = unicodeBOM
    *> spaceConsumer
    *> lexeme (NonEmpty.some definition)
-definition :: Parser Full.Definition
+definition :: Parser Definition
-definition = Full.ExecutableDefinition <$> executableDefinition
+definition = executableDefinition'
    <|> typeSystemDefinition'
    <|> typeSystemExtension'
    <?> "Definition"
  where
    executableDefinition' = do
        location <- getLocation
        definition' <- executableDefinition
        pure $ ExecutableDefinition definition' location
    typeSystemDefinition' = do
        location <- getLocation
        definition' <- typeSystemDefinition
-        pure $ Full.TypeSystemDefinition definition' location
+        pure $ TypeSystemDefinition definition' location
    typeSystemExtension' = do
        location <- getLocation
        definition' <- typeSystemExtension
-        pure $ Full.TypeSystemExtension definition' location
+        pure $ TypeSystemExtension definition' location
-getLocation :: Parser Full.Location
+getLocation :: Parser Location
 getLocation = fromSourcePosition <$> getSourcePos
  where
    fromSourcePosition SourcePos{..} =
-        Full.Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
+        Location (wordFromPosition sourceLine) (wordFromPosition sourceColumn)
    wordFromPosition = fromIntegral . unPos
-executableDefinition :: Parser Full.ExecutableDefinition
+executableDefinition :: Parser ExecutableDefinition
-executableDefinition = Full.DefinitionOperation <$> operationDefinition
+executableDefinition = DefinitionOperation <$> operationDefinition
-    <|> Full.DefinitionFragment  <$> fragmentDefinition
+    <|> DefinitionFragment  <$> fragmentDefinition
    <?> "ExecutableDefinition"
-typeSystemDefinition :: Parser Full.TypeSystemDefinition
+typeSystemDefinition :: Parser TypeSystemDefinition
 typeSystemDefinition = schemaDefinition
    <|> typeSystemDefinitionWithDescription
    <?> "TypeSystemDefinition"
  where
    typeSystemDefinitionWithDescription = description
        >>= liftA2 (<|>) typeDefinition' directiveDefinition
-    typeDefinition' description' = Full.TypeDefinition
+    typeDefinition' description' = TypeDefinition
        <$> typeDefinition description'
-typeSystemExtension :: Parser Full.TypeSystemExtension
+typeSystemExtension :: Parser TypeSystemExtension
-typeSystemExtension = Full.SchemaExtension <$> schemaExtension
+typeSystemExtension = SchemaExtension <$> schemaExtension
-    <|> Full.TypeExtension <$> typeExtension
+    <|> TypeExtension <$> typeExtension
    <?> "TypeSystemExtension"
-directiveDefinition :: Full.Description -> Parser Full.TypeSystemDefinition
+directiveDefinition :: Description -> Parser TypeSystemDefinition
-directiveDefinition description' = Full.DirectiveDefinition description'
+directiveDefinition description' = DirectiveDefinition description'
    <$ symbol "directive"
    <* at
    <*> name
@ -125,7 +127,7 @@ typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
    <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
    <?> "TypeSystemDirectiveLocation"
-typeDefinition :: Full.Description -> Parser Full.TypeDefinition
+typeDefinition :: Description -> Parser TypeDefinition
 typeDefinition description' = scalarTypeDefinition description'
    <|> objectTypeDefinition description'
    <|> interfaceTypeDefinition description'
@ -134,7 +136,7 @@ typeDefinition description' = scalarTypeDefinition description'
    <|> inputObjectTypeDefinition description'
    <?> "TypeDefinition"
-typeExtension :: Parser Full.TypeExtension
+typeExtension :: Parser TypeExtension
 typeExtension = scalarTypeExtension
    <|> objectTypeExtension
    <|> interfaceTypeExtension
@ -143,143 +145,143 @@ typeExtension = scalarTypeExtension
    <|> inputObjectTypeExtension
    <?> "TypeExtension"
-scalarTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+scalarTypeDefinition :: Description -> Parser TypeDefinition
-scalarTypeDefinition description' = Full.ScalarTypeDefinition description'
+scalarTypeDefinition description' = ScalarTypeDefinition description'
    <$ symbol "scalar"
    <*> name
    <*> directives
    <?> "ScalarTypeDefinition"
-scalarTypeExtension :: Parser Full.TypeExtension
+scalarTypeExtension :: Parser TypeExtension
 scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
-    $ (Full.ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
+    $ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
-objectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+objectTypeDefinition :: Description -> Parser TypeDefinition
-objectTypeDefinition description' = Full.ObjectTypeDefinition description'
+objectTypeDefinition description' = ObjectTypeDefinition description'
    <$ symbol "type"
    <*> name
-    <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
+    <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "ObjectTypeDefinition"
-objectTypeExtension :: Parser Full.TypeExtension
+objectTypeExtension :: Parser TypeExtension
 objectTypeExtension = extend "type" "ObjectTypeExtension"
    $ fieldsDefinitionExtension :|
        [ directivesExtension
        , implementsInterfacesExtension
        ]
  where
-    fieldsDefinitionExtension = Full.ObjectTypeFieldsDefinitionExtension
+    fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension
        <$> name
-        <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
+        <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
-    directivesExtension = Full.ObjectTypeDirectivesExtension
+    directivesExtension = ObjectTypeDirectivesExtension
        <$> name
-        <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
+        <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> NonEmpty.some directive
-    implementsInterfacesExtension = Full.ObjectTypeImplementsInterfacesExtension
+    implementsInterfacesExtension = ObjectTypeImplementsInterfacesExtension
        <$> name
        <*> implementsInterfaces NonEmpty.sepBy1
-description :: Parser Full.Description
+description :: Parser Description
-description = Full.Description
+description = Description
    <$> optional stringValue
    <?> "Description"
-unionTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+unionTypeDefinition :: Description -> Parser TypeDefinition
-unionTypeDefinition description' = Full.UnionTypeDefinition description'
+unionTypeDefinition description' = UnionTypeDefinition description'
    <$ symbol "union"
    <*> name
    <*> directives
-    <*> option (Full.UnionMemberTypes []) (unionMemberTypes sepBy1)
+    <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1)
    <?> "UnionTypeDefinition"
-unionTypeExtension :: Parser Full.TypeExtension
+unionTypeExtension :: Parser TypeExtension
 unionTypeExtension = extend "union" "UnionTypeExtension"
    $ unionMemberTypesExtension :| [directivesExtension]
  where
-    unionMemberTypesExtension = Full.UnionTypeUnionMemberTypesExtension
+    unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension
        <$> name
        <*> directives
        <*> unionMemberTypes NonEmpty.sepBy1
-    directivesExtension = Full.UnionTypeDirectivesExtension
+    directivesExtension = UnionTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 unionMemberTypes ::
    Foldable t =>
-    (Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
+    (Parser Text -> Parser Text -> Parser (t NamedType)) ->
-    Parser (Full.UnionMemberTypes t)
+    Parser (UnionMemberTypes t)
-unionMemberTypes sepBy' = Full.UnionMemberTypes
+unionMemberTypes sepBy' = UnionMemberTypes
    <$ equals
    <* optional pipe
    <*> name `sepBy'` pipe
    <?> "UnionMemberTypes"
-interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+interfaceTypeDefinition :: Description -> Parser TypeDefinition
-interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
+interfaceTypeDefinition description' = InterfaceTypeDefinition description'
    <$ symbol "interface"
    <*> name
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "InterfaceTypeDefinition"
-interfaceTypeExtension :: Parser Full.TypeExtension
+interfaceTypeExtension :: Parser TypeExtension
 interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
    $ fieldsDefinitionExtension :| [directivesExtension]
  where
-    fieldsDefinitionExtension = Full.InterfaceTypeFieldsDefinitionExtension
+    fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
-    directivesExtension = Full.InterfaceTypeDirectivesExtension
+    directivesExtension = InterfaceTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
-enumTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+enumTypeDefinition :: Description -> Parser TypeDefinition
-enumTypeDefinition description' = Full.EnumTypeDefinition description'
+enumTypeDefinition description' = EnumTypeDefinition description'
    <$ symbol "enum"
    <*> name
    <*> directives
    <*> listOptIn braces enumValueDefinition
    <?> "EnumTypeDefinition"
-enumTypeExtension :: Parser Full.TypeExtension
+enumTypeExtension :: Parser TypeExtension
 enumTypeExtension = extend "enum" "EnumTypeExtension"
    $ enumValuesDefinitionExtension :| [directivesExtension]
  where
-    enumValuesDefinitionExtension = Full.EnumTypeEnumValuesDefinitionExtension
+    enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some enumValueDefinition)
-    directivesExtension = Full.EnumTypeDirectivesExtension
+    directivesExtension = EnumTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
-inputObjectTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
+inputObjectTypeDefinition :: Description -> Parser TypeDefinition
-inputObjectTypeDefinition description' = Full.InputObjectTypeDefinition description'
+inputObjectTypeDefinition description' = InputObjectTypeDefinition description'
    <$ symbol "input"
    <*> name
    <*> directives
    <*> listOptIn braces inputValueDefinition
    <?> "InputObjectTypeDefinition"
-inputObjectTypeExtension :: Parser Full.TypeExtension
+inputObjectTypeExtension :: Parser TypeExtension
 inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
    $ inputFieldsDefinitionExtension :| [directivesExtension]
  where
-    inputFieldsDefinitionExtension = Full.InputObjectTypeInputFieldsDefinitionExtension
+    inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some inputValueDefinition)
-    directivesExtension = Full.InputObjectTypeDirectivesExtension
+    directivesExtension = InputObjectTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
-enumValueDefinition :: Parser Full.EnumValueDefinition
+enumValueDefinition :: Parser EnumValueDefinition
-enumValueDefinition = Full.EnumValueDefinition
+enumValueDefinition = EnumValueDefinition
    <$> description
    <*> enumValue
    <*> directives
@ -287,16 +289,16 @@ enumValueDefinition = Full.EnumValueDefinition
 implementsInterfaces ::
    Foldable t =>
-    (Parser Text -> Parser Text -> Parser (t Full.NamedType)) ->
+    (Parser Text -> Parser Text -> Parser (t NamedType)) ->
-    Parser (Full.ImplementsInterfaces t)
+    Parser (ImplementsInterfaces t)
-implementsInterfaces sepBy' = Full.ImplementsInterfaces
+implementsInterfaces sepBy' = ImplementsInterfaces
    <$ symbol "implements"
    <* optional amp
    <*> name `sepBy'` amp
    <?> "ImplementsInterfaces"
-inputValueDefinition :: Parser Full.InputValueDefinition
+inputValueDefinition :: Parser InputValueDefinition
-inputValueDefinition = Full.InputValueDefinition
+inputValueDefinition = InputValueDefinition
    <$> description
    <*> name
    <* colon
@ -305,13 +307,13 @@ inputValueDefinition = Full.InputValueDefinition
    <*> directives
    <?> "InputValueDefinition"
-argumentsDefinition :: Parser Full.ArgumentsDefinition
+argumentsDefinition :: Parser ArgumentsDefinition
-argumentsDefinition = Full.ArgumentsDefinition
+argumentsDefinition = ArgumentsDefinition
    <$> listOptIn parens inputValueDefinition
    <?> "ArgumentsDefinition"
-fieldDefinition :: Parser Full.FieldDefinition
+fieldDefinition :: Parser FieldDefinition
-fieldDefinition = Full.FieldDefinition
+fieldDefinition = FieldDefinition
    <$> description
    <*> name
    <*> argumentsDefinition
@ -320,159 +322,131 @@ fieldDefinition = Full.FieldDefinition
    <*> directives
    <?> "FieldDefinition"
-schemaDefinition :: Parser Full.TypeSystemDefinition
+schemaDefinition :: Parser TypeSystemDefinition
-schemaDefinition = Full.SchemaDefinition
+schemaDefinition = SchemaDefinition
    <$ symbol "schema"
    <*> directives
    <*> operationTypeDefinitions
    <?> "SchemaDefinition"
-operationTypeDefinitions :: Parser (NonEmpty Full.OperationTypeDefinition)
+operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition)
 operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
-schemaExtension :: Parser Full.SchemaExtension
+schemaExtension :: Parser SchemaExtension
 schemaExtension = extend "schema" "SchemaExtension"
    $ schemaOperationExtension :| [directivesExtension]
  where
-    directivesExtension = Full.SchemaDirectivesExtension
+    directivesExtension = SchemaDirectivesExtension
        <$> NonEmpty.some directive
-    schemaOperationExtension = Full.SchemaOperationExtension
+    schemaOperationExtension = SchemaOperationExtension
        <$> directives
        <*> operationTypeDefinitions
-operationTypeDefinition :: Parser Full.OperationTypeDefinition
+operationTypeDefinition :: Parser OperationTypeDefinition
-operationTypeDefinition = Full.OperationTypeDefinition
+operationTypeDefinition = OperationTypeDefinition
    <$> operationType <* colon
    <*> name
    <?> "OperationTypeDefinition"
-operationDefinition :: Parser Full.OperationDefinition
+operationDefinition :: Parser OperationDefinition
-operationDefinition = shorthand
+operationDefinition = SelectionSet <$> selectionSet
    <|> operationDefinition'
    <?> "OperationDefinition"
  where
-    shorthand = do
+    operationDefinition'
-        location <- getLocation
+        = OperationDefinition <$> operationType
-        selectionSet' <- selectionSet
+        <*> optional name
-        pure $ Full.SelectionSet selectionSet' location
+        <*> variableDefinitions
-    operationDefinition' = do
+        <*> directives
-        location <- getLocation
+        <*> selectionSet
        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 :: Parser OperationType
-operationType = Full.Query <$ symbol "query"
+operationType = Query <$ symbol "query"
-    <|> Full.Mutation <$ symbol "mutation"
+    <|> Mutation <$ symbol "mutation"
-    <|> Full.Subscription <$ symbol "subscription"
+    <|> Subscription <$ symbol "subscription"
    <?> "OperationType"
-selectionSet :: Parser Full.SelectionSet
+selectionSet :: Parser SelectionSet
 selectionSet = braces (NonEmpty.some selection) <?> "SelectionSet"
-selectionSetOpt :: Parser Full.SelectionSetOpt
+selectionSetOpt :: Parser SelectionSetOpt
 selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
-selection :: Parser Full.Selection
+selection :: Parser Selection
-selection = Full.FieldSelection <$> field
+selection = field
-    <|> Full.FragmentSpreadSelection <$> try fragmentSpread
+    <|> try fragmentSpread
-    <|> Full.InlineFragmentSelection <$> inlineFragment
+    <|> inlineFragment
    <?> "Selection"
-field :: Parser Full.Field
+field :: Parser Selection
-field = label "Field" $ do
+field = Field
-    location <- getLocation
+    <$> optional alias
-    alias' <- optional alias
+    <*> name
-    name' <- name
+    <*> arguments
-    arguments' <- arguments
+    <*> directives
-    directives' <- directives
+    <*> selectionSetOpt
-    selectionSetOpt' <- selectionSetOpt
+    <?> "Field"
    pure $ Full.Field alias' name' arguments' directives' selectionSetOpt' location
-alias :: Parser Full.Name
+alias :: Parser Alias
 alias = try (name <* colon) <?> "Alias"
-arguments :: Parser [Full.Argument]
+arguments :: Parser [Argument]
 arguments = listOptIn parens argument <?> "Arguments"
-argument :: Parser Full.Argument
+argument :: Parser Argument
-argument = label "Argument" $ do
+argument = Argument <$> name <* colon <*> value <?> "Argument"
    location <- getLocation
    name' <- name
    colon
    value' <- valueNode value
    pure $ Full.Argument name' value' location
-fragmentSpread :: Parser Full.FragmentSpread
+fragmentSpread :: Parser Selection
-fragmentSpread = label "FragmentSpread" $ do
+fragmentSpread = FragmentSpread
-    location <- getLocation
+    <$ spread
-    _ <- spread
+    <*> fragmentName
-    fragmentName' <- fragmentName
+    <*> directives
-    directives' <- directives
+    <?> "FragmentSpread"
    pure $ Full.FragmentSpread fragmentName' directives' location
-inlineFragment :: Parser Full.InlineFragment
+inlineFragment :: Parser Selection
-inlineFragment = label "InlineFragment" $ do
+inlineFragment = InlineFragment
-    location <- getLocation
+    <$ spread
-    _ <- spread
+    <*> optional typeCondition
-    typeCondition' <- optional typeCondition
+    <*> directives
-    directives' <- directives
+    <*> selectionSet
-    selectionSet' <- selectionSet
+    <?> "InlineFragment"
    pure $ Full.InlineFragment typeCondition' directives' selectionSet' location
-fragmentDefinition :: Parser Full.FragmentDefinition
+fragmentDefinition :: Parser FragmentDefinition
-fragmentDefinition =  label "FragmentDefinition" $ do
+fragmentDefinition = FragmentDefinition
-    location <- getLocation
+    <$  symbol "fragment"
-    _ <- symbol "fragment"
+    <*> name
-    fragmentName' <- name
+    <*> typeCondition
-    typeCondition' <- typeCondition
+    <*> directives
-    directives' <- directives
+    <*> selectionSet
-    selectionSet' <- selectionSet
+    <?> "FragmentDefinition"
    pure $ Full.FragmentDefinition
        fragmentName' typeCondition' directives' selectionSet' location
-fragmentName :: Parser Full.Name
+fragmentName :: Parser Name
 fragmentName = but (symbol "on") *> name <?> "FragmentName"
-typeCondition :: Parser Full.TypeCondition
+typeCondition :: Parser TypeCondition
 typeCondition = symbol "on" *> name <?> "TypeCondition"
-valueNode :: forall a. Parser a -> Parser (Full.Node a)
+value :: Parser Value
-valueNode valueParser = do
+value = Variable <$> variable
-    location <- getLocation
+    <|> Float <$> try float
-    value' <- valueParser
+    <|> Int <$> integer
-    pure $ Full.Node value' location
+    <|> Boolean <$> booleanValue
-
+    <|> Null <$  nullValue
-value :: Parser Full.Value
+    <|> String <$> stringValue
-value = Full.Variable <$> variable
+    <|> Enum <$> try enumValue
-    <|> Full.Float <$> try float
+    <|> List <$> brackets (some value)
-    <|> Full.Int <$> integer
+    <|> Object <$> braces (some $ objectField value)
    <|> Full.Boolean <$> booleanValue
    <|> Full.Null <$  nullValue
    <|> Full.String <$> stringValue
    <|> Full.Enum <$> try enumValue
    <|> Full.List <$> brackets (some value)
    <|> Full.Object <$> braces (some $ objectField $ valueNode value)
    <?> "Value"
-constValue :: Parser Full.ConstValue
+constValue :: Parser ConstValue
-constValue = Full.ConstFloat <$> try float
+constValue = ConstFloat <$> try float
-    <|> Full.ConstInt <$> integer
+    <|> ConstInt <$> integer
-    <|> Full.ConstBoolean <$> booleanValue
+    <|> ConstBoolean <$> booleanValue
-    <|> Full.ConstNull <$ nullValue
+    <|> ConstNull <$ nullValue
-    <|> Full.ConstString <$> stringValue
+    <|> ConstString <$> stringValue
-    <|> Full.ConstEnum <$> try enumValue
+    <|> ConstEnum <$> try enumValue
-    <|> Full.ConstList <$> brackets (some constValue)
+    <|> ConstList <$> brackets (some constValue)
-    <|> Full.ConstObject <$> braces (some $ objectField $ valueNode constValue)
+    <|> ConstObject <$> braces (some $ objectField constValue)
    <?> "Value"
 booleanValue :: Parser Bool
@ -480,7 +454,7 @@ booleanValue = True  <$ symbol "true"
    <|> False <$ symbol "false"
    <?> "BooleanValue"
-enumValue :: Parser Full.Name
+enumValue :: Parser Name
 enumValue = but (symbol "true")
    *> but (symbol "false")
    *> but (symbol "null")
@ -493,54 +467,51 @@ stringValue = blockString <|> string <?> "StringValue"
 nullValue :: Parser Text
 nullValue = symbol "null" <?> "NullValue"
-objectField :: forall a. Parser (Full.Node a) -> Parser (Full.ObjectField a)
+objectField :: Parser a -> Parser (ObjectField a)
-objectField valueParser = label "ObjectField" $ do
+objectField valueParser = ObjectField
-    location <- getLocation
+    <$> name
-    fieldName <- name
+    <* colon
-    colon
+    <*> valueParser
-    fieldValue <- valueParser
+    <?> "ObjectField"
    pure $ Full.ObjectField fieldName fieldValue location
-variableDefinitions :: Parser [Full.VariableDefinition]
+variableDefinitions :: Parser [VariableDefinition]
 variableDefinitions = listOptIn parens variableDefinition
    <?> "VariableDefinitions"
-variableDefinition :: Parser Full.VariableDefinition
+variableDefinition :: Parser VariableDefinition
-variableDefinition = label "VariableDefinition" $ do
+variableDefinition = VariableDefinition
-    location <- getLocation
+    <$> variable
-    variableName <- variable
+    <*  colon
-    colon
+    <*> type'
-    variableType <- type'
+    <*> defaultValue
-    variableValue <- defaultValue
+    <?> "VariableDefinition"
    pure $ Full.VariableDefinition variableName variableType variableValue location
-variable :: Parser Full.Name
+variable :: Parser Name
 variable = dollar *> name <?> "Variable"
-defaultValue :: Parser (Maybe (Full.Node Full.ConstValue))
+defaultValue :: Parser (Maybe ConstValue)
-defaultValue = optional (equals *> valueNode constValue) <?> "DefaultValue"
+defaultValue = optional (equals *> constValue) <?> "DefaultValue"
-type' :: Parser Full.Type
+type' :: Parser Type
-type' = try (Full.TypeNonNull <$> nonNullType)
+type' = try (TypeNonNull <$> nonNullType)
-    <|> Full.TypeList <$> brackets type'
+    <|> TypeList <$> brackets type'
-    <|> Full.TypeNamed <$> name
+    <|> TypeNamed <$> name
    <?> "Type"
-nonNullType :: Parser Full.NonNullType
+nonNullType :: Parser NonNullType
-nonNullType = Full.NonNullTypeNamed <$> name <* bang
+nonNullType = NonNullTypeNamed <$> name <* bang
-    <|> Full.NonNullTypeList  <$> brackets type'  <* bang
+    <|> NonNullTypeList  <$> brackets type'  <* bang
    <?> "NonNullType"
-directives :: Parser [Full.Directive]
+directives :: Parser [Directive]
 directives = many directive <?> "Directives"
-directive :: Parser Full.Directive
+directive :: Parser Directive
-directive = label "Directive" $ do
+directive = Directive
-    location <- getLocation
+    <$  at
-    at
+    <*> name
-    directiveName <- name
+    <*> arguments
-    directiveArguments <- arguments
+    <?> "Directive"
    pure $ Full.Directive directiveName directiveArguments location
 listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
 listOptIn surround = option [] . surround . some
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -5,16 +5,15 @@
 -- | Error handling.
 module Language.GraphQL.Error
-    ( CollectErrsT
+    ( parseError
    , CollectErrsT
    , Error(..)
    , Path(..)
    , Resolution(..)
    , ResolverException(..)
    , Response(..)
    , ResponseEventStream
    , addErr
    , addErrMsg
    , parseError
    , runCollectErrs
    , singleError
    ) where
@ -29,7 +28,7 @@ import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST (Location(..), Name)
 import Language.GraphQL.Execute.Coerce
-import qualified Language.GraphQL.Type.Schema as Schema
+import Language.GraphQL.Type.Schema
 import Prelude hiding (null)
 import Text.Megaparsec
    ( ParseErrorBundle(..)
@ -44,7 +43,7 @@ import Text.Megaparsec
 -- | Executor context.
 data Resolution m = Resolution
    { errors :: Seq Error
-    , types :: HashMap Name (Schema.Type m)
+    , types :: HashMap Name (Type m)
    }
 -- | Wraps a parse error into a list of errors.
@ -58,7 +57,6 @@ parseError ParseErrorBundle{..}  =
    errorObject s SourcePos{..} = Error
        { message = Text.pack $ init $ parseErrorTextPretty s
        , locations = [Location (unPos' sourceLine) (unPos' sourceColumn)]
        , path = []
        }
    unPos' = fromIntegral . unPos
    go (result, state) x =
@ -77,7 +75,7 @@ addErr v = modify appender
    appender resolution@Resolution{..} = resolution{ errors = errors |> v }
 makeErrorMessage :: Text -> Error
-makeErrorMessage s = Error s [] []
+makeErrorMessage s = Error s []
 -- | Constructs a response object containing only the error with the given
 -- message.
@ -88,20 +86,10 @@ singleError message = Response null $ Seq.singleton $ makeErrorMessage message
 addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a
 addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null
 -- | If an error can be associated to a particular field in the GraphQL result,
 -- it must contain an entry with the key path that details the path of the
 -- response field which experienced the error. This allows clients to identify
 -- whether a null result is intentional or caused by a runtime error.
 data Path
    = Segment Text -- ^ Field name.
    | Index Int -- ^ List index if a field returned a list.
    deriving (Eq, Show)
 -- | @GraphQL@ error.
 data Error = Error
    { message :: Text
    , locations :: [Location]
    , path :: [Path]
    } deriving (Eq, Show)
 -- | The server\'s response describes the result of executing the requested
@ -129,7 +117,7 @@ instance Exception ResolverException
 -- | Runs the given query computation, but collects the errors into an error
 -- list, which is then sent back with the data.
 runCollectErrs :: (Monad m, Serialize a)
-    => HashMap Name (Schema.Type m)
+    => HashMap Name (Type m)
    -> CollectErrsT m a
    -> m (Response a)
 runCollectErrs types' res = do
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -32,8 +32,8 @@ execute :: (MonadCatch m, VariableValue a, Serialize b)
    -> HashMap Name a -- ^ Variable substitution function.
    -> Document -- @GraphQL@ document.
    -> m (Either (ResponseEventStream m b) (Response b))
-execute schema' operationName subs document =
+execute schema operationName subs document =
-    case Transform.document schema' operationName subs document of
+    case Transform.document schema operationName subs document of
        Left queryError -> pure
            $ Right
            $ singleError
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@ -1,7 +1,3 @@
 {- 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 #-}
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@ -27,7 +27,8 @@ import qualified Language.GraphQL.Execute.Transform as Transform
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
-import qualified Language.GraphQL.Type.Internal as Internal
+import Language.GraphQL.Type.Internal
 import Language.GraphQL.Type.Schema
 import Prelude hiding (null)
 resolveFieldValue :: MonadCatch m
@ -42,7 +43,7 @@ resolveFieldValue result args resolver =
        => ResolverException
        -> CollectErrsT m Type.Value
    handleFieldError e =
-        addErr (Error (Text.pack $ displayException e) [] []) >> pure Type.Null
+        addErr (Error (Text.pack $ displayException e) []) >> pure Type.Null
    context = Type.Context
        { Type.arguments = Type.Arguments args
        , Type.values = result
@ -59,7 +60,7 @@ collectFields objectType = foldl forEach Map.empty
         in Map.insertWith (<>) responseKey (field :| []) groupedFields
    forEach groupedFields (Transform.SelectionFragment selectionFragment)
        | Transform.Fragment fragmentType fragmentSelectionSet <- selectionFragment
-        , Internal.doesFragmentTypeApply fragmentType objectType =
+        , doesFragmentTypeApply fragmentType objectType =
            let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
             in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
        | otherwise = groupedFields
@ -68,20 +69,44 @@ aliasOrName :: forall m. Transform.Field m -> Name
 aliasOrName (Transform.Field alias name _ _) = fromMaybe name alias
 resolveAbstractType :: Monad m
-    => Internal.AbstractType m
+    => AbstractType m
    -> Type.Subs
    -> CollectErrsT m (Maybe (Out.ObjectType m))
 resolveAbstractType abstractType values'
    | Just (Type.String typeName) <- HashMap.lookup "__typename" values' = do
        types' <- gets types
        case HashMap.lookup typeName types' of
-            Just (Internal.ObjectType objectType) ->
+            Just (ObjectType objectType) ->
-                if Internal.instanceOf objectType abstractType
+                if instanceOf objectType abstractType
                    then pure $ Just objectType
                    else pure Nothing
            _ -> pure Nothing
    | otherwise = pure Nothing
 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
 executeField :: (MonadCatch m, Serialize a)
    => Out.Resolver m
    -> Type.Value
@ -123,25 +148,25 @@ 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 addErrMsg "Enum value completion failed."
+        else addErrMsg "Value completion failed."
 completeValue (Out.ObjectBaseType objectType) fields result =
    executeSelectionSet result objectType $ mergeSelectionSets fields
 completeValue (Out.InterfaceBaseType interfaceType) fields result
    | Type.Object objectMap <- result = do
-        let abstractType = Internal.AbstractInterfaceType interfaceType
+        let abstractType = AbstractInterfaceType interfaceType
        concreteType <- resolveAbstractType abstractType objectMap
        case concreteType of
            Just objectType -> executeSelectionSet result objectType
                $ mergeSelectionSets fields
-            Nothing -> addErrMsg "Interface value completion failed."
+            Nothing -> addErrMsg "Value completion failed."
 completeValue (Out.UnionBaseType unionType) fields result
    | Type.Object objectMap <- result = do
-        let abstractType = Internal.AbstractUnionType unionType
+        let abstractType = AbstractUnionType unionType
        concreteType <- resolveAbstractType abstractType objectMap
        case concreteType of
            Just objectType -> executeSelectionSet result objectType
                $ mergeSelectionSets fields
-            Nothing -> addErrMsg "Union value completion failed."
+            Nothing -> addErrMsg "Value completion failed."
 completeValue _ _ _ = addErrMsg "Value completion failed."
 mergeSelectionSets :: MonadCatch m
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -47,23 +47,24 @@ import Language.GraphQL.AST (Name)
 import qualified Language.GraphQL.Execute.Coerce as Coerce
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type as Type
-import qualified Language.GraphQL.Type.Internal as Type
+import qualified Language.GraphQL.Type.In as In
 import Language.GraphQL.Type.Internal
 import qualified Language.GraphQL.Type.Out as Out
-import qualified Language.GraphQL.Type.Schema as Schema
+import Language.GraphQL.Type.Schema
 -- | Associates a fragment name with a list of 'Field's.
 data Replacement m = Replacement
    { fragments :: HashMap Full.Name (Fragment m)
    , fragmentDefinitions :: FragmentDefinitions
    , variableValues :: Type.Subs
-    , types :: HashMap Full.Name (Schema.Type m)
+    , types :: HashMap Full.Name (Type m)
    }
 type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition
 -- | Represents fragments and inline fragments.
 data Fragment m
-    = Fragment (Type.CompositeType m) (Seq (Selection m))
+    = Fragment (CompositeType m) (Seq (Selection m))
 -- | Single selection element.
 data Selection m
@ -84,7 +85,7 @@ data Field m = Field
 -- | Contains the operation to be executed along with its root type.
 data Document m = Document
-    (HashMap Full.Name (Schema.Type m)) (Out.ObjectType m) (Operation m)
+    (HashMap Full.Name (Type m)) (Out.ObjectType m) (Operation m)
 data OperationDefinition = OperationDefinition
    Full.OperationType
@ -138,9 +139,38 @@ getOperation (Just operationName) operations
    matchingName (OperationDefinition _ name _ _ _) =
        name == Just operationName
 lookupInputType
    :: Full.Type
    -> HashMap.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
 coerceVariableValues :: Coerce.VariableValue a
    => forall m
-    . HashMap Full.Name (Schema.Type m)
+    . HashMap Full.Name (Type m)
    -> OperationDefinition
    -> HashMap.HashMap Full.Name a
    -> Either QueryError Type.Subs
@ -150,10 +180,10 @@ coerceVariableValues types operationDefinition variableValues =
        $ foldr forEach (Just HashMap.empty) variableDefinitions
  where
    forEach variableDefinition coercedValues = do
-        let Full.VariableDefinition variableName variableTypeName defaultValue _ =
+        let Full.VariableDefinition variableName variableTypeName defaultValue =
                variableDefinition
-        let defaultValue' = constValue . Full.node <$> defaultValue
+        let defaultValue' = constValue <$> defaultValue
-        variableType <- Type.lookupInputType variableTypeName types
+        variableType <- lookupInputType variableTypeName types
        Coerce.matchFieldValues
            coerceVariableValue'
@ -177,20 +207,19 @@ constValue (Full.ConstList l) = Type.List $ constValue <$> l
 constValue (Full.ConstObject o) =
    Type.Object $ HashMap.fromList $ constObjectField <$> o
  where
-    constObjectField Full.ObjectField{value = value', ..} =
+    constObjectField (Full.ObjectField key value') = (key, constValue value')
        (name, constValue $ Full.node value')
 -- | Rewrites the original syntax tree into an intermediate representation used
 -- for query execution.
 document :: Coerce.VariableValue a
    => forall m
-    . Type.Schema m
+    . Schema m
    -> Maybe Full.Name
    -> HashMap Full.Name a
    -> Full.Document
    -> Either QueryError (Document m)
 document schema operationName subs ast = do
-    let referencedTypes = Schema.types schema
+    let referencedTypes = collectReferencedTypes schema
    (operations, fragmentTable) <- defragment ast
    chosenOperation <- getOperation operationName operations
@ -204,14 +233,14 @@ document schema operationName subs ast = do
            }
    case chosenOperation of
        OperationDefinition Full.Query _ _ _ _ ->
-            pure $ Document referencedTypes (Schema.query schema)
+            pure $ Document referencedTypes (query schema)
                $ operation chosenOperation replacement
        OperationDefinition Full.Mutation _ _ _ _
-            | Just mutationType <- Schema.mutation schema ->
+            | Just mutationType <- mutation schema ->
                pure $ Document referencedTypes mutationType
                    $ operation chosenOperation replacement
        OperationDefinition Full.Subscription _ _ _ _
-            | Just subscriptionType <- Schema.subscription schema ->
+            | Just subscriptionType <- subscription schema ->
                pure $ Document referencedTypes subscriptionType
                    $ operation chosenOperation replacement
        _ -> Left UnsupportedRootOperation
@ -226,18 +255,18 @@ defragment ast =
     in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations
  where
    defragment' definition (operations, fragments')
-        | (Full.ExecutableDefinition executable) <- definition
+        | (Full.ExecutableDefinition executable _) <- definition
        , (Full.DefinitionOperation operation') <- executable =
            (transform operation' : operations, fragments')
-        | (Full.ExecutableDefinition executable) <- definition
+        | (Full.ExecutableDefinition executable _) <- definition
        , (Full.DefinitionFragment fragment) <- executable
-        , (Full.FragmentDefinition name _ _ _ _) <- fragment =
+        , (Full.FragmentDefinition name _ _ _) <- fragment =
            (operations, HashMap.insert name fragment fragments')
    defragment' _ acc = acc
    transform = \case
-        Full.OperationDefinition type' name variables directives' selections _ ->
+        Full.OperationDefinition type' name variables directives' selections ->
            OperationDefinition type' name variables directives' selections
-        Full.SelectionSet selectionSet _ ->
+        Full.SelectionSet selectionSet ->
            OperationDefinition Full.Query Nothing mempty mempty selectionSet
 -- * Operation
@ -259,47 +288,33 @@ operation operationDefinition replacement
 selection
    :: Full.Selection
    ->  State (Replacement m) (Either (Seq (Selection m)) (Selection m))
-selection (Full.FieldSelection fieldSelection) =
+selection (Full.Field alias name arguments' directives' selections) =
-    maybe (Left mempty) (Right . SelectionField) <$> field fieldSelection
+    maybe (Left mempty) (Right . SelectionField) <$> do
-selection (Full.FragmentSpreadSelection fragmentSelection)
+        fieldArguments <- foldM go HashMap.empty arguments'
-    = maybe (Left mempty) (Right . SelectionFragment)
+        fieldSelections <- appendSelection selections
-    <$> fragmentSpread fragmentSelection
+        fieldDirectives <- Definition.selection <$> directives directives'
-selection (Full.InlineFragmentSelection fragmentSelection) =
+        let field' = Field alias name fieldArguments fieldSelections
-    inlineFragment fragmentSelection
+        pure $ field' <$ fieldDirectives
 field :: Full.Field ->  State (Replacement m) (Maybe (Field m))
 field (Full.Field alias name arguments' directives' selections _) = do
    fieldArguments <- foldM go HashMap.empty arguments'
    fieldSelections <- appendSelection selections
    fieldDirectives <- Definition.selection <$> directives directives'
    let field' = Field alias name fieldArguments fieldSelections
    pure $ field' <$ fieldDirectives
  where
-    go arguments (Full.Argument name' (Full.Node value' _) _) =
+    go arguments (Full.Argument name' value') =
        inputField arguments name' value'
-fragmentSpread
+selection (Full.FragmentSpread name directives') =
-    :: Full.FragmentSpread
+    maybe (Left mempty) (Right . SelectionFragment) <$> do
-    -> State (Replacement m) (Maybe (Fragment m))
+        spreadDirectives <- Definition.selection <$> directives directives'
-fragmentSpread (Full.FragmentSpread name directives' _) = do
+        fragments' <- gets fragments
    spreadDirectives <- Definition.selection <$> directives directives'
    fragments' <- gets fragments
-    fragmentDefinitions' <- gets fragmentDefinitions
+        fragmentDefinitions' <- gets fragmentDefinitions
-    case HashMap.lookup name fragments' of
+        case HashMap.lookup name fragments' of
-        Just definition -> lift $ pure $ definition <$ spreadDirectives
+            Just definition -> lift $ pure $ definition <$ spreadDirectives
-        Nothing
+            Nothing
-            | Just definition <- HashMap.lookup name fragmentDefinitions' -> do
+                | Just definition <- HashMap.lookup name fragmentDefinitions' -> do
-                fragDef <- fragmentDefinition definition
+                    fragDef <- fragmentDefinition definition
-                case fragDef of
+                    case fragDef of
-                    Just fragment -> lift $ pure $ fragment <$ spreadDirectives
+                        Just fragment -> lift $ pure $ fragment <$ spreadDirectives
-                    _ -> lift $ pure  Nothing
+                        _ -> lift $ pure  Nothing
-            | otherwise -> lift $ pure  Nothing
+                | otherwise -> lift $ pure  Nothing
-
+selection (Full.InlineFragment type' directives' selections) = do
 inlineFragment
    :: Full.InlineFragment
    ->  State (Replacement m) (Either (Seq (Selection m)) (Selection m))
 inlineFragment (Full.InlineFragment type' directives' selections _) = do
    fragmentDirectives <- Definition.selection <$> directives directives'
    case fragmentDirectives of
        Nothing -> pure $ Left mempty
@ -309,8 +324,8 @@ inlineFragment (Full.InlineFragment type' directives' selections _) = do
            case type' of
                Nothing -> pure $ Left fragmentSelectionSet
                Just typeName -> do
-                    types' <- gets types
+                    typeCondition' <- lookupTypeCondition typeName
-                    case Type.lookupTypeCondition typeName types' of
+                    case typeCondition' of
                        Just typeCondition -> pure $
                            selectionFragment typeCondition fragmentSelectionSet
                        Nothing -> pure $ Left mempty
@ -331,10 +346,10 @@ appendSelection = foldM go mempty
 directives :: [Full.Directive] ->  State (Replacement m) [Definition.Directive]
 directives = traverse directive
  where
-    directive (Full.Directive directiveName directiveArguments _)
+    directive (Full.Directive directiveName directiveArguments)
        = Definition.Directive directiveName . Type.Arguments
        <$> foldM go HashMap.empty directiveArguments
-    go arguments (Full.Argument name (Full.Node value' _) _) = do
+    go arguments (Full.Argument name value') = do
        substitutedValue <- value value'
        return $ HashMap.insert name substitutedValue arguments
@ -349,17 +364,29 @@ collectFragments = do
        _ <- fragmentDefinition nextValue
        collectFragments
 lookupTypeCondition :: Full.Name -> State (Replacement m) (Maybe (CompositeType m))
 lookupTypeCondition type' = do
    types' <- gets types
    case HashMap.lookup type' types' of
        Just (ObjectType objectType) ->
            lift $ pure $ Just $ CompositeObjectType objectType
        Just (UnionType unionType) ->
            lift $ pure $ Just $ CompositeUnionType unionType
        Just (InterfaceType interfaceType) ->
            lift $ pure $ Just $ CompositeInterfaceType interfaceType
        _ -> lift $ pure Nothing
 fragmentDefinition
    :: Full.FragmentDefinition
    ->  State (Replacement m) (Maybe (Fragment m))
-fragmentDefinition (Full.FragmentDefinition name type' _ selections _) = do
+fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
    modify deleteFragmentDefinition
    fragmentSelection <- appendSelection selections
-    types' <- gets types
+    compositeType <- lookupTypeCondition type'
-    case Type.lookupTypeCondition type' types' of
+    case compositeType of
-        Just compositeType -> do
+        Just compositeType' -> do
-            let newValue = Fragment compositeType fragmentSelection
+            let newValue = Fragment compositeType' fragmentSelection
            modify $ insertFragment newValue
            lift $ pure $ Just newValue
        _ -> lift $ pure Nothing
@ -384,8 +411,7 @@ value (Full.List list) = Type.List <$> traverse value list
 value (Full.Object object) =
    Type.Object . HashMap.fromList <$> traverse objectField object
  where
-    objectField Full.ObjectField{value = value', ..} =
+    objectField (Full.ObjectField name value') = (name,) <$> value value'
        (name,) <$> value (Full.node value')
 input :: forall m. Full.Value -> State (Replacement m) (Maybe Input)
 input (Full.Variable name) =
@ -401,8 +427,8 @@ input (Full.Object object) = do
    objectFields <- foldM objectField HashMap.empty object
    pure $ pure $ Object objectFields
  where
-    objectField resultMap Full.ObjectField{value = value', ..} =
+    objectField resultMap (Full.ObjectField name value') =
-        inputField resultMap name $ Full.node value'
+        inputField resultMap name value'
 inputField :: forall m
    . HashMap Full.Name Input
--- a/src/Language/GraphQL/Type.hs
+++ b/src/Language/GraphQL/Type.hs
@ -21,6 +21,6 @@ module Language.GraphQL.Type
    ) where
 import Language.GraphQL.Type.Definition
-import Language.GraphQL.Type.Schema (Schema, schema)
+import Language.GraphQL.Type.Schema (Schema(..))
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@ -22,7 +22,6 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.String (IsString(..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST (Name)
 import Prelude hiding (id)
@ -64,9 +63,6 @@ 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
@ -77,9 +73,6 @@ 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)
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@ -1,7 +1,3 @@
 {- 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 ViewPatterns #-}
@ -11,7 +7,6 @@
 -- with 'Language.GraphQL.Type.Out'.
 module Language.GraphQL.Type.In
    ( Argument(..)
    , Arguments
    , InputField(..)
    , InputObjectType(..)
    , Type(..)
@ -24,12 +19,11 @@ module Language.GraphQL.Type.In
 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
+import Language.GraphQL.Type.Definition
 -- | Single field of an 'InputObjectType'.
-data InputField = InputField (Maybe Text) Type (Maybe Definition.Value)
+data InputField = InputField (Maybe Text) Type (Maybe Value)
 -- | Input object type definition.
 --
@ -41,47 +35,31 @@ data InputObjectType = InputObjectType
 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
+    = NamedScalarType ScalarType
-    | NamedEnumType Definition.EnumType
+    | NamedEnumType EnumType
    | NamedInputObjectType InputObjectType
    | ListType Type
-    | NonNullScalarType Definition.ScalarType
+    | NonNullScalarType ScalarType
-    | NonNullEnumType Definition.EnumType
+    | NonNullEnumType 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) = '!' : show scalarType
    show (NonNullEnumType enumType) = '!' : show enumType
    show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType
    show (NonNullListType baseType) = concat ["![", show baseType, "]"]
 -- | Field argument definition.
-data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)
+data Argument = Argument (Maybe Text) Type (Maybe Value)
 -- | Field argument definitions.
 type Arguments = HashMap Name Argument
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
-pattern ScalarBaseType :: Definition.ScalarType -> Type
+pattern ScalarBaseType :: ScalarType -> Type
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
 -- | Matches either 'NamedEnumType' or 'NonNullEnumType'.
-pattern EnumBaseType :: Definition.EnumType -> Type
+pattern EnumBaseType :: EnumType -> Type
 pattern EnumBaseType enumType <- (isEnumType -> Just enumType)
 -- | Matches either 'NamedInputObjectType' or 'NonNullInputObjectType'.
@ -94,7 +72,7 @@ pattern ListBaseType listType <- (isListType -> Just listType)
 {-# COMPLETE EnumBaseType, ListBaseType, InputObjectBaseType, ScalarBaseType #-}
-isScalarType :: Type -> Maybe Definition.ScalarType
+isScalarType :: Type -> Maybe ScalarType
 isScalarType (NamedScalarType inputType) = Just inputType
 isScalarType (NonNullScalarType inputType) = Just inputType
 isScalarType _ = Nothing
@ -104,7 +82,7 @@ isInputObjectType (NamedInputObjectType inputType) = Just inputType
 isInputObjectType (NonNullInputObjectType inputType) = Just inputType
 isInputObjectType _ = Nothing
-isEnumType :: Type -> Maybe Definition.EnumType
+isEnumType :: Type -> Maybe EnumType
 isEnumType (NamedEnumType inputType) = Just inputType
 isEnumType (NonNullEnumType inputType) = Just inputType
 isEnumType _ = Nothing
--- a/src/Language/GraphQL/Type/Internal.hs
+++ b/src/Language/GraphQL/Type/Internal.hs
@ -3,93 +3,20 @@
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE LambdaCase #-}
 module Language.GraphQL.Type.Internal
    ( AbstractType(..)
    , CompositeType(..)
-    , Directive(..)
+    , collectReferencedTypes
    , Directives
    , Schema(..)
    , Type(..)
    , 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 Language.GraphQL.AST (Name)
 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
-
+import Language.GraphQL.Type.Schema
 -- | 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.
 data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments
 -- | 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.
 --
 --   __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.
 data Schema m = Schema
    (Out.ObjectType m)
    (Maybe (Out.ObjectType m))
    (Maybe (Out.ObjectType m))
    Directives
    (HashMap Full.Name (Type m))
    (HashMap Full.Name [Type m])
 -- | 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
@ -104,94 +31,61 @@ data AbstractType m
    | AbstractInterfaceType (Out.InterfaceType m)
    deriving Eq
-doesFragmentTypeApply :: forall m
+-- | Traverses the schema and finds all referenced types.
-    . CompositeType m
+collectReferencedTypes :: forall m. Schema m -> HashMap Name (Type m)
-    -> Out.ObjectType m
+collectReferencedTypes schema =
-    -> Bool
+    let queryTypes = traverseObjectType (query schema) HashMap.empty
-doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
+     in maybe queryTypes (`traverseObjectType` queryTypes) $ mutation schema
    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 =
+    collect traverser typeName element foundTypes
-        acc || foldr go (interfaceType == objectInterfaceType) interfaces
+        | HashMap.member typeName foundTypes = foundTypes
-instanceOf objectType (AbstractUnionType unionType) =
+        | otherwise = traverser $ HashMap.insert typeName element foundTypes
-    let Out.UnionType _ _ members = unionType
+    visitFields (Out.Field _ outputType arguments) foundTypes
-     in foldr go False members
+        = traverseOutputType outputType
-  where
+        $ foldr visitArguments foundTypes arguments
-    go unionMemberType acc = acc || objectType == unionMemberType
+    visitArguments (In.Argument _ inputType _) = traverseInputType inputType
-
+    visitInputFields (In.InputField _ inputType _) = traverseInputType inputType
-lookupTypeCondition :: forall m
+    getField (Out.ValueResolver field _) = field
-    . Full.Name
+    getField (Out.EventStreamResolver field _ _) = field
-    -> HashMap Full.Name (Type m)
+    traverseInputType (In.InputObjectBaseType objectType) =
-    -> Maybe (CompositeType m)
+        let (In.InputObjectType typeName _ inputFields) = objectType
-lookupTypeCondition type' types' =
+            element = InputObjectType objectType
-    case HashMap.lookup type' types' of
+            traverser = flip (foldr visitInputFields) inputFields
-        Just (ObjectType objectType) ->
+         in collect traverser typeName element
-            Just $ CompositeObjectType objectType
+    traverseInputType (In.ListBaseType listType) =
-        Just (UnionType unionType) -> Just $ CompositeUnionType unionType
+        traverseInputType listType
-        Just (InterfaceType interfaceType) ->
+    traverseInputType (In.ScalarBaseType scalarType) =
-            Just $ CompositeInterfaceType interfaceType
+        let (Definition.ScalarType typeName _) = scalarType
-        _ -> Nothing
+         in collect Prelude.id typeName (ScalarType scalarType)
-
+    traverseInputType (In.EnumBaseType enumType) =
-lookupInputType :: Full.Type -> HashMap Full.Name (Type m) -> Maybe In.Type
+        let (Definition.EnumType typeName _ _) = enumType
-lookupInputType (Full.TypeNamed name) types' =
+         in collect Prelude.id typeName (EnumType enumType)
-    case HashMap.lookup name types' of
+    traverseOutputType (Out.ObjectBaseType objectType) =
-        Just (ScalarType scalarType) ->
+        traverseObjectType objectType
-            Just $ In.NamedScalarType scalarType
+    traverseOutputType (Out.InterfaceBaseType interfaceType) =
-        Just (EnumType enumType) ->
+        traverseInterfaceType interfaceType
-            Just $ In.NamedEnumType enumType
+    traverseOutputType (Out.UnionBaseType unionType) =
-        Just (InputObjectType objectType) ->
+        let (Out.UnionType typeName _ types) = unionType
-            Just $ In.NamedInputObjectType objectType
+            traverser = flip (foldr traverseObjectType) types
-        _ -> Nothing
+         in collect traverser typeName (UnionType unionType)
-lookupInputType (Full.TypeList list) types'
+    traverseOutputType (Out.ListBaseType listType) =
-    = In.ListType
+        traverseOutputType listType
-    <$> lookupInputType list types'
+    traverseOutputType (Out.ScalarBaseType scalarType) =
-lookupInputType (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) types' =
+        let (Definition.ScalarType typeName _) = scalarType
-    case HashMap.lookup nonNull types' of
+         in collect Prelude.id typeName (ScalarType scalarType)
-        Just (ScalarType scalarType) ->
+    traverseOutputType (Out.EnumBaseType enumType) =
-            Just $ In.NonNullScalarType scalarType
+        let (Definition.EnumType typeName _ _) = enumType
-        Just (EnumType enumType) ->
+         in collect Prelude.id typeName (EnumType enumType)
-            Just $ In.NonNullEnumType enumType
+    traverseObjectType objectType foundTypes =
-        Just (InputObjectType objectType) ->
+        let (Out.ObjectType typeName _ interfaces fields) = objectType
-            Just $ In.NonNullInputObjectType objectType
+            element = ObjectType objectType
-        _ -> Nothing
+            traverser = polymorphicTraverser interfaces (getField <$> fields)
-lookupInputType (Full.TypeNonNull (Full.NonNullTypeList nonNull)) types'
+         in collect traverser typeName element foundTypes
-    = In.NonNullListType
+    traverseInterfaceType interfaceType foundTypes =
-    <$> lookupInputType nonNull types'
+        let (Out.InterfaceType typeName _ interfaces fields) = interfaceType
-
+            element = InterfaceType interfaceType
-lookupTypeField :: forall a. Full.Name -> Out.Type a -> Maybe (Out.Field a)
+            traverser = polymorphicTraverser interfaces fields
-lookupTypeField fieldName outputType =
+         in collect traverser typeName element foundTypes
-    outToComposite outputType >>= lookupCompositeField fieldName
+    polymorphicTraverser interfaces fields
-
+        = flip (foldr visitFields) fields
-lookupCompositeField :: forall a
+        . flip (foldr traverseInterfaceType) interfaces
    . 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
@ -38,7 +38,6 @@ 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
@ -53,9 +52,6 @@ data ObjectType m = ObjectType
 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
@ -67,9 +63,6 @@ data InterfaceType m = InterfaceType
 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
@ -79,14 +72,11 @@ 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.
+    (HashMap Name In.Argument) -- ^ Arguments.
 -- | These types may be used as output types as the result of fields.
 --
@ -108,20 +98,6 @@ data Type 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) = '!' : show scalarType
    show (NonNullEnumType enumType) = '!' : show enumType
    show (NonNullObjectType inputObjectType) = '!' : show inputObjectType
    show (NonNullInterfaceType interfaceType) = '!' : show interfaceType
    show (NonNullUnionType unionType) = '!' : show unionType
    show (NonNullListType baseType) = concat ["![", show baseType, "]"]
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@ -1,175 +1,33 @@
 {- 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
+    ( Schema(..)
-    , module Language.GraphQL.Type.Internal
+    , Type(..)
    ) where
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 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(..)
    , 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.
+-- | These are all of the possible kinds of types.
-schema :: forall m
+data Type m
-    . Out.ObjectType m -- ^ Query type.
+    = ScalarType Definition.ScalarType
-    -> Maybe (Out.ObjectType m) -- ^ Mutation type.
+    | EnumType Definition.EnumType
-    -> Maybe (Out.ObjectType m) -- ^ Subscription type.
+    | ObjectType (Out.ObjectType m)
-    -> Directives -- ^ Directive definitions.
+    | InputObjectType In.InputObjectType
-    -> Schema m -- ^ Schema.
+    | InterfaceType (Out.InterfaceType m)
-schema queryRoot mutationRoot subscriptionRoot directiveDefinitions =
+    | UnionType (Out.UnionType m)
-    Internal.Schema queryRoot mutationRoot subscriptionRoot
+    deriving Eq
        allDirectives collectedTypes collectedImplementations
  where
    collectedTypes = collectReferencedTypes queryRoot mutationRoot subscriptionRoot
    collectedImplementations = collectImplementations collectedTypes
    allDirectives = HashMap.union directiveDefinitions defaultDirectives
    defaultDirectives = HashMap.fromList
        [ ("skip", skipDirective)
        , ("include", includeDirective)
        , ("deprecated", deprecatedDirective)
        ]
    includeDirective =
        Directive includeDescription skipIncludeLocations includeArguments
    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 skipIncludeLocations skipArguments
    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 deprecatedLocations deprecatedArguments
    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 reasonType
        $ Just "No longer supported"
    reasonType = In.NamedScalarType Definition.string
    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
        ]
-- | Traverses the schema and finds all referenced types.
+-- | A Schema is created by supplying the root types of each type of operation,
-collectReferencedTypes :: forall m
+--   query and mutation (optional). A schema definition is then supplied to the
-    . Out.ObjectType m
+--   validator and executor.
-    -> Maybe (Out.ObjectType m)
+--
-    -> Maybe (Out.ObjectType m)
+--   __Note:__ When the schema is constructed, by default only the types that
-    -> HashMap Full.Name (Type m)
+--   are reachable by traversing the root types are included, other types must
-collectReferencedTypes queryRoot mutationRoot subscriptionRoot =
+--   be explicitly referenced.
-    let queryTypes = traverseObjectType queryRoot HashMap.empty
+data Schema m = Schema
-        mutationTypes = maybe queryTypes (`traverseObjectType` queryTypes)
+    { query :: Out.ObjectType m
-            mutationRoot
+    , mutation :: Maybe (Out.ObjectType m)
-     in maybe mutationTypes (`traverseObjectType` queryTypes) subscriptionRoot
+    , subscription :: Maybe (Out.ObjectType m)
-  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 _ _ _) accumulator =
        HashMap.insertWith (++) typeName [implementation] accumulator
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@ -2,505 +2,96 @@
   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 #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -- | GraphQL validator.
 module Language.GraphQL.Validate
-    ( Validation.Error(..)
+    ( Error(..)
    , Path(..)
    , document
    , module Language.GraphQL.Validate.Rules
    ) where
-import Control.Monad (join)
+import Control.Monad.Trans.Reader (Reader, asks, runReader)
-import Control.Monad.Trans.Class (MonadTrans(..))
+import Data.Foldable (foldrM)
 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 Data.Text (Text)
-import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
+import Language.GraphQL.AST.Document
-import qualified Language.GraphQL.AST.Document as Full
+import Language.GraphQL.Type.Schema
 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
+data Context m = Context
-    = HashMap Full.Name (Schema.Type m)
+    { ast :: Document
-    -> Validation.Rule m
+    , schema :: Schema m
-    -> Maybe (Out.Type m)
+    , rules :: [Rule]
-    -> a
+    }
    -> Seq (Validation.RuleT m)
-type ApplyRule m a = Validation.Rule m -> a -> Seq (Validation.RuleT m)
+type ValidateT m = Reader (Context m) (Seq Error)
 -- | If an error can be associated to a particular field in the GraphQL result,
 -- it must contain an entry with the key path that details the path of the
 -- response field which experienced the error. This allows clients to identify
 -- whether a null result is intentional or caused by a runtime error.
 data Path
    = Segment Text -- ^ Field name.
    | Index Int -- ^ List index if a field returned a list.
    deriving (Eq, Show)
 -- | Validation error.
 data Error = Error
    { message :: String
    , locations :: [Location]
    , path :: [Path]
    } deriving (Eq, Show)
 -- | Validates a document and returns a list of found errors. If the returned
 -- list is empty, the document is valid.
-document :: forall m
+document :: forall m. Schema m -> [Rule] -> Document -> Seq Error
    . Schema m
    -> [Validation.Rule m]
    -> Full.Document
    -> Seq Validation.Error
 document schema' rules' document' =
-    runReaderT reader context
+    runReader (foldrM go Seq.empty document') context
  where
-    context = Validation
+    context = Context
-        { Validation.ast = document'
+        { ast = document'
-        , Validation.schema = schema'
+        , schema = schema'
        , rules = rules'
        }
-    reader = do
+    go definition' accumulator = (accumulator ><) <$> definition definition'
        rule' <- lift $ Seq.fromList rules'
        join $ lift $ foldr (definition rule' context) Seq.empty document'
-definition :: Validation.Rule m
+definition :: forall m. Definition -> ValidateT m
-    -> Validation m
+definition = \case
-    -> Full.Definition
+    definition'@(ExecutableDefinition executableDefinition' _) -> do
-    -> Seq (Validation.RuleT m)
+        applied <- applyRules definition'
-    -> Seq (Validation.RuleT m)
+        children <- executableDefinition executableDefinition'
-definition (Validation.DefinitionRule rule) _ definition' accumulator =
+        pure $ children >< applied
-    accumulator |> rule definition'
+    definition' -> applyRules 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 =
+    applyRules definition' = foldr (ruleFilter definition') Seq.empty
-        inputValueDefinition context rule inputFieldDefinitionLocation
+        <$> asks rules
    ruleFilter definition' (DefinitionRule rule) accumulator
        | Just message' <- rule definition' =
            accumulator |> Error
                { message = message'
                , locations = [definitionLocation definition']
                , path = []
                }
        | otherwise = accumulator
    definitionLocation (ExecutableDefinition _ location) = location
    definitionLocation (TypeSystemDefinition _ location) = location
    definitionLocation (TypeSystemExtension _ location) = location
-schemaExtension :: forall m. Validation m -> ApplyRule m Full.SchemaExtension
+executableDefinition :: forall m. ExecutableDefinition -> ValidateT m
-schemaExtension context rule = \case
+executableDefinition (DefinitionOperation definition') =
-    Full.SchemaOperationExtension directives' _ ->
+    operationDefinition definition'
-        directives context rule schemaLocation directives'
+executableDefinition (DefinitionFragment definition') =
-    Full.SchemaDirectivesExtension directives' ->
+    fragmentDefinition definition'
        directives context rule schemaLocation directives'
-schemaLocation :: DirectiveLocation
+operationDefinition :: forall m. OperationDefinition -> ValidateT m
-schemaLocation = TypeSystemDirectiveLocation DirectiveLocation.Schema
+operationDefinition (SelectionSet _operation) =
    pure Seq.empty
 operationDefinition (OperationDefinition _type _name _variables _directives _selection) =
    pure Seq.empty
-interfaceLocation :: DirectiveLocation
+fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m
-interfaceLocation = TypeSystemDirectiveLocation DirectiveLocation.Interface
+fragmentDefinition _fragment = pure Seq.empty
 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 listType value'@(Full.Node (Full.ConstList values) location')
        = embedListLocation go listType values location'
        |> rule listType 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'
 -- valueTypeFromList :: Maybe In.Type -> Maybe In.Type
 embedListLocation :: forall a m
    . (Maybe In.Type -> Full.Node a -> Seq m)
    -> Maybe In.Type
    -> [a]
    -> Full.Location
    -> Seq m
 embedListLocation go listType values location'
    = foldMap (go $ valueTypeFromList listType) 
    $ flip Full.Node location' <$> Seq.fromList values
  where
    valueTypeFromList (Just (In.ListBaseType baseType)) = Just baseType
    valueTypeFromList _ = Nothing
 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 listType value'@(Full.Node (Full.List values) location')
        = embedListLocation go listType values location'
        |> rule listType 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
@ -1,50 +0,0 @@
 {- 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/src/Test/Hspec/GraphQL.hs
+++ b/src/Test/Hspec/GraphQL.hs
@ -11,7 +11,6 @@ module Test.Hspec.GraphQL
    , shouldResolveTo
    ) where
 import Control.Monad.Catch (MonadCatch)
 import qualified Data.Aeson as Aeson
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
@ -19,8 +18,8 @@ import Language.GraphQL.Error
 import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)
 -- | Asserts that a query resolves to some value.
-shouldResolveTo :: MonadCatch m
+shouldResolveTo
-    => Either (ResponseEventStream m Aeson.Value) Aeson.Object
+    :: Either (ResponseEventStream IO Aeson.Value) Aeson.Object
    -> Aeson.Object
    -> Expectation
 shouldResolveTo (Right actual) expected = actual `shouldBe` expected
@ -28,8 +27,8 @@ shouldResolveTo _ _ = expectationFailure
    "the query is expected to resolve to a value, but it resolved to an event stream"
 -- | Asserts that the response doesn't contain any errors.
-shouldResolve :: MonadCatch m
+shouldResolve
-    => (Text -> IO (Either (ResponseEventStream m Aeson.Value) Aeson.Object))
+    :: (Text -> IO (Either (ResponseEventStream IO Aeson.Value) Aeson.Object))
    -> Text
    -> Expectation
 shouldResolve executor query = do
--- a/stack.yaml
+++ b/stack.yaml
@ -1,4 +1,4 @@
-resolver: lts-17.2
+resolver: lts-16.6
 packages:
 - .
@ -6,4 +6,4 @@ packages:
 extra-deps: []
 flags: {}
-pvp-bounds: lower
+pvp-bounds: both
--- a/tests/Language/GraphQL/AST/DocumentSpec.hs
+++ b/tests/Language/GraphQL/AST/DocumentSpec.hs
@ -1,20 +0,0 @@
 {-# 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
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@ -4,7 +4,7 @@ module Language.GraphQL.AST.EncoderSpec
    ( spec
    ) where
-import qualified Language.GraphQL.AST.Document as Full
+import Language.GraphQL.AST
 import Language.GraphQL.AST.Encoder
 import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
 import Test.QuickCheck (choose, oneof, forAll)
@ -15,52 +15,52 @@ spec :: Spec
 spec = do
    describe "value" $ do
        context "null value" $ do
-            let testNull formatter = value formatter Full.Null `shouldBe` "null"
+            let testNull formatter = value formatter Null `shouldBe` "null"
            it "minified" $ testNull minified
            it "pretty" $ testNull pretty
        context "minified" $ do
            it "escapes \\" $
-                value minified (Full.String "\\") `shouldBe` "\"\\\\\""
+                value minified (String "\\") `shouldBe` "\"\\\\\""
            it "escapes double quotes" $
-                value minified (Full.String "\"") `shouldBe` "\"\\\"\""
+                value minified (String "\"") `shouldBe` "\"\\\"\""
            it "escapes \\f" $
-                value minified (Full.String "\f") `shouldBe` "\"\\f\""
+                value minified (String "\f") `shouldBe` "\"\\f\""
            it "escapes \\n" $
-                value minified (Full.String "\n") `shouldBe` "\"\\n\""
+                value minified (String "\n") `shouldBe` "\"\\n\""
            it "escapes \\r" $
-                value minified (Full.String "\r") `shouldBe` "\"\\r\""
+                value minified (String "\r") `shouldBe` "\"\\r\""
            it "escapes \\t" $
-                value minified (Full.String "\t") `shouldBe` "\"\\t\""
+                value minified (String "\t") `shouldBe` "\"\\t\""
            it "escapes backspace" $
-                value minified (Full.String "a\bc") `shouldBe` "\"a\\bc\""
+                value minified (String "a\bc") `shouldBe` "\"a\\bc\""
            context "escapes Unicode for chars less than 0010" $ do
-                it "Null" $ value minified (Full.String "\x0000") `shouldBe` "\"\\u0000\""
+                it "Null" $ value minified (String "\x0000") `shouldBe` "\"\\u0000\""
-                it "bell" $ value minified (Full.String "\x0007") `shouldBe` "\"\\u0007\""
+                it "bell" $ value minified (String "\x0007") `shouldBe` "\"\\u0007\""
            context "escapes Unicode for char less than 0020" $ do
-                it "DLE" $ value minified (Full.String "\x0010") `shouldBe` "\"\\u0010\""
+                it "DLE" $ value minified (String "\x0010") `shouldBe` "\"\\u0010\""
-                it "EM" $ value minified (Full.String "\x0019") `shouldBe` "\"\\u0019\""
+                it "EM" $ value minified (String "\x0019") `shouldBe` "\"\\u0019\""
            context "encodes without escape" $ do
-                it "space" $ value minified (Full.String "\x0020") `shouldBe` "\" \""
+                it "space" $ value minified (String "\x0020") `shouldBe` "\" \""
-                it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
+                it "~" $ value minified (String "\x007E") `shouldBe` "\"~\""
        context "pretty" $ do
            it "uses strings for short string values" $
-                value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
+                value pretty (String "Short text") `shouldBe` "\"Short text\""
            it "uses block strings for text with new lines, with newline symbol" $
-                value pretty (Full.String "Line 1\nLine 2")
+                value pretty (String "Line 1\nLine 2")
                    `shouldBe` [r|"""
  Line 1
  Line 2
 """|]
            it "uses block strings for text with new lines, with CR symbol" $
-                value pretty (Full.String "Line 1\rLine 2")
+                value pretty (String "Line 1\rLine 2")
                    `shouldBe` [r|"""
  Line 1
  Line 2
 """|]
            it "uses block strings for text with new lines, with CR symbol followed by newline" $
-                value pretty (Full.String "Line 1\r\nLine 2")
+                value pretty (String "Line 1\r\nLine 2")
                    `shouldBe` [r|"""
  Line 1
  Line 2
@ -77,12 +77,12 @@ spec = do
                forAll genNotAllowedSymbol $ \x -> do
                    let
                      rawValue = "Short \n" <> cons x "text"
-                      encoded = value pretty (Full.String $ toStrict rawValue)
+                      encoded = value pretty (String $ toStrict rawValue)
                    shouldStartWith (unpack encoded) "\""
                    shouldEndWith (unpack encoded) "\""
                    shouldNotContain (unpack encoded) "\"\"\""
-            it "Hello world" $ value pretty (Full.String "Hello,\n  World!\n\nYours,\n  GraphQL.")
+            it "Hello world" $ value pretty (String "Hello,\n  World!\n\nYours,\n  GraphQL.")
              `shouldBe` [r|"""
  Hello,
    World!
@ -91,29 +91,29 @@ spec = do
    GraphQL.
 """|]
-            it "has only newlines" $ value pretty (Full.String "\n") `shouldBe` [r|"""
+            it "has only newlines" $ value pretty (String "\n") `shouldBe` [r|"""
 """|]
            it "has newlines and one symbol at the begining" $
-              value pretty (Full.String "a\n\n") `shouldBe` [r|"""
+              value pretty (String "a\n\n") `shouldBe` [r|"""
  a
 """|]
            it "has newlines and one symbol at the end" $
-              value pretty (Full.String "\n\na") `shouldBe` [r|"""
+              value pretty (String "\n\na") `shouldBe` [r|"""
  a
 """|]
            it "has newlines and one symbol in the middle" $
-              value pretty (Full.String "\na\n") `shouldBe` [r|"""
+              value pretty (String "\na\n") `shouldBe` [r|"""
  a
 """|]
-            it "skip trailing whitespaces" $ value pretty (Full.String "  Short\ntext    ")
+            it "skip trailing whitespaces" $ value pretty (String "  Short\ntext    ")
              `shouldBe` [r|"""
  Short
  text
@ -121,13 +121,9 @@ spec = do
    describe "definition" $
        it "indents block strings in arguments" $
-            let location = Full.Location 0 0
+            let arguments = [Argument "message" (String "line1\nline2")]
-                argumentValue = Full.Node (Full.String "line1\nline2") location
+                field = Field Nothing "field" arguments [] []
-                arguments = [Full.Argument "message" argumentValue location]
+                operation = DefinitionOperation $ SelectionSet $ pure field
                field = Full.Field Nothing "field" arguments [] [] location
                fieldSelection = pure $ Full.FieldSelection field
                operation = Full.DefinitionOperation
                    $ Full.SelectionSet fieldSelection location
             in definition pretty operation `shouldBe` [r|{
  field(message: """
    line1
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@ -75,9 +75,9 @@ spec = describe "Lexer" $ do
            parse dollar "" "$" `shouldParse` "$"
            runBetween parens `shouldSucceedOn` "()"
            parse spread "" "..." `shouldParse` "..."
-            parse colon "" `shouldSucceedOn` ":"
+            parse colon "" ":" `shouldParse` ":"
            parse equals "" "=" `shouldParse` "="
-            parse at "" `shouldSucceedOn` "@"
+            parse at "" "@" `shouldParse` "@"
            runBetween brackets `shouldSucceedOn` "[]"
            runBetween braces `shouldSucceedOn` "{}"
            parse pipe "" "|" `shouldParse` "|"
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -128,7 +128,7 @@ spec = describe "Parser" $ do
        parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|]
    it "parses schema extension with an operation type and directive" $
-        let newDirective = Directive "newDirective" [] $ Location 1 15
+        let newDirective = Directive "newDirective" []
            schemaExtension = SchemaExtension
                $ SchemaOperationExtension [newDirective]
                $ OperationTypeDefinition Query "Query" :| []
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@ -1,7 +1,3 @@
 {- 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
@ -19,6 +15,6 @@ import Test.Hspec ( Spec
 spec :: Spec
 spec = describe "singleError" $
    it "constructs an error with the given message" $
-        let errors'' = Seq.singleton $ Error "Message." [] []
+        let errors'' = Seq.singleton $ Error "Message." []
            expected = Response Aeson.Null errors''
         in singleError "Message." `shouldBe` expected
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@ -1,7 +1,3 @@
 {- 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
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@ -3,7 +3,6 @@
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.ExecuteSpec
    ( spec
    ) where
@ -11,11 +10,10 @@ module Language.GraphQL.ExecuteSpec
 import Control.Exception (SomeException)
 import Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (emptyObject)
 import Data.Conduit
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL.AST (Document, Name)
+import Language.GraphQL.AST (Name)
 import Language.GraphQL.AST.Parser (document)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
@ -23,10 +21,13 @@ import Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Out as Out
 import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
-philosopherSchema :: Schema (Either SomeException)
+schema :: Schema (Either SomeException)
-philosopherSchema = schema queryType Nothing (Just subscriptionType) mempty
+schema = Schema
    { query = queryType
    , mutation = Nothing
    , subscription = Just subscriptionType
    }
 queryType :: Out.ObjectType (Either SomeException)
 queryType = Out.ObjectType "Query" Nothing []
@ -70,32 +71,9 @@ quoteType = Out.ObjectType "Quote" Nothing []
    quoteField =
        Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
 type EitherStreamOrValue = Either
    (ResponseEventStream (Either SomeException) Aeson.Value)
    (Response Aeson.Value)
 execute' :: Document -> Either SomeException EitherStreamOrValue
 execute' =
    execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
 spec :: Spec
 spec =
    describe "execute" $ do
        it "rejects recursive fragments" $
            let sourceQuery = [r|
              {
                ...cyclicFragment
              }
              fragment cyclicFragment on Query {
                ...cyclicFragment
              }
            |]
                expected = Response emptyObject mempty
                Right (Right actual) = either (pure . parseError) execute'
                    $ parse document "" sourceQuery
             in actual `shouldBe` expected
        context "Query" $ do
            it "skips unknown fields" $
                let data'' = Aeson.object
@ -104,6 +82,7 @@ spec =
                            ]
                        ]
                    expected = Response data'' mempty
                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
                    Right (Right actual) = either (pure . parseError) execute'
                        $ parse document "" "{ philosopher { firstName surname } }"
                in actual `shouldBe` expected
@ -115,6 +94,7 @@ spec =
                            ]
                        ]
                    expected = Response data'' mempty
                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
                    Right (Right actual) = either (pure . parseError) execute'
                        $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
                in actual `shouldBe` expected
@ -126,6 +106,7 @@ spec =
                            ]
                        ]
                    expected = Response data'' mempty
                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
                    Right (Left stream) = either (pure . parseError) execute'
                        $ parse document "" "subscription { newQuote { quote } }"
                    Right (Just actual) = runConduit $ stream .| await
--- a/tests/Language/GraphQL/Type/OutSpec.hs
+++ b/tests/Language/GraphQL/Type/OutSpec.hs
@ -1,7 +1,3 @@
 {- 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
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/tests/Language/GraphQL/Validate/RulesSpec.hs
@ -1,914 +0,0 @@
 {- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.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.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Validate
 import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain)
 import Text.Megaparsec (parse, errorBundlePretty)
 import Text.RawString.QQ (r)
 petSchema :: Schema IO
 petSchema = schema queryType Nothing (Just subscriptionType) mempty
 queryType :: ObjectType IO
 queryType = ObjectType "Query" Nothing [] $ HashMap.fromList
    [ ("dog", dogResolver)
    , ("cat", catResolver)
    , ("findDog", findDogResolver)
    ]
  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
 catCommandType :: EnumType
 catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
    [ ("JUMP", EnumValue Nothing)
    ]
 catType :: ObjectType IO
 catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("nickname", nicknameResolver)
    , ("doesKnowCommand", doesKnowCommandResolver)
    , ("meowVolume", meowVolumeResolver)
    ]
  where
    meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty
    meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 3
    doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
        $ HashMap.singleton "catCommand"
        $ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing
    doesKnowCommandResolver = ValueResolver doesKnowCommandField
        $ 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 = [r|
                  query getDogName {
                    dog {
                      name
                      color
                    }
                  }
                  extend type Dog {
                    color: String
                  }
                |]
                    expected = Error
                        { message =
                            "Definition must be OperationDefinition or \
                            \FragmentDefinition."
                        , locations = [AST.Location 9 19]
                        }
                 in validate queryString `shouldContain` [expected]
        context "singleFieldSubscriptionsRule" $ do
            it "rejects multiple subscription root fields" $
                let queryString = [r|
                  subscription sub {
                    newMessage {
                      body
                      sender
                    }
                    disallowedSecondRootField
                  }
                |]
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 2 19]
                        }
                 in validate queryString `shouldContain` [expected]
            it "rejects multiple subscription root fields coming from a fragment" $
                let queryString = [r|
                  subscription sub {
                    ...multipleSubscriptions
                  }
                  fragment multipleSubscriptions on Subscription {
                    newMessage {
                      body
                      sender
                    }
                    disallowedSecondRootField
                  }
                |]
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 2 19]
                        }
                 in validate queryString `shouldContain` [expected]
            it "finds corresponding subscription fragment" $
                let queryString = [r|
                  subscription sub {
                    ...anotherSubscription
                    ...multipleSubscriptions
                  }
                  fragment multipleSubscriptions on Subscription {
                    newMessage {
                      body
                    }
                    disallowedSecondRootField {
                      sender
                    }
                  }
                  fragment anotherSubscription on Subscription {
                    newMessage {
                      body
                      sender
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Subscription \"sub\" must select only one top \
                            \level field."
                        , locations = [AST.Location 2 19]
                        }
                 in validate queryString `shouldBe` [expected]
        context "loneAnonymousOperationRule" $
            it "rejects multiple anonymous operations" $
                let queryString = [r|
                  {
                    dog {
                      name
                    }
                  }
                  query getName {
                    dog {
                      owner {
                        name
                      }
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "This anonymous operation must be the only defined \
                            \operation."
                        , locations = [AST.Location 2 19]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueOperationNamesRule" $
            it "rejects operations with the same name" $
                let queryString = [r|
                  query dogOperation {
                    dog {
                      name
                    }
                  }
                  mutation dogOperation {
                    mutateDog {
                      id
                    }
                }
                |]
                    expected = Error
                        { message =
                            "There can be only one operation named \
                            \\"dogOperation\"."
                        , locations = [AST.Location 2 19, AST.Location 8 19]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueFragmentNamesRule" $
            it "rejects fragments with the same name" $
                let queryString = [r|
                  {
                    dog {
                      ...fragmentOne
                    }
                  }
                  fragment fragmentOne on Dog {
                    name
                  }
                  fragment fragmentOne on Dog {
                    owner {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "There can be only one fragment named \
                            \\"fragmentOne\"."
                        , locations = [AST.Location 8 19, AST.Location 12 19]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentSpreadTargetDefinedRule" $
            it "rejects the fragment spread without a target" $
                let queryString = [r|
                  {
                    dog {
                      ...undefinedFragment
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment target \"undefinedFragment\" is \
                            \undefined."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentSpreadTypeExistenceRule" $ do
            it "rejects fragment spreads without an unknown target type" $
                let queryString = [r|
                  {
                    dog {
                      ...notOnExistingType
                    }
                  }
                  fragment notOnExistingType on NotInSchema {
                    name
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment \"notOnExistingType\" is specified on \
                            \type \"NotInSchema\" which doesn't exist in the \
                            \schema."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects inline fragments without a target" $
                let queryString = [r|
                  {
                    ... on NotInSchema {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Inline fragment is specified on type \
                            \\"NotInSchema\" which doesn't exist in the schema."
                        , locations = [AST.Location 3 21]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fragmentsOnCompositeTypesRule" $ do
            it "rejects fragments on scalar types" $
                let queryString = [r|
                  {
                    dog {
                      ...fragOnScalar
                    }
                  }
                  fragment fragOnScalar on Int {
                    name
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment cannot condition on non composite type \
                            \\"Int\"."
                        , locations = [AST.Location 7 19]
                        }
                 in validate queryString `shouldContain` [expected]
            it "rejects inline fragments on scalar types" $
                let queryString = [r|
                  {
                    ... on Boolean {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment cannot condition on non composite type \
                            \\"Boolean\"."
                        , locations = [AST.Location 3 21]
                        }
                in validate queryString `shouldContain` [expected]
        context "noUnusedFragmentsRule" $
            it "rejects unused fragments" $
                let queryString = [r|
                  fragment nameFragment on Dog { # unused
                    name
                  }
                  {
                    dog {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment \"nameFragment\" is never used."
                        , locations = [AST.Location 2 19]
                        }
                 in validate queryString `shouldBe` [expected]
        context "noFragmentCyclesRule" $
            it "rejects spreads that form cycles" $
                let queryString = [r|
                  {
                    dog {
                      ...nameFragment
                    }
                  }
                  fragment nameFragment on Dog {
                    name
                    ...barkVolumeFragment
                  }
                  fragment barkVolumeFragment on Dog {
                    barkVolume
                    ...nameFragment
                  }
                |]
                    error1 = Error
                        { message =
                            "Cannot spread fragment \"barkVolumeFragment\" \
                            \within itself (via barkVolumeFragment -> \
                            \nameFragment -> barkVolumeFragment)."
                        , locations = [AST.Location 11 19]
                        }
                    error2 = Error
                        { message =
                            "Cannot spread fragment \"nameFragment\" within \
                            \itself (via nameFragment -> barkVolumeFragment -> \
                            \nameFragment)."
                        , locations = [AST.Location 7 19]
                        }
                 in validate queryString `shouldBe` [error1, error2]
        context "uniqueArgumentNamesRule" $
            it "rejects duplicate field arguments" $
                let queryString = [r|
                  {
                    dog {
                      isHousetrained(atOtherHomes: true, atOtherHomes: true)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "There can be only one argument named \
                            \\"atOtherHomes\"."
                        , locations = [AST.Location 4 38, AST.Location 4 58]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueDirectiveNamesRule" $
            it "rejects more than one directive per location" $
                let queryString = [r|
                  query ($foo: Boolean = true, $bar: Boolean = false) {
                    dog @skip(if: $foo) @skip(if: $bar) {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "There can be only one directive named \"skip\"."
                        , locations = [AST.Location 3 25, AST.Location 3 41]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueVariableNamesRule" $
            it "rejects duplicate variables" $
                let queryString = [r|
                  query houseTrainedQuery($atOtherHomes: Boolean, $atOtherHomes: Boolean) {
                    dog {
                      isHousetrained(atOtherHomes: $atOtherHomes)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "There can be only one variable named \
                            \\"atOtherHomes\"."
                        , locations = [AST.Location 2 43, AST.Location 2 67]
                        }
                 in validate queryString `shouldBe` [expected]
        context "variablesAreInputTypesRule" $
            it "rejects non-input types as variables" $
                let queryString = [r|
                  query takesDogBang($dog: Dog!) {
                    dog {
                      isHousetrained(atOtherHomes: $dog)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Variable \"$dog\" cannot be non-input type \
                            \\"Dog\"."
                        , locations = [AST.Location 2 38]
                        }
                 in validate queryString `shouldContain` [expected]
        context "noUndefinedVariablesRule" $
            it "rejects undefined variables" $
                let queryString = [r|
                  query variableIsNotDefinedUsedInSingleFragment {
                    dog {
                      ...isHousetrainedFragment
                    }
                  }
                  fragment isHousetrainedFragment on Dog {
                    isHousetrained(atOtherHomes: $atOtherHomes)
                  }
                |]
                    expected = Error
                        { message =
                            "Variable \"$atOtherHomes\" is not defined by \
                            \operation \
                            \\"variableIsNotDefinedUsedInSingleFragment\"."
                        , locations = [AST.Location 9 50]
                        }
                 in validate queryString `shouldBe` [expected]
        context "noUnusedVariablesRule" $
            it "rejects unused variables" $
                let queryString = [r|
                  query variableUnused($atOtherHomes: Boolean) {
                    dog {
                      isHousetrained
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Variable \"$atOtherHomes\" is never used in \
                            \operation \"variableUnused\"."
                        , locations = [AST.Location 2 40]
                        }
                 in validate queryString `shouldBe` [expected]
        context "uniqueInputFieldNamesRule" $
            it "rejects duplicate fields in input objects" $
                let queryString = [r|
                  {
                    findDog(complex: { name: "Fido", name: "Jack" }) {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "There can be only one input field named \"name\"."
                        , locations = [AST.Location 3 40, AST.Location 3 54]
                        }
                 in validate queryString `shouldBe` [expected]
        context "fieldsOnCorrectTypeRule" $
            it "rejects undefined fields" $
                let queryString = [r|
                  {
                    dog {
                      meowVolume
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Cannot query field \"meowVolume\" on type \"Dog\"."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "scalarLeafsRule" $
            it "rejects scalar fields with not empty selection set" $
                let queryString = [r|
                  {
                    dog {
                      barkVolume {
                        sinceWhen
                      }
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Field \"barkVolume\" must not have a selection \
                            \since type \"Int\" has no subfields."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownArgumentNamesRule" $ do
            it "rejects field arguments missing in the type" $
                let queryString = [r|
                  {
                    dog {
                      doesKnowCommand(command: CLEAN_UP_HOUSE, dogCommand: SIT)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Unknown argument \"command\" on field \
                            \\"Dog.doesKnowCommand\"."
                        , locations = [AST.Location 4 39]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects directive arguments missing in the definition" $
                let queryString = [r|
                  {
                    dog {
                      isHousetrained(atOtherHomes: true) @include(unless: false, if: true)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Unknown argument \"unless\" on directive \
                            \\"@include\"."
                        , locations = [AST.Location 4 67]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownDirectiveNamesRule" $
            it "rejects undefined directives" $
                let queryString = [r|
                  {
                    dog {
                      isHousetrained(atOtherHomes: true) @ignore(if: true)
                    }
                  }
                |]
                    expected = Error
                        { message = "Unknown directive \"@ignore\"."
                        , locations = [AST.Location 4 58]
                        }
                 in validate queryString `shouldBe` [expected]
        context "knownInputFieldNamesRule" $
            it "rejects undefined input object fields" $
                let queryString = [r|
                  {
                    findDog(complex: { favoriteCookieFlavor: "Bacon", name: "Jack" }) {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Field \"favoriteCookieFlavor\" is not defined \
                            \by type \"DogData\"."
                        , locations = [AST.Location 3 40]
                        }
                 in validate queryString `shouldBe` [expected]
        context "directivesInValidLocationsRule" $
            it "rejects directives in invalid locations" $
                let queryString = [r|
                  query @skip(if: $foo) {
                    dog {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Directive \"@skip\" may not be used on QUERY."
                        , locations = [AST.Location 2 25]
                        }
                 in validate queryString `shouldBe` [expected]
        context "overlappingFieldsCanBeMergedRule" $ do
            it "fails to merge fields of mismatching types" $
                let queryString = [r|
                  {
                    dog {
                      name: nickname
                      name
                    }
                  }
                |]
                    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 4 23, AST.Location 5 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "fails if the arguments of the same field don't match" $
                let queryString = [r|
                  {
                    dog {
                      doesKnowCommand(dogCommand: SIT)
                      doesKnowCommand(dogCommand: HEEL)
                    }
                  }
                |]
                    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 4 23, AST.Location 5 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "fails to merge same-named field and alias" $
                let queryString = [r|
                  {
                    dog {
                      doesKnowCommand(dogCommand: SIT)
                      doesKnowCommand: isHousetrained(atOtherHomes: true)
                    }
                  }
                |]
                    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 23, AST.Location 5 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "looks for fields after a successfully merged field pair" $
                let queryString = [r|
                  {
                    dog {
                      name
                      doesKnowCommand(dogCommand: SIT)
                    }
                    dog {
                      name
                      doesKnowCommand: isHousetrained(atOtherHomes: true)
                    }
                  }
                |]
                    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 5 23, AST.Location 9 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "possibleFragmentSpreadsRule" $ do
            it "rejects object inline spreads outside object scope" $
                let queryString = [r|
                  {
                    dog {
                      ... on Cat {
                        meowVolume
                      }
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment cannot be spread here as objects of type \
                            \\"Dog\" can never be of type \"Cat\"."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects object named spreads outside object scope" $
                let queryString = [r|
                  {
                    dog {
                      ... catInDogFragmentInvalid
                    }
                  }
                  fragment catInDogFragmentInvalid on Cat {
                    meowVolume
                  }
                |]
                    expected = Error
                        { message =
                            "Fragment \"catInDogFragmentInvalid\" cannot be \
                            \spread here as objects of type \"Dog\" can never \
                            \be of type \"Cat\"."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "providedRequiredInputFieldsRule" $
            it "rejects missing required input fields" $
                let queryString = [r|
                  {
                    findDog(complex: { name: null }) {
                      name
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Input field \"name\" of type \"DogData\" is \
                            \required, but it was not provided."
                        , locations = [AST.Location 3 38]
                        }
                 in validate queryString `shouldBe` [expected]
        context "providedRequiredArgumentsRule" $
            it "checks for (non-)nullable arguments" $
                let queryString = [r|
                  {
                    dog {
                      doesKnowCommand(dogCommand: null)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Field \"doesKnowCommand\" argument \"dogCommand\" \
                            \of type \"DogCommand\" is required, but it was \
                            \not provided."
                        , locations = [AST.Location 4 23]
                        }
                 in validate queryString `shouldBe` [expected]
        context "variablesInAllowedPositionRule" $ do
            it "rejects wrongly typed variable arguments" $
                let queryString = [r|
                  query catCommandArgQuery($catCommandArg: CatCommand) {
                    cat {
                      doesKnowCommand(catCommand: $catCommandArg)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Variable \"$catCommandArg\" of type \
                            \\"CatCommand\" used in position expecting type \
                            \\"!CatCommand\"."
                        , locations = [AST.Location 2 44]
                        }
                 in validate queryString `shouldBe` [expected]
            it "rejects wrongly typed variable arguments" $
                let queryString = [r|
                  query intCannotGoIntoBoolean($intArg: Int) {
                    dog {
                      isHousetrained(atOtherHomes: $intArg)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Variable \"$intArg\" of type \"Int\" used in \
                            \position expecting type \"Boolean\"."
                        , locations = [AST.Location 2 48]
                        }
                 in validate queryString `shouldBe` [expected]
        context "valuesOfCorrectTypeRule" $
            it "rejects values of incorrect types" $
                let queryString = [r|
                  {
                    dog {
                      isHousetrained(atOtherHomes: 3)
                    }
                  }
                |]
                    expected = Error
                        { message =
                            "Value 3 cannot be coerced to type \"Boolean\"."
                        , locations = [AST.Location 4 52]
                        }
                 in validate queryString `shouldBe` [expected]
--- a/tests/Language/GraphQL/ValidateSpec.hs
+++ b/tests/Language/GraphQL/ValidateSpec.hs
@ -0,0 +1,171 @@
 {- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.ValidateSpec
    ( spec
    ) where
 import Data.Sequence (Seq(..))
 import qualified Data.Sequence as Seq
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Language.GraphQL.AST as AST
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Validate
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 schema :: Schema IO
 schema = Schema
    { query = queryType
    , mutation = Nothing
    , subscription = Nothing
    } 
 queryType :: ObjectType IO
 queryType = ObjectType "Query" Nothing []
    $ HashMap.singleton "dog" dogResolver
  where
    dogField = Field Nothing (Out.NamedObjectType dogType) mempty
    dogResolver = ValueResolver dogField $ pure Null
 dogCommandType :: EnumType
 dogCommandType = EnumType "DogCommand" Nothing $ HashMap.fromList
    [ ("SIT", EnumValue Nothing)
    , ("DOWN", EnumValue Nothing)
    , ("HEEL", EnumValue Nothing)
    ]
 dogType :: ObjectType IO
 dogType = ObjectType "Dog" Nothing [petType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("nickname", nicknameResolver)
    , ("barkVolume", barkVolumeResolver)
    , ("doesKnowCommand", doesKnowCommandResolver)
    , ("isHousetrained", isHousetrainedResolver)
    , ("owner", ownerResolver)
    ]
  where
    nameField = Field Nothing (Out.NonNullScalarType string) mempty
    nameResolver = ValueResolver nameField $ pure "Name"
    nicknameField = Field Nothing (Out.NamedScalarType string) mempty
    nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
    barkVolumeField = Field Nothing (Out.NamedScalarType int) mempty
    barkVolumeResolver = ValueResolver barkVolumeField $ pure $ Int 3
    doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
        $ HashMap.singleton "dogCommand"
        $ In.Argument Nothing (In.NonNullEnumType dogCommandType) Nothing
    doesKnowCommandResolver = ValueResolver doesKnowCommandField
        $ pure $ Boolean True
    isHousetrainedField = Field Nothing (Out.NonNullScalarType boolean)
        $ HashMap.singleton "atOtherHomes"
        $ In.Argument Nothing (In.NamedScalarType boolean) Nothing
    isHousetrainedResolver = ValueResolver isHousetrainedField
        $ pure $ Boolean True
    ownerField = Field Nothing (Out.NamedObjectType humanType) mempty
    ownerResolver = ValueResolver ownerField $ pure Null
 sentientType :: InterfaceType IO
 sentientType = InterfaceType "Sentient" Nothing []
    $ HashMap.singleton "name"
    $ Field Nothing (Out.NonNullScalarType string) mempty
 petType :: InterfaceType IO
 petType = InterfaceType "Pet" Nothing []
    $ HashMap.singleton "name"
    $ Field Nothing (Out.NonNullScalarType string) mempty
 {-
 alienType :: ObjectType IO
 alienType = ObjectType "Alien" Nothing [sentientType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("homePlanet", homePlanetResolver)
    ]
  where
    nameField = Field Nothing (Out.NonNullScalarType string) mempty
    nameResolver = ValueResolver nameField $ pure "Name"
    homePlanetField =
        Field Nothing (Out.NamedScalarType string) mempty
    homePlanetResolver = ValueResolver homePlanetField $ pure "Home planet"
 -}
 humanType :: ObjectType IO
 humanType = ObjectType "Human" Nothing [sentientType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("pets", petsResolver)
    ]
  where
    nameField = Field Nothing (Out.NonNullScalarType string) mempty
    nameResolver = ValueResolver nameField $ pure "Name"
    petsField =
        Field Nothing (Out.ListType $ Out.NonNullInterfaceType petType) mempty
    petsResolver = ValueResolver petsField $ pure $ List []
 {-
 catCommandType :: EnumType
 catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList
    [ ("JUMP", EnumValue Nothing)
    ]
 catType :: ObjectType IO
 catType = ObjectType "Cat" Nothing [petType] $ HashMap.fromList
    [ ("name", nameResolver)
    , ("nickname", nicknameResolver)
    , ("doesKnowCommand", doesKnowCommandResolver)
    , ("meowVolume", meowVolumeResolver)
    ]
  where
    nameField = Field Nothing (Out.NonNullScalarType string) mempty
    nameResolver = ValueResolver nameField $ pure "Name"
    nicknameField = Field Nothing (Out.NamedScalarType string) mempty
    nicknameResolver = ValueResolver nicknameField $ pure "Nickname"
    doesKnowCommandField = Field Nothing (Out.NonNullScalarType boolean)
        $ HashMap.singleton "catCommand"
        $ In.Argument Nothing (In.NonNullEnumType catCommandType) Nothing
    doesKnowCommandResolver = ValueResolver doesKnowCommandField
        $ pure $ Boolean True
    meowVolumeField = Field Nothing (Out.NamedScalarType int) mempty
    meowVolumeResolver = ValueResolver meowVolumeField $ pure $ Int 2
 catOrDogType :: UnionType IO
 catOrDogType = UnionType "CatOrDog" Nothing [catType, dogType]
 dogOrHumanType :: UnionType IO
 dogOrHumanType = UnionType "DogOrHuman" Nothing [dogType, humanType]
 humanOrAlienType :: UnionType IO
 humanOrAlienType = UnionType "HumanOrAlien" Nothing [humanType, alienType]
 -}
 validate :: Text -> Seq Error
 validate queryString =
    case parse AST.document "" queryString of
        Left _ -> Seq.empty
        Right ast -> document schema specifiedRules ast
 spec :: Spec
 spec =
    describe "document" $
        it "rejects type definitions" $
            let queryString = [r|
              query getDogName {
                dog {
                  name
                  color
                }
              }
              extend type Dog {
                color: String
              }
            |]
                expected = Error
                    { message =
                        "Definition must be OperationDefinition or FragmentDefinition."
                    , locations = [AST.Location 9 15]
                    , path = []
                    }
             in validate queryString `shouldBe` Seq.singleton expected
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@ -19,7 +19,8 @@ import Test.Hspec.GraphQL
 import Text.RawString.QQ (r)
 experimentalResolver :: Schema IO
-experimentalResolver = schema queryType Nothing Nothing mempty
+experimentalResolver = Schema
    { query = queryType, mutation = Nothing, subscription = Nothing }
  where
    queryType = Out.ObjectType "Query" Nothing []
        $ HashMap.singleton "experimentalField"
@ -71,7 +72,7 @@ spec =
                ...experimentalFragment @skip(if: true)
              }
-              fragment experimentalFragment on Query {
+              fragment experimentalFragment on ExperimentalType {
                experimentalField
              }
            |]
@ -82,7 +83,7 @@ spec =
        it "should be able to @skip an inline fragment" $ do
            let sourceQuery = [r|
              {
-                ... on Query @skip(if: true) {
+                ... on ExperimentalType @skip(if: true) {
                  experimentalField
                }
              }
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@ -46,15 +46,18 @@ inlineQuery = [r|{
 }|]
 shirtType :: Out.ObjectType IO
-shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList
+shirtType = Out.ObjectType "Shirt" Nothing []
-    [ ("size", sizeFieldType)
+    $ HashMap.fromList
-    ]
+        [ ("size", sizeFieldType)
        , ("circumference", circumferenceFieldType)
        ]
 hatType :: Out.ObjectType IO
-hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList
+hatType = Out.ObjectType "Hat" Nothing []
-    [ ("size", sizeFieldType)
+    $ HashMap.fromList
-    , ("circumference", circumferenceFieldType)
+        [ ("size", sizeFieldType)
-    ]
+        , ("circumference", circumferenceFieldType)
        ]
 circumferenceFieldType :: Out.Resolver IO
 circumferenceFieldType
@ -67,11 +70,12 @@ sizeFieldType
    $ pure $ snd size
 toSchema :: Text -> (Text, Value) -> Schema IO
-toSchema t (_, resolve) = schema queryType Nothing Nothing mempty
+toSchema t (_, resolve) = Schema
    { query = queryType, mutation = Nothing, subscription = Nothing }
  where
-    garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
+    unionMember = if t == "Hat" then hatType else shirtType
    typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
-    garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty
+    garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
    queryType =
        case t of
            "circumference" -> hatType
@ -107,16 +111,22 @@ spec = do
        it "embeds inline fragments without type" $ do
            let sourceQuery = [r|{
-              circumference
+              garment {
-              ... {
+                circumference
-                size
+                ... {
                  size
                }
              }
            }|]
-            actual <- graphql (toSchema "circumference" circumference) sourceQuery
+                resolvers = ("garment", Object $ HashMap.fromList [circumference,  size])
            actual <- graphql (toSchema "garment" resolvers) sourceQuery
            let expected = HashMap.singleton "data"
                    $ Aeson.object
-                        [ "circumference" .= (60 :: Int)
+                        [ "garment" .= Aeson.object
-                        , "size" .= ("L" :: Text)
+                            [ "circumference" .= (60 :: Int)
                            , "size" .= ("L" :: Text)
                            ]
                        ]
             in actual `shouldResolveTo` expected
@ -173,6 +183,21 @@ spec = do
                        ]
             in actual `shouldResolveTo` expected
        it "rejects recursive fragments" $ do
            let expected = HashMap.singleton "data" $ Aeson.object []
                sourceQuery = [r|
              {
                ...circumferenceFragment
              }
              fragment circumferenceFragment on Hat {
                ...circumferenceFragment
              }
            |]
            actual <- graphql (toSchema "circumference" circumference) sourceQuery
            actual `shouldResolveTo` expected
        it "considers type condition" $ do
            let sourceQuery = [r|
              {
--- a/tests/Test/KitchenSinkSpec.hs
+++ b/tests/Test/KitchenSinkSpec.hs
@ -0,0 +1,69 @@
 {-# 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/RootOperationSpec.hs
+++ b/tests/Test/RootOperationSpec.hs
@ -23,11 +23,13 @@ hatType = Out.ObjectType "Hat" Nothing []
    $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
    $ pure $ Int 60
-garmentSchema :: Schema IO
+schema :: Schema IO
-garmentSchema = schema queryType (Just mutationType) Nothing mempty
+schema = Schema
    { query = Out.ObjectType "Query" Nothing [] hatFieldResolver
    , mutation = Just $ Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
    , subscription = Nothing
    }
  where
    queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver
    mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
    garment = pure $ Object $ HashMap.fromList
        [ ("circumference", Int 60)
        ]
@ -55,7 +57,7 @@ spec =
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
-            actual <- graphql garmentSchema querySource
+            actual <- graphql schema querySource
            actual `shouldResolveTo` expected
        it "chooses Mutation" $ do
@ -68,5 +70,5 @@ spec =
                    $ object
                        [ "incrementCircumference" .= (61 :: Int)
                        ]
-            actual <- graphql garmentSchema querySource
+            actual <- graphql schema querySource
            actual `shouldResolveTo` expected
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@ -0,0 +1,204 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data
    ( Character
    , StarWarsException(..)
    , appearsIn
    , artoo
    , getDroid
    , getDroid'
    , getEpisode
    , getFriends
    , getHero
    , getHuman
    , id_
    , homePlanet
    , name_
    , secretBackstory
    , typeName
    ) where
 import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException)
 import Control.Applicative (Alternative(..), liftA2)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Data.Typeable (cast)
 import Language.GraphQL.Error
 import Language.GraphQL.Type
 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
 -- ** 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
 data StarWarsException = SecretBackstory | InvalidArguments
 instance Show StarWarsException where
    show SecretBackstory = "secretBackstory is secret."
    show InvalidArguments = "Invalid arguments."
 instance Exception StarWarsException where
    toException = toException . ResolverException
    fromException e = do
        ResolverException resolverException <- fromException e
        cast resolverException
 secretBackstory :: Resolve (Either SomeException)
 secretBackstory = throwM SecretBackstory
 typeName :: Character -> Text
 typeName = either (const "Droid") (const "Human")
 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
 getHuman :: ID -> Maybe Character
 getHuman = fmap Right . getHuman'
 getHuman' :: ID -> Maybe Human
 getHuman' "1000" = pure luke'
 getHuman' "1001" = pure vader
 getHuman' "1002" = pure han
 getHuman' "1003" = pure leia
 getHuman' "1004" = pure tarkin
 getHuman' _      = empty
 getDroid :: ID -> Maybe Character
 getDroid = fmap Left . getDroid'
 getDroid' :: ID -> Maybe 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 Text
 getEpisode 4 = pure "NEW_HOPE"
 getEpisode 5 = pure "EMPIRE"
 getEpisode 6 = pure "JEDI"
 getEpisode _ = empty
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@ -0,0 +1,366 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.StarWars.QuerySpec
    ( spec
    ) where
 import qualified Data.Aeson as Aeson
 import Data.Aeson ((.=))
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL
 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
            }
            }
        |]
        $ Aeson.object
            [ "data" .= Aeson.object
                [ "hero" .= Aeson.object ["id" .= ("2001" :: Text)]
                ]
            ]
      it "R2-D2 ID and friends" $ testQuery
        [r| query HeroNameAndFriendsQuery {
            hero {
                id
                name
                friends {
                  name
                }
            }
            }
        |]
        $ Aeson.object [ "data" .= Aeson.object [
            "hero" .= Aeson.object
                [ "id" .= ("2001" :: Text)
                , r2d2Name
                , "friends" .=
                    [ Aeson.object [lukeName]
                    , Aeson.object [hanName]
                    , Aeson.object [leiaName]
                    ]
                ]
        ]]
    describe "Nested Queries" $ do
      it "R2-D2 friends" $ testQuery
        [r| query NestedQuery {
              hero {
                name
                friends {
                  name
                  appearsIn
                  friends {
                    name
                  }
                }
              }
            }
        |]
        $ Aeson.object [ "data" .= Aeson.object [
          "hero" .= Aeson.object [
              "name" .= ("R2-D2" :: Text)
            , "friends" .= [
                  Aeson.object [
                      "name" .= ("Luke Skywalker" :: Text)
                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                    , "friends" .= [
                          Aeson.object [hanName]
                        , Aeson.object [leiaName]
                        , Aeson.object [c3poName]
                        , Aeson.object [r2d2Name]
                        ]
                    ]
                , Aeson.object [
                      hanName
                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                    , "friends" .=
                        [ Aeson.object [lukeName]
                        , Aeson.object [leiaName]
                        , Aeson.object [r2d2Name]
                        ]
                    ]
                , Aeson.object [
                      leiaName
                    , "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
                    , "friends" .=
                        [ Aeson.object [lukeName]
                        , Aeson.object [hanName]
                        , Aeson.object [c3poName]
                        , Aeson.object [r2d2Name]
                        ]
                    ]
                ]
            ]
        ]]
      it "Luke ID" $ testQuery
        [r| query FetchLukeQuery {
              human(id: "1000") {
                name
              }
            }
        |]
        $ Aeson.object [ "data" .= Aeson.object
            [ "human" .= Aeson.object [lukeName]
            ]]
    it "Luke ID with variable" $ testQueryParams
      (HashMap.singleton "someId" "1000")
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ Aeson.object [ "data" .= Aeson.object [
        "human" .= Aeson.object [lukeName]
      ]]
    it "Han ID with variable" $ testQueryParams
      (HashMap.singleton "someId" "1002")
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ Aeson.object [ "data" .= Aeson.object [
        "human" .= Aeson.object [hanName]
      ]]
    it "Invalid ID" $ testQueryParams
      (HashMap.singleton "id" "Not a valid ID")
      [r| query humanQuery($id: String!) {
            human(id: $id) {
              name
            }
          }
      |] $ Aeson.object ["data" .= Aeson.object ["human" .= Aeson.Null]]
    it "Luke aliased" $ testQuery
      [r| query FetchLukeAliased {
            luke: human(id: "1000") {
              name
            }
          }
      |]
      $ Aeson.object [ "data" .= Aeson.object [
       "luke" .= Aeson.object [lukeName]
      ]]
    it "R2-D2 ID and friends aliased" $ testQuery
      [r| query HeroNameAndFriendsQuery {
            hero {
              id
              name
              friends {
                friendName: name
              }
            }
          }
      |]
      $ Aeson.object [ "data" .= Aeson.object [
        "hero" .= Aeson.object [
            "id" .= ("2001" :: Text)
          , r2d2Name
          , "friends" .=
              [ Aeson.object ["friendName" .= ("Luke Skywalker" :: Text)]
              , Aeson.object ["friendName" .= ("Han Solo" :: Text)]
              , Aeson.object ["friendName" .= ("Leia Organa" :: Text)]
              ]
          ]
      ]]
    it "Luke and Leia aliased" $ testQuery
      [r| query FetchLukeAndLeiaAliased {
            luke: human(id: "1000") {
              name
            }
            leia: human(id: "1003") {
              name
            }
          }
      |]
      $ Aeson.object [ "data" .= Aeson.object
        [ "luke" .= Aeson.object [lukeName]
        , "leia" .= Aeson.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
              }
            }
        |]
        $ Aeson.object [ "data" .= Aeson.object [
          "luke" .= Aeson.object [lukeName, tatooine]
        , "leia" .= Aeson.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
            }
        |]
        $ Aeson.object [ "data" .= Aeson.object [
          "luke" .= Aeson.object [lukeName, tatooine]
        , "leia" .= Aeson.object [leiaName, alderaan]
        ]]
    describe "__typename" $ do
      it "R2D2 is a Droid" $ testQuery
        [r| query CheckTypeOfR2 {
              hero {
                __typename
                name
              }
            }
          |]
        $ Aeson.object ["data" .= Aeson.object [
            "hero" .= Aeson.object
                [ "__typename" .= ("Droid" :: Text)
                , r2d2Name
                ]
        ]]
      it "Luke is a human" $ testQuery
        [r| query CheckTypeOfLuke {
              hero(episode: EMPIRE) {
                __typename
                name
              }
            }
          |]
        $ Aeson.object ["data" .= Aeson.object [
            "hero" .= Aeson.object
                [ "__typename" .= ("Human" :: Text)
                , lukeName
                ]
        ]]
    describe "Errors in resolvers" $ do
        it "error on secretBackstory" $ testQuery
          [r|
            query HeroNameQuery {
              hero {
                name
                  secretBackstory
              }
            }
          |]
          $ Aeson.object
              [ "data" .= Aeson.object
                  [ "hero" .= Aeson.object
                      [ "name" .= ("R2-D2" :: Text)
                      , "secretBackstory" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ Aeson.object
                      ["message" .= ("secretBackstory is secret." :: Text)]
                  ]
              ]
        it "Error in a list" $ testQuery
          [r| query HeroNameQuery {
                hero {
                  name
                  friends {
                    name
                    secretBackstory
                  }
                }
              }
            |]
          $ Aeson.object ["data" .= Aeson.object
            [ "hero" .= Aeson.object
                [ "name" .= ("R2-D2" :: Text)
                , "friends" .=
                    [ Aeson.object
                        [ "name" .= ("Luke Skywalker" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , Aeson.object
                        [ "name" .= ("Han Solo" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , Aeson.object
                        [ "name" .= ("Leia Organa" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    ]
                ]
            ]
            , "errors" .=
                [ Aeson.object
                    [ "message" .= ("secretBackstory is secret." :: Text)
                    ]
                , Aeson.object
                    [ "message" .= ("secretBackstory is secret." :: Text)
                    ]
                , Aeson.object
                    [ "message" .= ("secretBackstory is secret." :: Text)
                    ]
                ]
            ]
        it "error on secretBackstory with alias" $ testQuery
          [r| query HeroNameQuery {
                mainHero: hero {
                  name
                  story: secretBackstory
                }
              }
            |]
          $ Aeson.object
              [ "data" .= Aeson.object
                  [ "mainHero" .= Aeson.object
                      [ "name" .= ("R2-D2" :: Text)
                      , "story" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ Aeson.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 =
    let Right (Right actual) = graphql schema q
     in Aeson.Object actual `shouldBe` expected
 testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected =
    let Right (Right actual) = graphqlSubs schema Nothing f q
     in Aeson.Object actual `shouldBe` expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -0,0 +1,154 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Test.StarWars.Schema
    ( schema
    ) where
 import Control.Monad.Catch (MonadThrow(..), SomeException)
 import Control.Monad.Trans.Reader (asks)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Test.StarWars.Data
 import Prelude hiding (id)
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 schema :: Schema (Either SomeException)
 schema = Schema
    { query = queryType
    , mutation = Nothing
    , subscription = Nothing
    }
  where
    queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
        [ ("hero", heroFieldResolver)
        , ("human", humanFieldResolver)
        , ("droid", droidFieldResolver)
        ]
    heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
        $ HashMap.singleton "episode"
        $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
    heroFieldResolver = ValueResolver heroField hero
    humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
        $ HashMap.singleton "id"
        $ In.Argument Nothing (In.NonNullScalarType string) Nothing
    humanFieldResolver = ValueResolver humanField human
    droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
    droidFieldResolver = ValueResolver droidField droid
 heroObject :: Out.ObjectType (Either SomeException)
 heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
    [ ("id", idFieldType)
    , ("name", nameFieldType)
    , ("friends", friendsFieldType)
    , ("appearsIn", appearsInField)
    , ("homePlanet", homePlanetFieldType)
    , ("secretBackstory", secretBackstoryFieldType)
    , ("__typename", typenameFieldType)
    ]
  where
    homePlanetFieldType
      = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
      $ idField "homePlanet"
 droidObject :: Out.ObjectType (Either SomeException)
 droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
    [ ("id", idFieldType)
    , ("name", nameFieldType)
    , ("friends", friendsFieldType)
    , ("appearsIn", appearsInField)
    , ("primaryFunction", primaryFunctionFieldType)
    , ("secretBackstory", secretBackstoryFieldType)
    , ("__typename", typenameFieldType)
    ]
  where
    primaryFunctionFieldType
        = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
        $ idField "primaryFunction"
 typenameFieldType :: Resolver (Either SomeException)
 typenameFieldType
    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
    $ idField "__typename"
 idFieldType :: Resolver (Either SomeException)
 idFieldType
    = ValueResolver (Out.Field Nothing (Out.NamedScalarType id) mempty)
    $ idField "id"
 nameFieldType :: Resolver (Either SomeException)
 nameFieldType
    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
    $ idField "name"
 friendsFieldType :: Resolver (Either SomeException)
 friendsFieldType
    = ValueResolver (Out.Field Nothing fieldType mempty)
    $ idField "friends"
  where
    fieldType = Out.ListType $ Out.NamedObjectType droidObject
 appearsInField :: Resolver (Either SomeException)
 appearsInField
    = ValueResolver (Out.Field (Just description) fieldType mempty)
    $ idField "appearsIn"
  where
    fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
    description = "Which movies they appear in."
 secretBackstoryFieldType :: Resolver (Either SomeException)
 secretBackstoryFieldType = ValueResolver field secretBackstory
  where
    field = Out.Field Nothing (Out.NamedScalarType string) mempty
 idField :: Text -> Resolve (Either SomeException)
 idField f = do
    v <- asks values
    let (Object v') = v
    pure $ v' HashMap.! f
 episodeEnum :: EnumType
 episodeEnum = EnumType "Episode" (Just description)
    $ HashMap.fromList [newHope, empire, jedi]
  where
    description = "One of the films in the Star Wars Trilogy"
    newHope = ("NEW_HOPE", EnumValue $ Just "Released in 1977.")
    empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
    jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
 hero :: Resolve (Either SomeException)
 hero = do
  episode <- argument "episode"
  pure $ character $ case episode of
      Enum "NEW_HOPE" -> getHero 4
      Enum "EMPIRE" -> getHero 5
      Enum "JEDI" -> getHero 6
      _ -> artoo
 human :: Resolve (Either SomeException)
 human = do
    id' <- argument "id"
    case id' of
        String i -> pure $ maybe Null character $ getHuman i >>= Just
        _ -> throwM InvalidArguments
 droid :: Resolve (Either SomeException)
 droid = do
    id' <- argument "id"
    case id' of
        String i -> pure $ maybe Null character $ getDroid i >>= Just
        _ -> throwM InvalidArguments
 character :: Character -> Value
 character char = Object $ HashMap.fromList
    [ ("id", String $ id_ char)
    , ("name", String $ name_ char)
    , ("friends", List $ character <$> getFriends char)
    , ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
    , ("homePlanet", String $ either mempty homePlanet char)
    , ("__typename", String $ typeName char)
    ]
--- a/tests/data/kitchen-sink.graphql
+++ b/tests/data/kitchen-sink.graphql
@ -0,0 +1,38 @@
 # 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
@ -0,0 +1 @@
 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}
		`@ -0,0 +1 @@`
							`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}`