Release 0.7.0.0

Separate Query and Mutation resolvers
Fixes #33 .
2020-05-11 12:34:48 +02:00 · 2020-05-10 18:32:58 +02:00 · 2020-04-12 08:32:39 +02:00 · 2020-04-10 11:19:36 +02:00 · 2020-03-31 10:04:34 +03:00 · 2020-02-20 05:16:14 +01:00
44 changed files with 4287 additions and 577 deletions
--- a/.ghci
+++ b/.ghci
@ -1,2 +0,0 @@
 import Data.Attoparsec.Text
 import qualified Data.Text.IO as TIO
--- a/.gitignore
+++ b/.gitignore
@ -1 +1,14 @@
 # Stack
 .stack-work/
 /stack.yaml.lock
 # Cabal
 /dist/
 /dist-newstyle/
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.project.local
 /graphql.cabal
 # GHC
 *.hi
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -1,6 +1,207 @@
-# Change Log
+# Changelog
 All notable changes to this project will be documented in this file.
 The format is based on
 [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 ## [Unreleased]
 ## [0.7.0.0] - 2020-05-11
 ### Fixed
 - Result of null encoding
 - Block strings encoding
 - Result of tab and newline encoding
 ### Added
 - AST for the GraphQL schema.
 - Type system definition parser.
 - `Trans.argument`.
 - Schema extension parser.
 - Contributing guidelines.
 - `Schema.resolversToMap` (intended for to be used internally).
 ### Changed
 - Rename `AST.Definition` into `AST.Document.ExecutableDefinition`.
  `AST.Document.TypeSystemDefinition` and `AST.Document.TypeSystemExtension`
  can also be definitions.
 - Move all AST data to `AST.Document` and reexport them.
 - Rename `AST.OperationSelectionSet` to `AST.Document.SelectionSet`.
 - Make `Schema.Subs` a `Data.HashMap.Strict` (was a function
  `key -> Maybe value` before).
 - Make `AST.Lexer.at` a text (symbol) parser. It was a char before and is
  `symbol "@"` now.
 - Replace `MonadIO` with a plain `Monad`. Since the tests don't use IO,
  set the inner monad to `Identity`.
 - `NonEmpty (Resolver m)` is now `HashMap Text (NonEmpty (Resolver m))`. Root
  operation type can be any type, therefore a hashmap is needed. Since types
  cannot be empty, we save the list of resolvers in the type as a non-empty
  list. Currently only "Query" and "Mutation" are supported as types. For more
  schema support is required. The executor checks now if the type in the query
  matches the type of the provided root resolvers.
 ### Removed
 - `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
  These types are only used in `AST.Selection` and `AST.Selection` contains now
  3 corresponding data constructors, `Field`, `InlineFragment` and
  `FragmentSpread`, instead of separate types. It simplifies pattern matching
  and doesn't make the code less typesafe.
 - `Schema.scalarA`.
 - `Schema.wrappedScalarA`.
 - `Schema.wrappedObjectA`.
 - `Schema.objectA`.
 - `AST.Argument`. Replaced with `AST.Arguments` which holds all arguments as a
  key/value map.
 ## [0.6.1.0] - 2019-12-23
 ### Fixed
 - Parsing multiple string arguments, such as
  `login(username: "username", password: "password")` would fail on the comma
  due to strings not having a space consumer.
 - Fragment spread is evaluated based on the `__typename` resolver. If the
  resolver is missing, it is assumed that the type condition is satisfied (all
  fragments are included).
 - Escaping characters during encoding.
 ### Added
 - Directive support (@skip and @include).
 - Pretifying multi-line string arguments as block strings.
 ## [0.6.0.0] - 2019-11-27
 ### Changed
 - `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`.
 - `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`.
 - `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`.
 - All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The
  module should be imported qualified.
 - All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed.
  The module should be imported qualified.
 - `Language.GraphQL.AST.Core.Object` is now just a HashMap.
 - `Language.GraphQL.AST.Transform` is isn't exposed publically anymore.
 - `Language.GraphQL.Schema.resolve` accepts a selection `Seq` (`Data.Sequence`)
  instead of a list. Selections are stored as sequences internally as well.
 - Add a reader instance to the resolver's monad stack. The Reader contains
  a Name/Value hashmap, which will contain resolver arguments.
 ### Added
 - Nested fragment support.
 ### Fixed
 - Consume ignored tokens after `$` and `!`. I mistakenly assumed that
  `$variable` is a single token, same as `Type!` is a single token. This is not
  the case, for example `Variable` is defined as `$ Name`, so these are two
  tokens, therefore whitespaces and commas after `$` and `!` should be
  consumed.
 ### Improved
 - `Language.GraphQL.AST.Parser.type_`: Try type parsers in a variable
  definition in a different order to avoid using `but`.
 ### Removed
 - `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
  instead.
 - `Language.GraphQL.AST.Directives`. Use `[Language.GraphQL.AST.Directives]`
  instead.
 - `Language.GraphQL.AST.VariableDefinitions`. Use
  `[Language.GraphQL.AST.VariableDefinition]` instead.
 - `Language.GraphQL.AST.FragmentName`. Use `Language.GraphQL.AST.Name` instead.
 - `Language.GraphQL.Execute.Schema` - It was a resolver list, not a schema.
 - `Language.GraphQL.Schema`: `enum`, `enumA`, `wrappedEnum` and `wrappedEnumA`.
  Use `scalar`, `scalarA`, `wrappedScalar` and `wrappedScalarA` instead.
 ## [0.5.1.0] - 2019-10-22
 ### Deprecated
 - `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
  instead.
 - `Language.GraphQL.AST.Directives`. Use `[Language.GraphQL.AST.Directives]`
  instead.
 - `Language.GraphQL.AST.VariableDefinitions`. Use
  `[Language.GraphQL.AST.VariableDefinition]` instead.
 ### Added
 - Module documentation.
 - Inline fragment support.
 ### Fixed
 - Top-level fragments.
 - Fragment for execution is chosen based on the type.
 ## [0.5.0.1] - 2019-09-10
 ### Added
 - Minimal documentation for all public symbols.
 ### Deprecated
 - `Language.GraphQL.AST.FragmentName`. Replaced with Language.GraphQL.AST.Name.
 - `Language.GraphQL.Execute.Schema` - It is not a schema (at least not a
  complete one), but a resolver list, and the resolvers should be provided by
  the user separately, because the schema can originate from a GraphQL
  document. `Schema` name should be free to provide a data type for the real
  schema later.
 - `Language.GraphQL.Schema`: `enum`, `enumA`, `wrappedEnum` and `wrappedEnumA`.
  There are actually only two generic types in GraphQL: Scalars and objects.
  Enum is a scalar value.
 ### Fixed
 - Parsing block string values.
 ## [0.5.0.0] - 2019-08-14
 ### Added
 - `executeWithName` executes an operation with the given name.
 - Export `Language.GraphQL.Encoder.definition`,
  `Language.GraphQL.Encoder.type'` and `Language.GraphQL.Encoder.directive`.
 - Export `Language.GraphQL.Encoder.value`. Escapes \ and " in strings now.
 ### Changed
 - `Operation` includes now possible operation name which allows to support
  documents with multiple operations.
 - `Language.GraphQL.Encoder.document` and other encoding functions take a
  `Formatter` as argument to distinguish between minified and pretty printing.
 - All encoder functions return `Data.Text.Lazy`.
 ### Removed
 - Unused `Language.GraphQL.Encoder.spaced`.
 ## [0.4.0.0] - 2019-07-23
 ### Added
 - Support for mutations.
 - Error handling (with monad transformers).
 - Nullable types.
 - Arbitrary nested lists support.
 - Potential BOM header parsing.
 ### Changed
 - attoparsec is replaced with megaparsec.
 - The library is now under `Language.GraphQL` (instead of `Data.GraphQL`).
 - HUnit and tasty are replaced with Hspec.
 - `Alternative`/`MonadPlus` resolver constraints are replaced with `MonadIO`.
 ### Removed
 - Duplicates from `Language.GraphQL.AST` already available in
  `Language.GraphQL.AST.Core`.
 - All module exports are now explicit, so private and help functions aren't
  exported anymore.
 ## [0.3] - 2015-09-22
 ### Changed
 - Exact match numeric types to spec.
 - Names follow now the spec.
 - AST slightly different for better readability or easier parsing.
 - Replace golden test for test to validate parsing/encoding.
 ### Added
 - Parsing errors in all cases where `Alternative` is used.
 - GraphQL encoder.
 ### Fixed
 - Expect braces `inputValueDefinitions` instead of parens when parsing.
 ## [0.2.1] - 2015-09-16
 ### Fixed
 - Include data files for golden tests in Cabal package.
 - Support for ghc-7.8.
 ## [0.2] - 2015-09-14
 ### Added
 - Rudimentary parser for `GraphQL` which successfully parses the sample file
@ -10,6 +211,18 @@ All notable changes to this project will be documented in this file.
 - Many optional data types in `GraphQl` didn't need to be wrapped in a `Maybe`.
 - Some `newtype`s became type synonyms for easier parsing.
-## [0.1] - 2015-09-12
+## 0.1 - 2015-09-12
 ### Added
 - Data types for the GraphQL language.
 [Unreleased]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...HEAD
 [0.7.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...v0.7.0.0
 [0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
 [0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
 [0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0
 [0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
 [0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0
 [0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
 [0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
 [0.2.1]: https://github.com/caraus-ecms/graphql/compare/v0.2...v0.2.1
 [0.2]: https://github.com/caraus-ecms/graphql/compare/v0.1...v0.2
--- 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/Data/GraphQL/AST.hs
+++ b/Data/GraphQL/AST.hs
@ -1,143 +0,0 @@
 module Data.GraphQL.AST where
 import Data.Text (Text)
 -- * Name
 type Name = Text
 -- * Document
 newtype Document = Document [Definition] deriving (Eq,Show)
 data Definition = DefinitionOperation OperationDefinition
                | DefinitionFragment  FragmentDefinition
                | DefinitionType      TypeDefinition
                  deriving (Eq,Show)
 data OperationDefinition =
    Query        Name [VariableDefinition] [Directive] SelectionSet
  | Mutation     Name [VariableDefinition] [Directive] SelectionSet
  -- Not official yet
  -- -- | Subscription Name [VariableDefinition] [Directive] SelectionSet
    deriving (Eq,Show)
 data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
                          deriving (Eq,Show)
 newtype Variable = Variable Name deriving (Eq,Show)
 type SelectionSet = [Selection]
 data Selection = SelectionField Field
               | SelectionFragmentSpread FragmentSpread
               | SelectionInlineFragment InlineFragment
                 deriving (Eq,Show)
 data Field = Field Alias Name [Argument]
                              [Directive]
                              SelectionSet
             deriving (Eq,Show)
 type Alias = Name
 data Argument = Argument Name Value deriving (Eq,Show)
 -- * Fragments
 data FragmentSpread = FragmentSpread Name [Directive]
                      deriving (Eq,Show)
 data InlineFragment =
    InlineFragment TypeCondition [Directive] SelectionSet
    deriving (Eq,Show)
 data FragmentDefinition =
    FragmentDefinition Name TypeCondition [Directive] SelectionSet
    deriving (Eq,Show)
 type TypeCondition = NamedType
 -- * Values
 data Value = ValueVariable Variable
           | ValueInt Int -- TODO: Should this be `Integer`?
           | ValueFloat Double -- TODO: Should this be `Scientific`?
           | ValueBoolean Bool
           | ValueString Text
           | ValueEnum Name
           | ValueList ListValue
           | ValueObject ObjectValue
             deriving (Eq,Show)
 newtype ListValue = ListValue [Value] deriving (Eq,Show)
 newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)
 data ObjectField = ObjectField Name Value deriving (Eq,Show)
 type DefaultValue = Value
 -- * Directives
 data Directive = Directive Name [Argument] deriving (Eq,Show)
 -- * Type Reference
 data Type = TypeNamed NamedType
          | TypeList ListType
          | TypeNonNull NonNullType
            deriving (Eq,Show)
 newtype NamedType = NamedType Name deriving (Eq,Show)
 newtype ListType = ListType Type deriving (Eq,Show)
 data NonNullType = NonNullTypeNamed NamedType
                 | NonNullTypeList  ListType
                   deriving (Eq,Show)
 -- * Type definition
 data TypeDefinition = TypeDefinitionObject        ObjectTypeDefinition
                    | TypeDefinitionInterface     InterfaceTypeDefinition
                    | TypeDefinitionUnion         UnionTypeDefinition
                    | TypeDefinitionScalar        ScalarTypeDefinition
                    | TypeDefinitionEnum          EnumTypeDefinition
                    | TypeDefinitionInputObject   InputObjectTypeDefinition
                    | TypeDefinitionTypeExtension TypeExtensionDefinition
                      deriving (Eq,Show)
 data ObjectTypeDefinition = ObjectTypeDefinition Name Interfaces [FieldDefinition]
                            deriving (Eq,Show)
 type Interfaces = [NamedType]
 data FieldDefinition = FieldDefinition Name ArgumentsDefinition Type
                       deriving (Eq,Show)
 type ArgumentsDefinition = [InputValueDefinition]
 data InputValueDefinition = InputValueDefinition Name Type (Maybe DefaultValue)
                            deriving (Eq,Show)
 data InterfaceTypeDefinition = InterfaceTypeDefinition Name [FieldDefinition]
                               deriving (Eq,Show)
 data UnionTypeDefinition = UnionTypeDefinition Name [NamedType]
                           deriving (Eq,Show)
 data ScalarTypeDefinition = ScalarTypeDefinition Name
                            deriving (Eq,Show)
 data EnumTypeDefinition = EnumTypeDefinition Name [EnumValueDefinition]
                          deriving (Eq,Show)
 newtype EnumValueDefinition = EnumValueDefinition Name
                              deriving (Eq,Show)
 data InputObjectTypeDefinition = InputObjectTypeDefinition Name [InputValueDefinition]
                                 deriving (Eq,Show)
 newtype TypeExtensionDefinition = TypeExtensionDefinition ObjectTypeDefinition
                                  deriving (Eq,Show)
--- a/Data/GraphQL/Parser.hs
+++ b/Data/GraphQL/Parser.hs
@ -1,322 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 module Data.GraphQL.Parser where
 import Prelude hiding (takeWhile)
 import Control.Applicative ((<|>), empty, many, optional)
 import Control.Monad (when)
 import Data.Char
 import Data.Text (Text, pack)
 import Data.Attoparsec.Text
  ( Parser
  , (<?>)
  , anyChar
  , decimal
  , double
  , endOfLine
  , many1
  , manyTill
  , option
  , peekChar
  , satisfy
  , sepBy1
  , signed
  )
 import Data.GraphQL.AST
 -- * Name
 -- XXX: Handle starting `_` and no number at the beginning:
 -- https://facebook.github.io/graphql/#sec-Names
 -- TODO: Use takeWhile1 instead for efficiency. With takeWhile1 there is no
 -- parsing failure.
 name :: Parser Name
 name = tok $ pack <$> many1 (satisfy isAlphaNum)
 -- * Document
 document :: Parser Document
 document = whiteSpace
     *> (Document <$> many1 definition)
    -- Try SelectionSet when no definition
    <|> (Document . pure
                  . DefinitionOperation
                  . Query mempty empty empty
                <$> selectionSet)
    <?> "document error!"
 definition :: Parser Definition
 definition = DefinitionOperation <$> operationDefinition
         <|> DefinitionFragment  <$> fragmentDefinition
         <|> DefinitionType      <$> typeDefinition
         <?> "definition error!"
 operationDefinition :: Parser OperationDefinition
 operationDefinition =
        op Query "query"
    <|> op Mutation "mutation"
    <?> "operationDefinition error!"
  where
    op f n = f <$ tok n <*> tok name
                        <*> optempty variableDefinitions
                        <*> optempty directives
                        <*> selectionSet
 variableDefinitions :: Parser [VariableDefinition]
 variableDefinitions = parens (many1 variableDefinition)
 variableDefinition :: Parser VariableDefinition
 variableDefinition =
    VariableDefinition <$> variable
                       <*  tok ":"
                       <*> type_
                       <*> optional defaultValue
 defaultValue :: Parser DefaultValue
 defaultValue = tok "=" *> value
 variable :: Parser Variable
 variable = Variable <$ tok "$" <*> name
 selectionSet :: Parser SelectionSet
 selectionSet = braces $ many1 selection
 selection :: Parser Selection
 selection = SelectionField <$> field
            -- Inline first to catch `on` case
        <|> SelectionInlineFragment <$> inlineFragment
        <|> SelectionFragmentSpread <$> fragmentSpread
        <?> "selection error!"
 field :: Parser Field
 field = Field <$> optempty alias
              <*> name
              <*> optempty arguments
              <*> optempty directives
              <*> optempty selectionSet
 alias :: Parser Alias
 alias = name <* tok ":"
 arguments :: Parser [Argument]
 arguments = parens $ many1 argument
 argument :: Parser Argument
 argument = Argument <$> name <* tok ":" <*> value
 -- * Fragments
 fragmentSpread :: Parser FragmentSpread
 -- TODO: Make sure it fails when `... on`.
 -- See https://facebook.github.io/graphql/#FragmentSpread
 fragmentSpread = FragmentSpread
    <$  tok "..."
    <*> name
    <*> optempty directives
 -- InlineFragment tried first in order to guard against 'on' keyword
 inlineFragment :: Parser InlineFragment
 inlineFragment = InlineFragment
    <$  tok "..."
    <*  tok "on"
    <*> typeCondition
    <*> optempty directives
    <*> selectionSet
 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
    <$  tok "fragment"
    <*> name
    <*  tok "on"
    <*> typeCondition
    <*> optempty directives
    <*> selectionSet
 typeCondition :: Parser TypeCondition
 typeCondition = namedType
 -- * Values
 -- This will try to pick the first type it can parse. If you are working with
 -- explicit types use the `typedValue` parser.
 value :: Parser Value
 value = ValueVariable <$> variable
        -- TODO: Handle arbitrary precision.
    <|> ValueInt     <$> tok (signed decimal)
    <|> ValueFloat   <$> tok (signed double)
    <|> ValueBoolean <$> bool
    -- TODO: Handle escape characters, unicode, etc
    <|> ValueString  <$> quotes name
    -- `true` and `false` have been tried before
    <|> ValueEnum    <$> name
    <|> ValueList    <$> listValue
    <|> ValueObject  <$> objectValue
 -- Notice it can be empty
 listValue :: Parser ListValue
 listValue = ListValue <$> brackets (many value)
 -- Notice it can be empty
 objectValue :: Parser ObjectValue
 objectValue = ObjectValue <$> braces (many objectField)
 objectField :: Parser ObjectField
 objectField = ObjectField <$> name <* tok ":" <*> value
 bool :: Parser Bool
 bool = True  <$ tok "true"
   <|> False <$ tok "false"
 -- * Directives
 directives :: Parser [Directive]
 directives = many1 directive
 directive :: Parser Directive
 directive = Directive
    <$  tok "@"
    <*> name
    <*> optempty arguments
 -- * Type Reference
 type_ :: Parser Type
 type_ = TypeNamed   <$> namedType
    <|> TypeList    <$> listType
    <|> TypeNonNull <$> nonNullType
 namedType :: Parser NamedType
 namedType = NamedType <$> name
 listType :: Parser ListType
 listType = ListType <$> brackets type_
 nonNullType :: Parser NonNullType
 nonNullType = NonNullTypeNamed <$> namedType <* tok "!"
          <|> NonNullTypeList  <$> listType  <* tok "!"
 -- * Type Definition
 typeDefinition :: Parser TypeDefinition
 typeDefinition =
        TypeDefinitionObject        <$> objectTypeDefinition
    <|> TypeDefinitionInterface     <$> interfaceTypeDefinition
    <|> TypeDefinitionUnion         <$> unionTypeDefinition
    <|> TypeDefinitionScalar        <$> scalarTypeDefinition
    <|> TypeDefinitionEnum          <$> enumTypeDefinition
    <|> TypeDefinitionInputObject   <$> inputObjectTypeDefinition
    <|> TypeDefinitionTypeExtension <$> typeExtensionDefinition
    <?> "typeDefinition error!"
 objectTypeDefinition :: Parser ObjectTypeDefinition
 objectTypeDefinition = ObjectTypeDefinition
    <$  tok "type"
    <*> name
    <*> optempty interfaces
    <*> fieldDefinitions
    <?> "objectTypeDefinition error!"
 interfaces :: Parser Interfaces
 interfaces = tok "implements" *> many1 namedType
 fieldDefinitions :: Parser [FieldDefinition]
 fieldDefinitions = braces $ many1 fieldDefinition
 fieldDefinition :: Parser FieldDefinition
 fieldDefinition = FieldDefinition
    <$> name
    <*> optempty argumentsDefinition
    <*  tok ":"
    <*> type_
 argumentsDefinition :: Parser ArgumentsDefinition
 argumentsDefinition = inputValueDefinitions
 inputValueDefinitions :: Parser [InputValueDefinition]
 inputValueDefinitions = parens $ many1 inputValueDefinition
 inputValueDefinition :: Parser InputValueDefinition
 inputValueDefinition = InputValueDefinition
    <$> name
    <*  tok ":"
    <*> type_
    <*> optional defaultValue
 interfaceTypeDefinition :: Parser InterfaceTypeDefinition
 interfaceTypeDefinition = InterfaceTypeDefinition
    <$  tok "interface"
    <*> name
    <*> fieldDefinitions
 unionTypeDefinition :: Parser UnionTypeDefinition
 unionTypeDefinition = UnionTypeDefinition
    <$  tok "union"
    <*> name
    <*  tok "="
    <*> unionMembers
 unionMembers :: Parser [NamedType]
 unionMembers = namedType `sepBy1` tok "|"
 scalarTypeDefinition :: Parser ScalarTypeDefinition
 scalarTypeDefinition = ScalarTypeDefinition
    <$  tok "scalar"
    <*> name
 enumTypeDefinition :: Parser EnumTypeDefinition
 enumTypeDefinition = EnumTypeDefinition
    <$  tok "enum"
    <*> name
    <*> enumValueDefinitions
 enumValueDefinitions :: Parser [EnumValueDefinition]
 enumValueDefinitions = braces $ many1 enumValueDefinition
 enumValueDefinition :: Parser EnumValueDefinition
 enumValueDefinition = EnumValueDefinition <$> name
 inputObjectTypeDefinition :: Parser InputObjectTypeDefinition
 inputObjectTypeDefinition = InputObjectTypeDefinition
    <$  tok "input"
    <*> name
    <*> inputValueDefinitions
 typeExtensionDefinition :: Parser TypeExtensionDefinition
 typeExtensionDefinition = TypeExtensionDefinition
    <$  tok "extend"
    <*> objectTypeDefinition
 -- * Internal
 tok :: Parser a -> Parser a
 tok p = p <* whiteSpace
 parens :: Parser a -> Parser a
 parens = between "(" ")"
 braces :: Parser a -> Parser a
 braces = between "{" "}"
 quotes :: Parser a -> Parser a
 quotes = between "\"" "\""
 brackets :: Parser a -> Parser a
 brackets = between "[" "]"
 between :: Parser Text -> Parser Text -> Parser a -> Parser a
 between open close p = tok open *> p <* tok close
 -- `empty` /= `pure mempty` for `Parser`.
 optempty :: Monoid a => Parser a -> Parser a
 optempty = option mempty
 -- ** WhiteSpace
 --
 whiteSpace :: Parser ()
 whiteSpace = peekChar >>= \case
    Just c -> if isSpace c || c == ','
              then anyChar *> whiteSpace
              else when (c == '#') $ manyTill anyChar endOfLine *> whiteSpace
    _ -> return ()
--- a/3
+++ b/3
@ -1,4 +1,5 @@
-Copyright J. Daniel Navarro (c) 2015
+Copyright 2019-2020 Eugen Wissner, Germany
 Copyright 2015-2017 J. Daniel Navarro
 All rights reserved.
--- a/README.md
+++ b/README.md
@ -1,25 +1,48 @@
 # Haskell GraphQL
 [![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql)
 [![Build Status](https://semaphoreci.com/api/v1/belka-ew/graphql/branches/master/badge.svg)](https://semaphoreci.com/belka-ew/graphql)
 [![License](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](https://raw.githubusercontent.com/caraus-ecms/graphql/master/LICENSE)
-For now this only provides the data types to represent the GraphQL AST,
+GraphQL implementation in Haskell.
 but the idea is to be a Haskell port of
 [`graphql-js`](https://github.com/graphql/graphql-js). Next releases
 should include:
- [x] GraphQL AST
+This implementation is relatively low-level by design, it doesn't provide any
- [x] Parser for the GraphQL language. See TODO for caveats.
+mappings between the GraphQL types and Haskell's type system and avoids
- [ ] GraphQL Schema AST.
+compile-time magic. It focuses on flexibility instead, so other solutions can
- [ ] Parser for the GraphQL Schema language.
+be built on top of it.
 - [ ] Interpreter of GraphQL requests.
 - [ ] Utilities to define GraphQL types and schema.
-See the TODO file for more concrete tasks.
+## State of the work
 For now this only provides a parser and a printer for the GraphQL query
 language and allows to execute queries and mutations without the schema
 validation step. But the idea is to be a Haskell port of
 [`graphql-js`](https://github.com/graphql/graphql-js).
 For the list of currently missing features see issues marked as
 "[not implemented](https://github.com/caraus-ecms/graphql/labels/not%20implemented)".
 ## Documentation
 API documentation is available through
 [Hackage](https://hackage.haskell.org/package/graphql).
 You'll also find a small tutorial with some examples under
 [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.
-Feel free to contact me, jdnavarro, on the #haskell channel on the
+Should you have questions on usage, please open an issue and ask – this helps
-[GraphQL Slack Server](https://graphql.slack.com). You can obtain an
+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/21
+++ b/21
@ -1,21 +0,0 @@
 ## AST
 - Simplify unnecessary `newtypes` with type synonyms
 - Data type accessors
 - Deal with Strictness/unboxing
 - Deal with Location
 ## Parser
 - Secure Names
 - Optimize `name` and `whiteSpace`: `take...`, `T.fold`, ...
 - Handle escape characters in string literals
 - Guard for `on` in `FragmentSpread`
 - Tests!
 - Handle `[Const]` grammar parameter. Need examples
 - Arbitrary precision for number values?
 - Handle errors. Perhaps port to `parsers` or use a lexer and
 `regex-applicative`
 ## Tests
 - Golden data within package, `path_graphql` macro.
 - Pretty Print golden result
--- a/docs/tutorial/tutorial.lhs
+++ b/docs/tutorial/tutorial.lhs
@ -0,0 +1,151 @@
 ---
 title: GraphQL Haskell Tutorial
 ---
 == Getting started ==
 Welcome to graphql-haskell!
 We have written a small tutorial to help you (and ourselves) understand the graphql package.
 Since this file is a literate haskell file, we start by importing some dependencies.
 > {-# LANGUAGE OverloadedStrings #-}
 > module Main where
 >
 > import Control.Monad.IO.Class (liftIO)
 > import Data.Aeson (encode)
 > import Data.ByteString.Lazy.Char8 (putStrLn)
 > import Data.HashMap.Strict (HashMap)
 > import qualified Data.HashMap.Strict as HashMap
 > import Data.List.NonEmpty (NonEmpty(..))
 > import Data.Text (Text)
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
 > import qualified Language.GraphQL.Schema as Schema
 >
 > 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 :: HashMap Text (NonEmpty (Schema.Resolver IO))
 > schema1 = HashMap.singleton "Query" $ hello :| []
 >
 > hello :: Schema.Resolver IO
 > hello = Schema.scalar "hello" (return ("it's me" :: Text))
 This defines a simple schema with one type and one field, that resolves to a fixed value.
 Next we define our query.
 > query1 :: Text
 > query1 = "{ hello }"
 To run the query, we call the `graphql` with the schema and the query.
 > main1 :: IO ()
 > main1 = putStrLn =<< encode <$> graphql schema1 query1
 This runs the query by fetching the one field defined,
 returning
 ```{"data" : {"hello":"it's me"}}```
 === Monadic actions ===
 For this example, we're going to be using time.
 > schema2 :: HashMap Text (NonEmpty (Schema.Resolver IO))
 > schema2 = HashMap.singleton "Query" $ time :| []
 >
 > time :: Schema.Resolver IO
 > time = Schema.scalar "time" $ do
 >   t <- liftIO getCurrentTime
 >   return $ 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 = putStrLn =<< encode <$> graphql schema2 query2
 This runs the query, returning the current time
 ```{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}```
 === Errors ===
 Errors are handled according to the spec,
 with fields that cause erros being resolved to `null`,
 and an error being added to the error list.
 An example of this is the following query:
 > queryShouldFail :: Text
 > queryShouldFail = "{ boyhowdy }"
 Since there is no `boyhowdy` field in our schema, it will not resolve,
 and the query will fail, as we can see in the following example.
 > mainShouldFail :: IO ()
 > mainShouldFail = do
 >   success <- graphql schema1 query1
 >   putStrLn $ encode success
 >   putStrLn "This will fail"
 >   failure <- graphql schema1 queryShouldFail
 >   putStrLn $ encode failure
 >
 This outputs:
 ```
 {"data": {"hello": "it's me"}}
 This will fail
 {"data": {"boyhowdy": null}, "errors":[{"message": "the field boyhowdy did not resolve."}]}
 ```
 === Combining resolvers ===
 Now that we have two resolvers, we can define a schema which uses them both.
 > schema3 :: HashMap Text (NonEmpty (Schema.Resolver IO))
 > schema3 = HashMap.singleton "Query" $ hello :| [time]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
 > main3 = putStrLn =<< encode <$> graphql schema3 query3
 This queries for both time and hello, returning
 ```{ "data": {"hello":"it's me","time":"2016-03-08 23:29:11.62108 UTC"}}```
 Notice that we can name our queries, as we did with `timeAndHello`. Since we have only been using single queries, we can use the shorthand `{ time hello}`, as we have been doing in the previous examples.
 In GraphQL there can only be one operation per query.
 == Further examples ==
 More examples on queries and a more complex schema can be found in the test directory,
 in the [Test.StarWars](../../tests/Test/StarWars) module. This includes a more complex schema, and more complex queries.
 > main :: IO ()
 > main = main1 >> main2 >> mainShouldFail >> main3
--- a/graphql.cabal
+++ b/graphql.cabal
@ -1,45 +0,0 @@
 name:                graphql
 version:             0.2
 synopsis:            Haskell GraphQL implementation
 description:
  This package provides a rudimentary parser for the
  <https://facebook.github.io/graphql/ GraphQL> language.
 homepage:            https://github.com/jdnavarro/graphql-haskell
 bug-reports:         https://github.com/jdnavarro/graphql-haskell/issues
 license:             BSD3
 license-file:        LICENSE
 author:              Danny Navarro
 maintainer:          j@dannynavarro.net
 copyright:           Copyright (C) 2015 J. Daniel Navarro
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 tested-with:         GHC == 7.10
 extra-source-files:  README.md CHANGELOG.md stack.yaml
 library
  default-language:    Haskell2010
  ghc-options:         -Wall
  exposed-modules:     Data.GraphQL.AST
                       Data.GraphQL.Parser
  build-depends:       base >= 4.7 && < 5,
                       text >=0.11.3.1,
                       attoparsec >=0.10.4.0
 test-suite golden
  default-language:    Haskell2010
  type:                exitcode-stdio-1.0
  hs-source-dirs:      tests
  main-is:             golden.hs
  ghc-options:         -Wall
  build-depends:       base >= 4.6 && <5,
                       bytestring,
                       text,
                       attoparsec,
                       tasty >=0.10,
                       tasty-golden,
                       graphql
 source-repository head
  type:     git
  location: git://github.com/jdnavarro/graphql-haskell.git
--- a/package.yaml
+++ b/package.yaml
@ -0,0 +1,58 @@
 name:                graphql
 version:             0.7.0.0
 synopsis:            Haskell GraphQL implementation
 description:
  This package provides a rudimentary parser for the
  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 maintainer:          belka@caraus.de
 github:              caraus-ecms/graphql
 category:            Language
 copyright:
 - (c) 2019-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>
 extra-source-files:
 - CHANGELOG.md
 - README.md
 - LICENSE
 - docs/tutorial/tutorial.lhs
 data-files:
 - tests/data/*.graphql
 - tests/data/*.min.graphql
 dependencies:
 - aeson
 - base >= 4.7 && < 5
 - containers
 - megaparsec
 - parser-combinators
 - text
 - transformers
 - unordered-containers
 library:
  source-dirs: src
  other-modules:
  - Language.GraphQL.Execute.Transform
  - Language.GraphQL.Type.Directive
 tests:
  tasty:
    main: Spec.hs
    source-dirs: tests
    ghc-options:
    - -threaded
    - -rtsopts
    - -with-rtsopts=-N
    dependencies:
    - graphql
    - hspec
    - hspec-expectations
    - hspec-megaparsec
    - QuickCheck
    - raw-strings-qq
--- a/semaphoreci.sh
+++ b/semaphoreci.sh
@ -0,0 +1,40 @@
 #!/bin/bash
 STACK=$SEMAPHORE_CACHE_DIR/stack
 export STACK_ROOT=$SEMAPHORE_CACHE_DIR/.stack
 setup() {
 	if [ ! -e "$STACK" ]
 	then
 		curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C $SEMAPHORE_CACHE_DIR '*/stack'
 	fi
 	if [ -e "$SEMAPHORE_CACHE_DIR/graphql.cabal" ]
 	then
 		cp -a $SEMAPHORE_CACHE_DIR/graphql.cabal graphql.cabal
 	fi
 	$STACK --no-terminal setup
 	cp -a graphql.cabal $SEMAPHORE_CACHE_DIR/graphql.cabal
 }
 setup_test() {
 	$STACK --no-terminal test --only-snapshot
 }
 test() {
 	$STACK --no-terminal test --pedantic
 }
 test_docs() {
 	$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
 	$STACK --no-terminal haddock --no-haddock-deps
 }
 setup_lint() {
 	$STACK --no-terminal install hlint
 }
 lint() {
 	$STACK --no-terminal exec hlint -- src tests
 }
 $1
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@ -0,0 +1,35 @@
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
    ( graphql
    , graphqlSubs
    ) where
 import qualified Data.Aeson as Aeson
 import Data.List.NonEmpty (NonEmpty)
 import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import Language.GraphQL.AST.Parser
 import qualified Language.GraphQL.Schema as Schema
 import Text.Megaparsec (parse)
 -- | If the text parses correctly as a @GraphQL@ query the query is
 -- executed using the given 'Schema.Resolver's.
 graphql :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m Aeson.Value -- ^ Response.
 graphql = flip graphqlSubs mempty
 -- | If the text parses correctly as a @GraphQL@ query the substitution is
 -- applied to the query and the query is then executed using to the given
 -- 'Schema.Resolver's.
 graphqlSubs :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
    -> Schema.Subs -- ^ Variable substitution function.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m Aeson.Value -- ^ Response.
 graphqlSubs schema f
    = either parseError (execute schema f)
    . parse document ""
--- a/src/Language/GraphQL/AST.hs
+++ b/src/Language/GraphQL/AST.hs
@ -0,0 +1,6 @@
 -- | Target AST for Parser.
 module Language.GraphQL.AST
    ( module Language.GraphQL.AST.Document
    ) where
 import Language.GraphQL.AST.Document
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@ -0,0 +1,78 @@
 -- | This is the AST meant to be executed.
 module Language.GraphQL.AST.Core
    ( Alias
    , Arguments(..)
    , Directive(..)
    , Document
    , Field(..)
    , Fragment(..)
    , Name
    , Operation(..)
    , Selection(..)
    , TypeCondition
    , Value(..)
    ) where
 import Data.Int (Int32)
 import Data.HashMap.Strict (HashMap)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Sequence (Seq)
 import Data.String (IsString(..))
 import Data.Text (Text)
 import Language.GraphQL.AST (Alias, Name, TypeCondition)
 -- | GraphQL document is a non-empty list of operations.
 type Document = NonEmpty Operation
 -- | GraphQL has 3 operation types: queries, mutations and subscribtions.
 --
 -- Currently only queries and mutations are supported.
 data Operation
    = Query (Maybe Text) (Seq Selection)
    | Mutation (Maybe Text) (Seq Selection)
    deriving (Eq, Show)
 -- | Single GraphQL field.
 data Field
    = Field (Maybe Alias) Name Arguments (Seq Selection)
    deriving (Eq, Show)
 -- | Argument list.
 newtype Arguments = Arguments (HashMap Name Value)
    deriving (Eq, Show)
 instance Semigroup Arguments where
    (Arguments x) <> (Arguments y) = Arguments $ x <> y
 instance Monoid Arguments where
    mempty = Arguments mempty
 -- | Directive.
 data Directive = Directive Name Arguments
    deriving (Eq, Show)
 -- | Represents fragments and inline fragments.
 data Fragment
    = Fragment TypeCondition (Seq Selection)
    deriving (Eq, Show)
 -- | Single selection element.
 data Selection
    = SelectionFragment Fragment
    | SelectionField Field
    deriving (Eq, Show)
 -- | Represents accordingly typed GraphQL values.
 data Value
    = Int Int32
    | Float Double -- ^ GraphQL Float is double precision
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value]
    | Object (HashMap Name Value)
    deriving (Eq, Show)
 instance IsString Value where
    fromString = String . fromString
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@ -0,0 +1,41 @@
 -- | Various parts of a GraphQL document can be annotated with directives. 
 --   This module describes locations in a document where directives can appear.
 module Language.GraphQL.AST.DirectiveLocation
    ( DirectiveLocation(..)
    , ExecutableDirectiveLocation(..)
    , TypeSystemDirectiveLocation(..)
    ) where
 -- | All directives can be splitted in two groups: directives used to annotate
 --   various parts of executable definitions and the ones used in the schema
 --   definition.
 data DirectiveLocation
    = ExecutableDirectiveLocation ExecutableDirectiveLocation
    | TypeSystemDirectiveLocation TypeSystemDirectiveLocation
    deriving (Eq, Show)
 -- | Where directives can appear in an executable definition, like a query.
 data ExecutableDirectiveLocation
    = Query
    | Mutation
    | Subscription
    | Field
    | FragmentDefinition
    | FragmentSpread
    | InlineFragment
    deriving (Eq, Show)
 -- | Where directives can appear in a type system definition.
 data TypeSystemDirectiveLocation
    = Schema
    | Scalar
    | Object
    | FieldDefinition
    | ArgumentDefinition
    | Interface
    | Union
    | Enum
    | EnumValue
    | InputObject
    | InputFieldDefinition
    deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@ -0,0 +1,486 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | 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
    ( Alias
    , Argument(..)
    , ArgumentsDefinition(..)
    , Definition(..)
    , Description(..)
    , Directive(..)
    , Document
    , EnumValueDefinition(..)
    , ExecutableDefinition(..)
    , FieldDefinition(..)
    , FragmentDefinition(..)
    , ImplementsInterfaces(..)
    , InputValueDefinition(..)
    , Name
    , NamedType
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
    , OperationType(..)
    , OperationTypeDefinition(..)
    , SchemaExtension(..)
    , Selection(..)
    , SelectionSet
    , SelectionSetOpt
    , Type(..)
    , TypeCondition
    , TypeDefinition(..)
    , TypeExtension(..)
    , TypeSystemDefinition(..)
    , TypeSystemExtension(..)
    , UnionMemberTypes(..)
    , Value(..)
    , VariableDefinition(..)
    ) where
 import Data.Foldable (toList)
 import Data.Int (Int32)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.DirectiveLocation
 -- * Language
 -- ** Source Text
 -- | Name.
 type Name = Text
 -- ** Document
 -- | GraphQL document.
 type Document = NonEmpty Definition
 -- | All kinds of definitions that can occur in a GraphQL document.
 data Definition
    = ExecutableDefinition ExecutableDefinition
    | TypeSystemDefinition TypeSystemDefinition
    | TypeSystemExtension TypeSystemExtension
    deriving (Eq, Show)
 -- | Top-level definition of a document, either an operation or a fragment.
 data ExecutableDefinition
    = DefinitionOperation OperationDefinition
    | DefinitionFragment FragmentDefinition
    deriving (Eq, Show)
 -- ** Operations
 -- | Operation definition.
 data OperationDefinition
    = SelectionSet SelectionSet
    | OperationDefinition
        OperationType
        (Maybe Name)
        [VariableDefinition]
        [Directive]
        SelectionSet
    deriving (Eq, Show)
 -- | GraphQL has 3 operation types:
 --
 -- * query - a read-only fetch.
 -- * mutation - a write operation followed by a fetch.
 -- * subscription - a long-lived request that fetches data in response to
 -- source events.
 --
 -- Currently only queries and mutations are supported.
 data OperationType = Query | Mutation deriving (Eq, Show)
 -- ** Selection Sets
 -- | "Top-level" selection, selection on an operation or fragment.
 type SelectionSet = NonEmpty Selection
 -- | Field selection.
 type SelectionSetOpt = [Selection]
 -- | Selection is a single entry in a selection set. It can be a single field,
 -- fragment spread or inline fragment.
 --
 -- The only required property of a field is its name. Optionally it can also
 -- have an alias, arguments, directives and a list of subfields.
 --
 -- In the following query "user" is a field with two subfields, "id" and "name":
 --
 -- @
 -- {
 --   user {
 --     id
 --     name
 --   }
 -- }
 -- @
 --
 -- A fragment spread refers to a fragment defined outside the operation and is
 -- expanded at the execution time.
 --
 -- @
 -- {
 --   user {
 --     ...userFragment
 --   }
 -- }
 --
 -- fragment userFragment on UserType {
 --   id
 --   name
 -- }
 -- @
 --
 -- 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
 -- | Single argument.
 --
 -- @
 -- {
 --   user(id: 4) {
 --     name
 --   }
 -- }
 -- @
 --
 --  Here "id" is an argument for the field "user" and its value is 4.
 data Argument = Argument Name Value deriving (Eq,Show)
 -- ** 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
    deriving (Eq, Show)
 -- | Type condition.
 type TypeCondition = Name
 -- ** Input Values
 -- | Input value.
 data Value
    = Variable Name
    | Int Int32
    | Float Double
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value]
    | Object [ObjectField]
    deriving (Eq, Show)
 -- | Key-value pair.
 --
 --   A list of 'ObjectField's represents a GraphQL object type.
 data ObjectField = ObjectField Name Value deriving (Eq, Show)
 -- ** Variables
 -- | Variable definition.
 data VariableDefinition = VariableDefinition Name Type (Maybe Value)
    deriving (Eq, Show)
 -- ** Type References
 -- | Type representation.
 data Type
    = TypeNamed Name
    | TypeList Type
    | TypeNonNull NonNullType
    deriving (Eq, Show)
 -- | Represents type names.
 type NamedType = Name
 -- | Helper type to represent Non-Null types and lists of such types.
 data NonNullType
    = NonNullTypeNamed Name
    | NonNullTypeList Type
    deriving (Eq, Show)
 -- ** Directives
 -- | Directive.
 --
 -- Directives begin with "@", can accept arguments, and can be applied to the
 -- most GraphQL elements, providing additional information.
 data Directive = Directive Name [Argument] deriving (Eq, Show)
 -- * Type System
 -- | Type system can define a schema, a type or a directive.
 --
 -- @
 -- schema {
 --   query: Query
 -- }
 --
 -- directive @example on FIELD_DEFINITION
 --
 -- type Query {
 --   field: String @example
 -- }
 -- @
 --
 -- This example defines a custom directive "@example", which is applied to a
 -- field definition of the type definition "Query". On the top the schema
 -- is defined by taking advantage of the type "Query".
 data TypeSystemDefinition
    = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
    | TypeDefinition TypeDefinition
    | DirectiveDefinition
        Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
    deriving (Eq, Show)
 -- ** Type System Extensions
 -- | Extension for a type system definition. Only schema and type definitions
 -- can be extended.
 data TypeSystemExtension
    = SchemaExtension SchemaExtension
    | TypeExtension TypeExtension
    deriving (Eq, Show)
 -- ** Schema
 -- | Root operation type definition.
 --
 -- Defining root operation types is not required since they have defaults. So
 -- the default query root type is "Query", and the default mutation root type
 -- is "Mutation". But these defaults can be changed for a specific schema. In
 -- the following code the query root type is changed to "MyQueryRootType", and
 -- the mutation root type to "MyMutationRootType":
 --
 -- @
 -- schema {
 --   query: MyQueryRootType
 --   mutation: MyMutationRootType
 -- }
 -- @
 data OperationTypeDefinition
    = OperationTypeDefinition OperationType NamedType
    deriving (Eq, Show)
 -- | Extension of the schema definition by further operations or directives.
 data SchemaExtension
    = SchemaOperationExtension [Directive] (NonEmpty OperationTypeDefinition)
    | SchemaDirectivesExtension (NonEmpty Directive)
    deriving (Eq, Show)
 -- ** Descriptions
 -- | GraphQL has built-in capability to document service APIs. Documentation
 -- is a GraphQL string that precedes a particular definition and contains
 -- Markdown. Any GraphQL definition can be documented this way.
 --
 -- @
 -- """
 -- Supported languages.
 -- """
 -- enum Language {
 --   "English"
 --   EN
 --
 --   "Russian"
 --   RU
 -- }
 -- @
 newtype Description = Description (Maybe Text)
    deriving (Eq, Show)
 -- ** Types
 -- | Type definitions describe various user-defined types.
 data TypeDefinition
    = ScalarTypeDefinition Description Name [Directive]
    | ObjectTypeDefinition
        Description
        Name
        (ImplementsInterfaces [])
        [Directive]
        [FieldDefinition]
    | InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
    | UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
    | EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
    | InputObjectTypeDefinition
        Description Name [Directive] [InputValueDefinition]
    deriving (Eq, Show)
 -- | Extensions for custom, already defined types.
 data TypeExtension
    = ScalarTypeExtension Name (NonEmpty Directive)
    | ObjectTypeFieldsDefinitionExtension
        Name (ImplementsInterfaces []) [Directive] (NonEmpty FieldDefinition)
    | ObjectTypeDirectivesExtension
        Name (ImplementsInterfaces []) (NonEmpty Directive)
    | ObjectTypeImplementsInterfacesExtension
        Name (ImplementsInterfaces NonEmpty)
    | InterfaceTypeFieldsDefinitionExtension
        Name [Directive] (NonEmpty FieldDefinition)
    | InterfaceTypeDirectivesExtension Name (NonEmpty Directive)
    | UnionTypeUnionMemberTypesExtension
        Name [Directive] (UnionMemberTypes NonEmpty)
    | UnionTypeDirectivesExtension Name (NonEmpty Directive)
    | EnumTypeEnumValuesDefinitionExtension
        Name [Directive] (NonEmpty EnumValueDefinition)
    | EnumTypeDirectivesExtension Name (NonEmpty Directive)
    | InputObjectTypeInputFieldsDefinitionExtension
        Name [Directive] (NonEmpty InputValueDefinition)
    | InputObjectTypeDirectivesExtension Name (NonEmpty Directive)
    deriving (Eq, Show)
 -- ** Objects
 -- | Defines a list of interfaces implemented by the given object type.
 --
 -- @
 -- type Business implements NamedEntity & ValuedEntity {
 --   name: String
 -- }
 -- @
 --
 -- Here the object type "Business" implements two interfaces: "NamedEntity" and
 -- "ValuedEntity".
 newtype ImplementsInterfaces t = ImplementsInterfaces (t NamedType)
 instance Foldable t => Eq (ImplementsInterfaces t) where
    (ImplementsInterfaces xs) == (ImplementsInterfaces ys)
        = toList xs == toList ys
 instance Foldable t => Show (ImplementsInterfaces t) where
    show (ImplementsInterfaces interfaces) = Text.unpack
        $ Text.append "implements"
        $ Text.intercalate " & "
        $ toList interfaces
 -- | Definition of a single field in a type.
 --
 -- @
 -- type Person {
 --   name: String
 --   picture(width: Int, height: Int): Url
 -- }
 -- @
 --
 -- "name" and "picture", including their arguments and types, are field
 -- definitions.
 data FieldDefinition
    = FieldDefinition Description Name ArgumentsDefinition Type [Directive]
    deriving (Eq, Show)
 -- | A list of values passed to a field.
 --
 -- @
 -- type Person {
 --   name: String
 --   picture(width: Int, height: Int): Url
 -- }
 -- @
 --
 -- "Person" has two fields, "name" and "picture". "name" doesn't have any
 -- arguments, so 'ArgumentsDefinition' contains an empty list. "picture"
 -- contains definitions for 2 arguments: "width" and "height".
 newtype ArgumentsDefinition = ArgumentsDefinition [InputValueDefinition]
    deriving (Eq, Show)
 instance Semigroup ArgumentsDefinition where
    (ArgumentsDefinition xs) <> (ArgumentsDefinition ys) =
        ArgumentsDefinition $ xs <> ys
 instance Monoid ArgumentsDefinition where
    mempty = ArgumentsDefinition []
 -- | Defines an input value.
 --
 -- * Input values can define field arguments, see 'ArgumentsDefinition'.
 -- * They can also be used as field definitions in an input type.
 --
 -- @
 -- input Point2D {
 --   x: Float
 --   y: Float
 -- }
 -- @
 --
 -- The input type "Point2D" contains two value definitions: "x" and "y".
 data InputValueDefinition
    = InputValueDefinition Description Name Type (Maybe Value) [Directive]
    deriving (Eq, Show)
 -- ** Unions
 -- | List of types forming a union.
 --
 -- @
 -- union SearchResult = Person | Photo
 -- @
 --
 -- "Person" and "Photo" are member types of the union "SearchResult".
 newtype UnionMemberTypes t = UnionMemberTypes (t NamedType)
 instance Foldable t => Eq (UnionMemberTypes t) where
    (UnionMemberTypes xs) == (UnionMemberTypes ys) = toList xs == toList ys
 instance Foldable t => Show (UnionMemberTypes t) where
    show (UnionMemberTypes memberTypes) = Text.unpack
        $ Text.intercalate " | "
        $ toList memberTypes
 -- ** Enums
 -- | Single value in an enum definition.
 --
 -- @
 -- enum Direction {
 --   NORTH
 --   EAST
 --   SOUTH
 --   WEST
 -- }
 -- @
 --
 -- "NORTH, "EAST", "SOUTH", and "WEST" are value definitions of an enum type
 -- definition "Direction".
 data EnumValueDefinition = EnumValueDefinition Description Name [Directive]
    deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@ -0,0 +1,344 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExplicitForAll #-}
 -- | This module defines a minifier and a printer for the @GraphQL@ language.
 module Language.GraphQL.AST.Encoder
    ( Formatter
    , definition
    , directive
    , document
    , minified
    , pretty
    , type'
    , value
    ) where
 import Data.Char (ord)
 import Data.Foldable (fold)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as Lazy (Text)
 import qualified Data.Text.Lazy as Lazy.Text
 import Data.Text.Lazy.Builder (Builder)
 import qualified Data.Text.Lazy.Builder as Builder
 import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
 import Data.Text.Lazy.Builder.RealFloat (realFloat)
 import qualified Language.GraphQL.AST as Full
 import Language.GraphQL.AST.Document
 -- | Instructs the encoder whether the GraphQL document should be minified or
 --   pretty printed.
 --
 --   Use 'pretty' or 'minified' to construct the formatter.
 data Formatter
    = Minified
    | Pretty Word
 -- | Constructs a formatter for pretty printing.
 pretty :: Formatter
 pretty = Pretty 0
 -- | Constructs a formatter for minifying.
 minified :: Formatter
 minified = Minified
 -- | Converts a Document' into a string.
 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 (ExecutableDefinition x) acc = definition formatter x : acc
    executableDefinition _ acc = acc
 -- | Converts a t'Full.ExecutableDefinition' into a string.
 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)
        = operationDefinition formatter operation
    encodeDefinition (Full.DefinitionFragment fragment)
        = fragmentDefinition formatter fragment
 -- | Converts a 'Full.OperationDefinition into a string.
 operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
 operationDefinition formatter (Full.SelectionSet sels)
    = selectionSet formatter sels
 operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
    = "query " <> node formatter name vars dirs sels
 operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
    = "mutation " <> node formatter name vars dirs sels
 -- | Converts a Full.Query or Full.Mutation into a string.
 node :: Formatter ->
    Maybe Full.Name ->
    [Full.VariableDefinition] ->
    [Full.Directive] ->
    Full.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 -> [Full.VariableDefinition] -> Lazy.Text
 variableDefinitions formatter
    = parensCommas formatter $ variableDefinition formatter
 variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
 variableDefinition formatter (Full.VariableDefinition var ty dv)
    = variable var
    <> eitherFormat formatter ": " ":"
    <> type' ty
    <> maybe mempty (defaultValue formatter) dv
 defaultValue :: Formatter -> Full.Value -> Lazy.Text
 defaultValue formatter val
    = eitherFormat formatter " = " "="
    <> value formatter val
 variable :: Full.Name -> Lazy.Text
 variable var = "$" <> Lazy.Text.fromStrict var
 selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
 selectionSet formatter
    = bracesList formatter (selection formatter)
    . NonEmpty.toList
 selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
 selectionSetOpt formatter = bracesList formatter $ selection formatter
 indentSymbol :: Lazy.Text
 indentSymbol = "  "
 indent :: (Integral a) => a -> Lazy.Text
 indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
 selection :: Formatter -> Full.Selection -> Lazy.Text
 selection formatter = Lazy.Text.append indent' . encodeSelection
  where
    encodeSelection (Full.Field alias name args directives' selections) =
        field incrementIndent alias name args directives' selections
    encodeSelection (Full.InlineFragment typeCondition directives' selections) =
        inlineFragment incrementIndent typeCondition directives' selections
    encodeSelection (Full.FragmentSpread name directives') =
        fragmentSpread incrementIndent name directives'
    incrementIndent
        | Pretty indentation <- formatter = Pretty $ indentation + 1
        | otherwise = Minified
    indent'
        | Pretty indentation <- formatter = indent $ indentation + 1
        | otherwise = ""
 colon :: Formatter -> Lazy.Text
 colon formatter = eitherFormat formatter ": " ":"
 -- | Converts Full.Field into a string
 field :: Formatter ->
    Maybe Full.Name ->
    Full.Name ->
    [Full.Argument] ->
    [Full.Directive] ->
    [Full.Selection] ->
    Lazy.Text
 field formatter alias name args dirs set
    = optempty prependAlias (fold alias)
    <> Lazy.Text.fromStrict name
    <> optempty (arguments formatter) args
    <> optempty (directives formatter) dirs
    <> optempty selectionSetOpt' set
  where
    prependAlias aliasName = Lazy.Text.fromStrict aliasName <>  colon formatter
    selectionSetOpt' = (eitherFormat formatter " " "" <>)
        . selectionSetOpt formatter
 arguments :: Formatter -> [Full.Argument] -> Lazy.Text
 arguments formatter = parensCommas formatter $ argument formatter
 argument :: Formatter -> Full.Argument -> Lazy.Text
 argument formatter (Full.Argument name value')
    = Lazy.Text.fromStrict name
    <> colon formatter
    <> value formatter value'
 -- * Fragments
 fragmentSpread :: Formatter -> Full.Name -> [Full.Directive] -> Lazy.Text
 fragmentSpread formatter name directives'
    = "..." <> Lazy.Text.fromStrict name
    <> optempty (directives formatter) directives'
 inlineFragment ::
    Formatter ->
    Maybe Full.TypeCondition ->
    [Full.Directive] ->
    Full.SelectionSet ->
    Lazy.Text
 inlineFragment formatter tc dirs sels = "... on "
    <> Lazy.Text.fromStrict (fold tc)
    <> directives formatter dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
 fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
    = "fragment " <> Lazy.Text.fromStrict name
    <> " on " <> Lazy.Text.fromStrict tc
    <> optempty (directives formatter) dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 -- * Miscellaneous
 -- | Converts a 'Full.Directive' into a string.
 directive :: Formatter -> Full.Directive -> Lazy.Text
 directive formatter (Full.Directive name args)
    = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
 directives :: Formatter -> [Full.Directive] -> Lazy.Text
 directives Minified = spaces (directive Minified)
 directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
 -- | Converts a 'Full.Value' into a string.
 value :: Formatter -> Full.Value -> Lazy.Text
 value _ (Full.Variable x) = variable x
 value _ (Full.Int x) = Builder.toLazyText $ decimal x
 value _ (Full.Float x) = Builder.toLazyText $ realFloat x
 value _ (Full.Boolean  x) = booleanValue x
 value _ Full.Null = "null"
 value formatter (Full.String string) = stringValue formatter string
 value _ (Full.Enum x) = Lazy.Text.fromStrict x
 value formatter (Full.List x) = listValue formatter x
 value formatter (Full.Object x) = objectValue formatter x
 booleanValue :: Bool -> Lazy.Text
 booleanValue True  = "true"
 booleanValue False = "false"
 quote :: Builder.Builder
 quote = Builder.singleton '\"'
 oneLine :: Text -> Builder
 oneLine string = quote <> Text.foldr (mappend . escape) quote string
 stringValue :: Formatter -> Text -> Lazy.Text
 stringValue Minified string = Builder.toLazyText
    $ quote <> Text.foldr (mappend . escape) quote string
 stringValue (Pretty indentation) string =
  if hasEscaped string
  then stringValue Minified string
  else Builder.toLazyText $ encoded lines'
    where
      isWhiteSpace char = char == ' ' || char == '\t'
      isNewline char = char == '\n' || char == '\r'
      hasEscaped = Text.any (not . isAllowed)
      isAllowed char =
          char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
      tripleQuote = Builder.fromText "\"\"\""
      start = tripleQuote <> Builder.singleton '\n'
      end = Builder.fromLazyText (indent indentation) <> tripleQuote
      strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
      lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
      encoded [] = oneLine string
      encoded [_] = oneLine string
      encoded lines'' = start <> transformLines lines'' <> end
      transformLines = foldr ((\line acc -> line <> Builder.singleton '\n' <> acc) . transformLine) mempty
      transformLine line =
        if Lazy.Text.null (Builder.toLazyText line)
        then line
        else Builder.fromLazyText (indent (indentation + 1)) <> line
 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 -> [Full.Value] -> Lazy.Text
 listValue formatter = bracketsCommas formatter $ value formatter
 objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text
 objectValue formatter = intercalate $ objectField formatter
  where
    intercalate f
        = braces
        . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
        . fmap f
 objectField :: Formatter -> Full.ObjectField -> Lazy.Text
 objectField formatter (Full.ObjectField name value') =
    Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
 -- | Converts a 'Full.Type' a type into a string.
 type' :: Full.Type -> Lazy.Text
 type' (Full.TypeNamed   x) = Lazy.Text.fromStrict x
 type' (Full.TypeList    x) = listType x
 type' (Full.TypeNonNull x) = nonNullType x
 listType :: Full.Type -> Lazy.Text
 listType x = brackets (type' x)
 nonNullType :: Full.NonNullType -> Lazy.Text
 nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
 nonNullType (Full.NonNullTypeList  x) = listType x <> "!"
 -- * Internal
 between :: Char -> Char -> Lazy.Text -> Lazy.Text
 between open close = Lazy.Text.cons open . (`Lazy.Text.snoc` close)
 parens :: Lazy.Text -> Lazy.Text
 parens = between '(' ')'
 brackets :: Lazy.Text -> Lazy.Text
 brackets = between '[' ']'
 braces :: Lazy.Text -> Lazy.Text
 braces = between '{' '}'
 spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
 spaces f = Lazy.Text.intercalate "\SP" . fmap f
 parensCommas :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
 parensCommas formatter f
    = parens
    . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
    . fmap f
 bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
 bracketsCommas formatter f
    = brackets
    . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
    . fmap f
 bracesList :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
 bracesList (Pretty intendation) f xs
    = Lazy.Text.snoc (Lazy.Text.intercalate "\n" content) '\n'
    <> (Lazy.Text.snoc $ Lazy.Text.replicate (fromIntegral intendation) "  ") '}'
  where
    content = "{" : fmap f xs
 bracesList Minified f xs = braces $ Lazy.Text.intercalate "," $ fmap f xs
 optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
 optempty f xs = if xs == mempty then mempty else f xs
 eitherFormat :: forall a. Formatter -> a -> a -> a
 eitherFormat (Pretty _) x _ = x
 eitherFormat Minified _ x = x
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@ -0,0 +1,236 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module defines a bunch of small parsers used to parse individual
 --   lexemes.
 module Language.GraphQL.AST.Lexer
    ( Parser
    , amp
    , at
    , bang
    , blockString
    , braces
    , brackets
    , colon
    , dollar
    , comment
    , equals
    , extend
    , integer
    , float
    , lexeme
    , name
    , parens
    , pipe
    , spaceConsumer
    , spread
    , string
    , symbol
    , unicodeBOM
    ) where
 import Control.Applicative (Alternative(..), liftA2)
 import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
 import Data.Foldable (foldl')
 import Data.List (dropWhileEnd)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Proxy (Proxy(..))
 import Data.Void (Void)
 import Text.Megaparsec ( Parsec
                       , (<?>)
                       , between
                       , chunk
                       , chunkToTokens
                       , notFollowedBy
                       , oneOf
                       , option
                       , optional
                       , satisfy
                       , sepBy
                       , skipSome
                       , takeP
                       , takeWhile1P
                       , try
                       )
 import Text.Megaparsec.Char (char, digitChar, space1)
 import qualified Text.Megaparsec.Char.Lexer as Lexer
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 -- | Standard parser.
 -- Accepts the type of the parsed token.
 type Parser = Parsec Void T.Text
 ignoredCharacters :: Parser ()
 ignoredCharacters = space1 <|> skipSome (char ',')
 -- | Parser that skips comments and meaningless characters, whitespaces and
 -- commas.
 spaceConsumer :: Parser ()
 spaceConsumer = Lexer.space ignoredCharacters comment empty
 -- | Parser for comments.
 comment :: Parser ()
 comment = Lexer.skipLineComment "#"
 -- | Lexeme definition which ignores whitespaces and commas.
 lexeme :: forall a. Parser a -> Parser a
 lexeme = Lexer.lexeme spaceConsumer
 -- | Symbol definition which ignores whitespaces and commas.
 symbol :: T.Text -> Parser T.Text
 symbol = Lexer.symbol spaceConsumer
 -- | Parser for "!".
 bang :: Parser T.Text
 bang = symbol "!"
 -- | Parser for "$".
 dollar :: Parser T.Text
 dollar = symbol "$"
 -- | Parser for "@".
 at :: Parser Text
 at = symbol "@"
 -- | Parser for "&".
 amp :: Parser T.Text
 amp = symbol "&"
 -- | Parser for ":".
 colon :: Parser T.Text
 colon = symbol ":"
 -- | Parser for "=".
 equals :: Parser T.Text
 equals = symbol "="
 -- | Parser for the spread operator (...).
 spread :: Parser T.Text
 spread = symbol "..."
 -- | Parser for "|".
 pipe :: Parser T.Text
 pipe = symbol "|"
 -- | Parser for an expression between "(" and ")".
 parens :: forall a. Parser a -> Parser a
 parens = between (symbol "(") (symbol ")")
 -- | Parser for an expression between "[" and "]".
 brackets :: forall a. Parser a -> Parser a
 brackets = between (symbol "[") (symbol "]")
 -- | Parser for an expression between "{" and "}".
 braces :: forall a. Parser a -> Parser a
 braces = between (symbol "{") (symbol "}")
 -- | Parser for strings.
 string :: Parser T.Text
 string = between "\"" "\"" stringValue <* spaceConsumer
  where
    stringValue = T.pack <$> many stringCharacter
    stringCharacter = satisfy isStringCharacter1
        <|> escapeSequence
    isStringCharacter1 = liftA2 (&&) isSourceCharacter isChunkDelimiter
 -- | Parser for block strings.
 blockString :: Parser T.Text
 blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
  where
    stringValue = do
        byLine <- sepBy (many blockStringCharacter) lineTerminator
        let indentSize = foldr countIndent 0 $ tail byLine
            withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
            withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
        return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
    removeEmptyLine [] = True
    removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
    removeEmptyLine _ = False
    blockStringCharacter
        = takeWhile1P Nothing isWhiteSpace
        <|> takeWhile1P Nothing isBlockStringCharacter1
        <|> escapeTripleQuote
        <|> try (chunk "\"" <* notFollowedBy (chunk "\"\""))
    escapeTripleQuote = chunk "\\" >>= flip option (chunk "\"\"")
    isBlockStringCharacter1 = liftA2 (&&) isSourceCharacter isChunkDelimiter
    countIndent [] acc = acc
    countIndent (x:_) acc
        | T.null x = acc
        | not (isWhiteSpace $ T.head x) = acc
        | acc == 0 = T.length x
        | otherwise = min acc $ T.length x
    removeIndent _ [] = []
    removeIndent n (x:chunks) = T.drop n x : chunks
 -- | Parser for integers.
 integer :: Integral a => Parser a
 integer = Lexer.signed (pure ()) $ lexeme Lexer.decimal
 -- | Parser for floating-point numbers.
 float :: Parser Double
 float = Lexer.signed (pure ()) $ lexeme Lexer.float
 -- | Parser for names (/[_A-Za-z][_0-9A-Za-z]*/).
 name :: Parser T.Text
 name = do
    firstLetter <- nameFirstLetter
    rest <- many $ nameFirstLetter <|> digitChar
    _ <- spaceConsumer
    return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
      where
        nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
 isChunkDelimiter :: Char -> Bool
 isChunkDelimiter = flip notElem ['"', '\\', '\n', '\r']
 isWhiteSpace :: Char -> Bool
 isWhiteSpace = liftA2 (||) (== ' ') (== '\t')
 lineTerminator :: Parser T.Text
 lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
 isSourceCharacter :: Char -> Bool
 isSourceCharacter = isSourceCharacter' . ord
  where
    isSourceCharacter' code = code >= 0x0020
                           || code == 0x0009
                           || code == 0x000a
                           || code == 0x000d
 escapeSequence :: Parser Char
 escapeSequence = do
    _ <- char '\\'
    escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
    case escaped of
        'b' -> return '\b'
        'f' -> return '\f'
        'n' -> return '\n'
        'r' -> return '\r'
        't' -> return '\t'
        'u' -> chr . foldl' step 0
                   . chunkToTokens (Proxy :: Proxy T.Text)
                 <$> takeP Nothing 4
        _ -> return escaped
  where
    step accumulator = (accumulator * 16 +) . digitToInt
 -- | Parser for the "Byte Order Mark".
 unicodeBOM :: Parser ()
 unicodeBOM = optional (char '\xfeff') >> pure ()
 -- | Parses "extend" followed by a 'symbol'. It is used by schema extensions.
 extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a
 extend token extensionLabel parsers
    = foldr combine headParser (NonEmpty.tail parsers)
    <?> extensionLabel
  where
    headParser = tryExtension $ NonEmpty.head parsers
    combine current accumulated = accumulated <|> tryExtension current
    tryExtension extensionParser = try
        $ symbol "extend"
        *> symbol token
        *> extensionParser
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@ -0,0 +1,485 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- | @GraphQL@ document parser.
 module Language.GraphQL.AST.Parser
    ( document
    ) where
 import Control.Applicative (Alternative(..), optional)
 import Control.Applicative.Combinators (sepBy1)
 import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import qualified Language.GraphQL.AST.DirectiveLocation as Directive
 import Language.GraphQL.AST.DirectiveLocation
    ( DirectiveLocation
    , ExecutableDirectiveLocation
    , TypeSystemDirectiveLocation
    )
 import Language.GraphQL.AST.Document
 import Language.GraphQL.AST.Lexer
 import Text.Megaparsec (lookAhead, option, try, (<?>))
 -- | Parser for the GraphQL documents.
 document :: Parser Document
 document = unicodeBOM
    >> spaceConsumer
    >> lexeme (NonEmpty.some definition)
 definition :: Parser Definition
 definition = ExecutableDefinition <$> executableDefinition
    <|> TypeSystemDefinition <$> typeSystemDefinition
    <|> TypeSystemExtension <$> typeSystemExtension
    <?> "Definition"
 executableDefinition :: Parser ExecutableDefinition
 executableDefinition = DefinitionOperation <$> operationDefinition
    <|> DefinitionFragment  <$> fragmentDefinition
    <?> "ExecutableDefinition"
 typeSystemDefinition :: Parser TypeSystemDefinition
 typeSystemDefinition = schemaDefinition
    <|> TypeDefinition <$> typeDefinition
    <|> directiveDefinition
    <?> "TypeSystemDefinition"
 typeSystemExtension :: Parser TypeSystemExtension
 typeSystemExtension = SchemaExtension <$> schemaExtension
    <|> TypeExtension <$> typeExtension
    <?> "TypeSystemExtension"
 directiveDefinition :: Parser TypeSystemDefinition
 directiveDefinition = DirectiveDefinition
    <$> description
    <* symbol "directive"
    <* at
    <*> name
    <*> argumentsDefinition
    <* symbol "on"
    <*> directiveLocations
    <?> "DirectiveDefinition"
 directiveLocations :: Parser (NonEmpty DirectiveLocation)
 directiveLocations = optional pipe
    *> directiveLocation `NonEmpty.sepBy1` pipe
 directiveLocation :: Parser DirectiveLocation
 directiveLocation
    = Directive.ExecutableDirectiveLocation <$> executableDirectiveLocation
    <|> Directive.TypeSystemDirectiveLocation <$> typeSystemDirectiveLocation
 executableDirectiveLocation :: Parser ExecutableDirectiveLocation
 executableDirectiveLocation = Directive.Query <$ symbol "QUERY"
    <|> Directive.Mutation <$ symbol "MUTATION"
    <|> Directive.Subscription <$ symbol "SUBSCRIPTION"
    <|> Directive.Field <$ symbol "FIELD"
    <|> Directive.FragmentDefinition <$ "FRAGMENT_DEFINITION"
    <|> Directive.FragmentSpread <$ "FRAGMENT_SPREAD"
    <|> Directive.InlineFragment <$ "INLINE_FRAGMENT"
 typeSystemDirectiveLocation :: Parser TypeSystemDirectiveLocation
 typeSystemDirectiveLocation = Directive.Schema <$ symbol "SCHEMA"
    <|> Directive.Scalar <$ symbol "SCALAR"
    <|> Directive.Object <$ symbol "OBJECT"
    <|> Directive.FieldDefinition <$ symbol "FIELD_DEFINITION"
    <|> Directive.ArgumentDefinition <$ symbol "ARGUMENT_DEFINITION"
    <|> Directive.Interface <$ symbol "INTERFACE"
    <|> Directive.Union <$ symbol "UNION"
    <|> Directive.Enum <$ symbol "ENUM"
    <|> Directive.EnumValue <$ symbol "ENUM_VALUE"
    <|> Directive.InputObject <$ symbol "INPUT_OBJECT"
    <|> Directive.InputFieldDefinition <$ symbol "INPUT_FIELD_DEFINITION"
 typeDefinition :: Parser TypeDefinition
 typeDefinition = scalarTypeDefinition
    <|> objectTypeDefinition
    <|> interfaceTypeDefinition
    <|> unionTypeDefinition
    <|> enumTypeDefinition
    <|> inputObjectTypeDefinition
    <?> "TypeDefinition"
 typeExtension :: Parser TypeExtension
 typeExtension = scalarTypeExtension
    <|> objectTypeExtension
    <|> interfaceTypeExtension
    <|> unionTypeExtension
    <|> enumTypeExtension
    <|> inputObjectTypeExtension
    <?> "TypeExtension"
 scalarTypeDefinition :: Parser TypeDefinition
 scalarTypeDefinition = ScalarTypeDefinition
    <$> description
    <* symbol "scalar"
    <*> name
    <*> directives
    <?> "ScalarTypeDefinition"
 scalarTypeExtension :: Parser TypeExtension
 scalarTypeExtension = extend "scalar" "ScalarTypeExtension"
    $ (ScalarTypeExtension <$> name <*> NonEmpty.some directive) :| []
 objectTypeDefinition :: Parser TypeDefinition
 objectTypeDefinition = ObjectTypeDefinition
    <$> description
    <* symbol "type"
    <*> name
    <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "ObjectTypeDefinition"
 objectTypeExtension :: Parser TypeExtension
 objectTypeExtension = extend "type" "ObjectTypeExtension"
    $ fieldsDefinitionExtension :|
        [ directivesExtension
        , implementsInterfacesExtension
        ]
  where
    fieldsDefinitionExtension = ObjectTypeFieldsDefinitionExtension
        <$> name
        <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
    directivesExtension = ObjectTypeDirectivesExtension
        <$> name
        <*> option (ImplementsInterfaces []) (implementsInterfaces sepBy1)
        <*> NonEmpty.some directive
    implementsInterfacesExtension = ObjectTypeImplementsInterfacesExtension
        <$> name
        <*> implementsInterfaces NonEmpty.sepBy1
 description :: Parser Description
 description = Description
    <$> optional (string <|> blockString)
    <?> "Description"
 unionTypeDefinition :: Parser TypeDefinition
 unionTypeDefinition = UnionTypeDefinition
    <$> description
    <* symbol "union"
    <*> name
    <*> directives
    <*> option (UnionMemberTypes []) (unionMemberTypes sepBy1)
    <?> "UnionTypeDefinition"
 unionTypeExtension :: Parser TypeExtension
 unionTypeExtension = extend "union" "UnionTypeExtension"
    $ unionMemberTypesExtension :| [directivesExtension]
  where
    unionMemberTypesExtension = UnionTypeUnionMemberTypesExtension
        <$> name
        <*> directives
        <*> unionMemberTypes NonEmpty.sepBy1
    directivesExtension = UnionTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 unionMemberTypes ::
    Foldable t =>
    (Parser Text -> Parser Text -> Parser (t NamedType)) ->
    Parser (UnionMemberTypes t)
 unionMemberTypes sepBy' = UnionMemberTypes
    <$ equals
    <* optional pipe
    <*> name `sepBy'` pipe
    <?> "UnionMemberTypes"
 interfaceTypeDefinition :: Parser TypeDefinition
 interfaceTypeDefinition = InterfaceTypeDefinition
    <$> description
    <* symbol "interface"
    <*> name
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "InterfaceTypeDefinition"
 interfaceTypeExtension :: Parser TypeExtension
 interfaceTypeExtension = extend "interface" "InterfaceTypeExtension"
    $ fieldsDefinitionExtension :| [directivesExtension]
  where
    fieldsDefinitionExtension = InterfaceTypeFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some fieldDefinition)
    directivesExtension = InterfaceTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 enumTypeDefinition :: Parser TypeDefinition
 enumTypeDefinition = EnumTypeDefinition
    <$> description
    <* symbol "enum"
    <*> name
    <*> directives
    <*> listOptIn braces enumValueDefinition
    <?> "EnumTypeDefinition"
 enumTypeExtension :: Parser TypeExtension
 enumTypeExtension = extend "enum" "EnumTypeExtension"
    $ enumValuesDefinitionExtension :| [directivesExtension]
  where
    enumValuesDefinitionExtension = EnumTypeEnumValuesDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some enumValueDefinition)
    directivesExtension = EnumTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 inputObjectTypeDefinition :: Parser TypeDefinition
 inputObjectTypeDefinition = InputObjectTypeDefinition
    <$> description
    <* symbol "input"
    <*> name
    <*> directives
    <*> listOptIn braces inputValueDefinition
    <?> "InputObjectTypeDefinition"
 inputObjectTypeExtension :: Parser TypeExtension
 inputObjectTypeExtension = extend "input" "InputObjectTypeExtension"
    $ inputFieldsDefinitionExtension :| [directivesExtension]
  where
    inputFieldsDefinitionExtension = InputObjectTypeInputFieldsDefinitionExtension
        <$> name
        <*> directives
        <*> braces (NonEmpty.some inputValueDefinition)
    directivesExtension = InputObjectTypeDirectivesExtension
        <$> name
        <*> NonEmpty.some directive
 enumValueDefinition :: Parser EnumValueDefinition
 enumValueDefinition = EnumValueDefinition
    <$> description
    <*> enumValue
    <*> directives
    <?> "EnumValueDefinition"
 implementsInterfaces ::
    Foldable t =>
    (Parser Text -> Parser Text -> Parser (t NamedType)) ->
    Parser (ImplementsInterfaces t)
 implementsInterfaces sepBy' = ImplementsInterfaces
    <$ symbol "implements"
    <* optional amp
    <*> name `sepBy'` amp
    <?> "ImplementsInterfaces"
 inputValueDefinition :: Parser InputValueDefinition
 inputValueDefinition = InputValueDefinition
    <$> description
    <*> name
    <* colon
    <*> type'
    <*> defaultValue
    <*> directives
    <?> "InputValueDefinition"
 argumentsDefinition :: Parser ArgumentsDefinition
 argumentsDefinition = ArgumentsDefinition
    <$> listOptIn parens inputValueDefinition
    <?> "ArgumentsDefinition"
 fieldDefinition :: Parser FieldDefinition
 fieldDefinition = FieldDefinition
    <$> description
    <*> name
    <*> argumentsDefinition
    <* colon
    <*> type'
    <*> directives
    <?> "FieldDefinition"
 schemaDefinition :: Parser TypeSystemDefinition
 schemaDefinition = SchemaDefinition
    <$ symbol "schema"
    <*> directives
    <*> operationTypeDefinitions
    <?> "SchemaDefinition"
 operationTypeDefinitions :: Parser (NonEmpty OperationTypeDefinition)
 operationTypeDefinitions = braces $ NonEmpty.some operationTypeDefinition
 schemaExtension :: Parser SchemaExtension
 schemaExtension = extend "schema" "SchemaExtension"
    $ schemaOperationExtension :| [directivesExtension]
  where
    directivesExtension = SchemaDirectivesExtension
        <$> NonEmpty.some directive
    schemaOperationExtension = SchemaOperationExtension
        <$> directives
        <*> operationTypeDefinitions
 operationTypeDefinition :: Parser OperationTypeDefinition
 operationTypeDefinition = OperationTypeDefinition
    <$> operationType <* colon
    <*> name
    <?> "OperationTypeDefinition"
 operationDefinition :: Parser OperationDefinition
 operationDefinition = SelectionSet <$> selectionSet
    <|> operationDefinition'
    <?> "operationDefinition error"
  where
    operationDefinition'
        = OperationDefinition <$> operationType
        <*> optional name
        <*> variableDefinitions
        <*> directives
        <*> selectionSet
 operationType :: Parser OperationType
 operationType = Query <$ symbol "query"
    <|> Mutation <$ symbol "mutation"
    -- <?> Keep default error message
 -- * SelectionSet
 selectionSet :: Parser SelectionSet
 selectionSet = braces $ NonEmpty.some selection
 selectionSetOpt :: Parser SelectionSetOpt
 selectionSetOpt = listOptIn braces selection
 selection :: Parser Selection
 selection = field
    <|> try fragmentSpread
    <|> inlineFragment
    <?> "selection error!"
 -- * Field
 field :: Parser Selection
 field = Field
    <$> optional alias
    <*> name
    <*> arguments
    <*> directives
    <*> selectionSetOpt
 alias :: Parser Alias
 alias = try $ name <* colon
 -- * Arguments
 arguments :: Parser [Argument]
 arguments = listOptIn parens argument
 argument :: Parser Argument
 argument = Argument <$> name <* colon <*> value
 -- * Fragments
 fragmentSpread :: Parser Selection
 fragmentSpread = FragmentSpread
    <$ spread
    <*> fragmentName
    <*> directives
 inlineFragment :: Parser Selection
 inlineFragment = InlineFragment
    <$ spread
    <*> optional typeCondition
    <*> directives
    <*> selectionSet
 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
                 <$  symbol "fragment"
                 <*> name
                 <*> typeCondition
                 <*> directives
                 <*> selectionSet
 fragmentName :: Parser Name
 fragmentName = but (symbol "on") *> name
 typeCondition :: Parser TypeCondition
 typeCondition = symbol "on" *> name
 -- * Input Values
 value :: Parser Value
 value = Variable <$> variable
    <|> Float    <$> try float
    <|> Int      <$> integer
    <|> Boolean  <$> booleanValue
    <|> Null     <$  symbol "null"
    <|> String   <$> blockString
    <|> String   <$> string
    <|> Enum     <$> try enumValue
    <|> List     <$> listValue
    <|> Object   <$> objectValue
    <?> "value error!"
  where
    booleanValue :: Parser Bool
    booleanValue = True  <$ symbol "true"
               <|> False <$ symbol "false"
    listValue :: Parser [Value]
    listValue = brackets $ some value
    objectValue :: Parser [ObjectField]
    objectValue = braces $ some objectField
 enumValue :: Parser Name
 enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
 objectField :: Parser ObjectField
 objectField = ObjectField <$> name <* colon <*> value
 -- * Variables
 variableDefinitions :: Parser [VariableDefinition]
 variableDefinitions = listOptIn parens variableDefinition
 variableDefinition :: Parser VariableDefinition
 variableDefinition = VariableDefinition
    <$> variable
    <*  colon
    <*> type'
    <*> defaultValue
    <?> "VariableDefinition"
 variable :: Parser Name
 variable = dollar *> name
 defaultValue :: Parser (Maybe Value)
 defaultValue = optional (equals *> value) <?> "DefaultValue"
 -- * Input Types
 type' :: Parser Type
 type' = try (TypeNonNull <$> nonNullType)
    <|> TypeList <$> brackets type'
    <|> TypeNamed <$> name
    <?> "Type"
 nonNullType :: Parser NonNullType
 nonNullType = NonNullTypeNamed <$> name <* bang
          <|> NonNullTypeList  <$> brackets type'  <* bang
          <?> "nonNullType error!"
 -- * Directives
 directives :: Parser [Directive]
 directives = many directive
 directive :: Parser Directive
 directive = Directive
    <$  at
    <*> name
    <*> arguments
 -- * Internal
 listOptIn :: (Parser [a] -> Parser [a]) -> Parser a -> Parser [a]
 listOptIn surround = option [] . surround . some
 -- Hack to reverse parser success
 but :: Parser a -> Parser ()
 but pn = False <$ lookAhead pn <|> pure True >>= \case
    False -> empty
    True  -> pure ()
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -0,0 +1,88 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | Error handling.
 module Language.GraphQL.Error
    ( parseError
    , CollectErrsT
    , addErr
    , addErrMsg
    , runCollectErrs
    , runAppendErrs
    , singleError
    ) where
 import qualified Data.Aeson as Aeson
 import Data.Text (Text)
 import Data.Void (Void)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.State ( StateT
                                 , modify
                                 , runStateT
                                 )
 import Text.Megaparsec
    ( ParseErrorBundle(..)
    , PosState(..)
    , SourcePos(..)
    , errorOffset
    , parseErrorTextPretty
    , reachOffset
    , unPos
    )
 -- | Wraps a parse error into a list of errors.
 parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
 parseError ParseErrorBundle{..}  =
    pure $ Aeson.object [("errors", Aeson.toJSON $ fst $ foldl go ([], bundlePosState) bundleErrors)]
  where
    errorObject s SourcePos{..} = Aeson.object
        [ ("message", Aeson.toJSON $ init $ parseErrorTextPretty s)
        , ("line", Aeson.toJSON $ unPos sourceLine)
        , ("column", Aeson.toJSON $ unPos sourceColumn)
        ]
    go (result, state) x =
        let (_, newState) = reachOffset (errorOffset x) state
            sourcePosition = pstateSourcePos newState
         in (errorObject x sourcePosition : result, newState)
 -- | A wrapper to pass error messages around.
 type CollectErrsT m = StateT [Aeson.Value] m
 -- | Adds an error to the list of errors.
 addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
 addErr v = modify (v :)
 makeErrorMessage :: Text -> Aeson.Value
 makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
 -- | Constructs a response object containing only the error with the given
 --   message.
 singleError :: Text -> Aeson.Value
 singleError message = Aeson.object
    [ ("errors", Aeson.toJSON [makeErrorMessage message])
    ]
 -- | Convenience function for just wrapping an error message.
 addErrMsg :: Monad m => Text -> CollectErrsT m ()
 addErrMsg = addErr . makeErrorMessage
 -- | Appends the given list of errors to the current list of errors.
 appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
 appendErrs errs = modify (errs ++)
 -- | Runs the given query computation, but collects the errors into an error
 --   list, which is then sent back with the data.
 runCollectErrs :: Monad m => CollectErrsT m Aeson.Value -> m Aeson.Value
 runCollectErrs res = do
    (dat, errs) <- runStateT res []
    if null errs
       then return $ Aeson.object [("data", dat)]
       else return $ Aeson.object [("data", dat), ("errors", Aeson.toJSON $ reverse errs)]
 -- | Runs the given computation, collecting the errors and appending them
 --   to the previous list of errors.
 runAppendErrs :: Monad m => CollectErrsT m a -> CollectErrsT m a
 runAppendErrs f = do
    (v, errs) <- lift $ runStateT f []
    appendErrs errs
    return v
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -0,0 +1,86 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
    ( execute
    , executeWithName
    ) where
 import qualified Data.Aeson as Aeson
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
 import qualified Language.GraphQL.AST.Core as AST.Core
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Schema as Schema
 -- | The substitution is applied to the document, and the resolvers are applied
 -- to the resulting fields.
 --
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
 execute :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
    -> Schema.Subs -- ^ Variable substitution function.
    -> Document -- @GraphQL@ document.
    -> m Aeson.Value
 execute schema subs doc =
    maybe transformError (document schema Nothing)
        $ Transform.document subs doc
  where
    transformError = return $ singleError "Schema transformation error."
 -- | The substitution is applied to the document, and the resolvers are applied
 -- to the resulting fields. The operation name can be used if the document
 -- defines multiple root operations.
 --
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
 executeWithName :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers
    -> Text -- ^ Operation name.
    -> Schema.Subs -- ^ Variable substitution function.
    -> Document -- ^ @GraphQL@ Document.
    -> m Aeson.Value
 executeWithName schema name subs doc =
    maybe transformError (document schema $ Just name)
        $ Transform.document subs doc
  where
    transformError = return $ singleError "Schema transformation error."
 document :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m))
    -> Maybe Text
    -> AST.Core.Document
    -> m Aeson.Value
 document schema Nothing (op :| []) = operation schema op
 document schema (Just name) operations = case NonEmpty.dropWhile matchingName operations of
    [] -> return $ singleError
        $ Text.unwords ["Operation", name, "couldn't be found in the document."]
    (op:_)  -> operation schema op
  where
    matchingName (AST.Core.Query (Just name') _) = name == name'
    matchingName (AST.Core.Mutation (Just name') _) = name == name'
    matchingName _ = False
 document _ _ _ = return $ singleError "Missing operation name."
 operation :: Monad m
    => HashMap Text (NonEmpty (Schema.Resolver m))
    -> AST.Core.Operation
    -> m Aeson.Value
 operation schema = schemaOperation
  where
    runResolver fields = runCollectErrs
        . flip Schema.resolve fields
        . Schema.resolversToMap
    resolve fields queryType = maybe lookupError (runResolver fields)
        $ HashMap.lookup queryType schema
    lookupError = pure
        $ singleError "Root operation type couldn't be found in the schema."
    schemaOperation (AST.Core.Query _ fields) = resolve fields "Query"
    schemaOperation (AST.Core.Mutation _ fields) = resolve fields "Mutation"
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -0,0 +1,167 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE TupleSections #-}
 -- | After the document is parsed, before getting executed the AST is
 --   transformed into a similar, simpler AST. This module is responsible for
 --   this transformation.
 module Language.GraphQL.Execute.Transform
    ( document
    ) where
 import Control.Arrow (first)
 import Control.Monad (foldM, unless)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
 import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Sequence (Seq, (<|), (><))
 import qualified Language.GraphQL.AST as Full
 import qualified Language.GraphQL.AST.Core as Core
 import Language.GraphQL.AST.Document (Definition(..), Document)
 import qualified Language.GraphQL.Schema as Schema
 import qualified Language.GraphQL.Type.Directive as Directive
 -- | Associates a fragment name with a list of 'Core.Field's.
 data Replacement = Replacement
    { fragments :: HashMap Core.Name Core.Fragment
    , fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
    }
 type TransformT a = StateT Replacement (ReaderT Schema.Subs Maybe) a
 liftJust :: forall a. a -> TransformT a
 liftJust = lift . lift . Just
 -- | Rewrites the original syntax tree into an intermediate representation used
 -- for query execution.
 document :: Schema.Subs -> Document -> Maybe Core.Document
 document subs document' =
    flip runReaderT subs
        $ evalStateT (collectFragments >> operations operationDefinitions)
        $ Replacement HashMap.empty fragmentTable
  where
    (fragmentTable, operationDefinitions) = foldr defragment mempty document'
    defragment (ExecutableDefinition (Full.DefinitionOperation definition)) acc =
        (definition :) <$> acc
    defragment (ExecutableDefinition (Full.DefinitionFragment definition)) acc =
        let (Full.FragmentDefinition name _ _ _) = definition
         in first (HashMap.insert name definition) acc
    defragment _ acc = acc
 -- * Operation
 operations :: [Full.OperationDefinition] -> TransformT Core.Document
 operations operations' = do
    coreOperations <- traverse operation operations'
    lift . lift $ NonEmpty.nonEmpty coreOperations
 operation :: Full.OperationDefinition -> TransformT Core.Operation
 operation (Full.SelectionSet sels)
    = operation $ Full.OperationDefinition Full.Query mempty mempty mempty sels
 operation (Full.OperationDefinition Full.Query name _vars _dirs sels)
    = Core.Query name <$> appendSelection sels
 operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels)
    = Core.Mutation name <$> appendSelection sels
 -- * Selection
 selection ::
    Full.Selection ->
    TransformT (Either (Seq Core.Selection) Core.Selection)
 selection (Full.Field alias name arguments' directives' selections) =
    maybe (Left mempty) (Right . Core.SelectionField) <$> do
        fieldArguments <- arguments arguments'
        fieldSelections <- appendSelection selections
        fieldDirectives <- Directive.selection <$> directives directives'
        let field' = Core.Field alias name fieldArguments fieldSelections
        pure $ field' <$ fieldDirectives
 selection (Full.FragmentSpread name directives') =
    maybe (Left mempty) (Right . Core.SelectionFragment) <$> do
        spreadDirectives <- Directive.selection <$> directives directives'
        fragments' <- gets fragments
        fragment <- maybe lookupDefinition liftJust (HashMap.lookup name fragments')
        pure $ fragment <$ spreadDirectives
  where
    lookupDefinition = do
        fragmentDefinitions' <- gets fragmentDefinitions
        found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
        fragmentDefinition found
 selection (Full.InlineFragment type' directives' selections) = do
    fragmentDirectives <- Directive.selection <$> directives directives'
    case fragmentDirectives of
        Nothing -> pure $ Left mempty
        _ -> do
            fragmentSelectionSet <- appendSelection selections
            pure $ maybe Left selectionFragment type' fragmentSelectionSet
  where
    selectionFragment typeName = Right
        . Core.SelectionFragment
        . Core.Fragment typeName
 appendSelection ::
    Traversable t =>
    t Full.Selection ->
    TransformT (Seq Core.Selection)
 appendSelection = foldM go mempty
  where
    go acc sel = append acc <$> selection sel
    append acc (Left list) = list >< acc
    append acc (Right one) = one <| acc
 directives :: [Full.Directive] -> TransformT [Core.Directive]
 directives = traverse directive
  where
    directive (Full.Directive directiveName directiveArguments) =
        Core.Directive directiveName <$> arguments directiveArguments
 -- * Fragment replacement
 -- | Extract fragment definitions into a single 'HashMap'.
 collectFragments :: TransformT ()
 collectFragments = do
    fragDefs <- gets fragmentDefinitions
    let nextValue = head $ HashMap.elems fragDefs
    unless (HashMap.null fragDefs) $ do
        _ <- fragmentDefinition nextValue
        collectFragments
 fragmentDefinition ::
    Full.FragmentDefinition ->
    TransformT Core.Fragment
 fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
    modify deleteFragmentDefinition
    fragmentSelection <- appendSelection selections
    let newValue = Core.Fragment type' fragmentSelection
    modify $ insertFragment newValue
    liftJust newValue
  where
    deleteFragmentDefinition (Replacement fragments' fragmentDefinitions') =
        Replacement fragments' $ HashMap.delete name fragmentDefinitions'
    insertFragment newValue (Replacement fragments' fragmentDefinitions') =
        let newFragments = HashMap.insert name newValue fragments'
         in Replacement newFragments fragmentDefinitions'
 arguments :: [Full.Argument] -> TransformT Core.Arguments
 arguments = fmap Core.Arguments . foldM go HashMap.empty
  where
    go arguments' (Full.Argument name value') = do
        substitutedValue <- value value'
        return $ HashMap.insert name substitutedValue arguments'
 value :: Full.Value -> TransformT Core.Value
 value (Full.Variable name) = lift (asks $ HashMap.lookup name) >>= lift . lift
 value (Full.Int i) = pure $ Core.Int i
 value (Full.Float f) = pure $ Core.Float f
 value (Full.String x) = pure $ Core.String x
 value (Full.Boolean b) = pure $ Core.Boolean b
 value Full.Null = pure   Core.Null
 value (Full.Enum e) = pure $ Core.Enum e
 value (Full.List l) =
    Core.List <$> traverse value l
 value (Full.Object o) =
    Core.Object . HashMap.fromList <$> traverse objectField o
 objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
 objectField (Full.ObjectField name value') = (name,) <$> value value'
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@ -0,0 +1,138 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Schema
    ( Resolver(..)
    , Subs
    , object
    , resolve
    , resolversToMap
    , scalar
    , wrappedObject
    , wrappedScalar
    -- * AST Reexports
    , Field
    , Value(..)
    ) where
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Control.Monad.Trans.Reader (runReaderT)
 import Data.Foldable (fold, toList)
 import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Language.GraphQL.AST.Core
 import Language.GraphQL.Error
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
 --   information (if an error has occurred). @m@ is an arbitrary monad, usually
 --   'IO'.
 data Resolver m = Resolver
    Text -- ^ Name
    (Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
 -- | Converts resolvers to a map.
 resolversToMap
    :: (Foldable f, Functor f)
    => f (Resolver m)
    -> HashMap Text (Field -> CollectErrsT m Aeson.Object)
 resolversToMap = HashMap.fromList . toList . fmap toKV
  where
    toKV (Resolver name f) = (name, f)
 -- | Contains variables for the query. The key of the map is a variable name,
 --   and the value is the variable value.
 type Subs = HashMap Name Value
 -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
 object :: Monad m => Name -> ActionT m [Resolver m] -> Resolver m
 object name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ flds) resolver
        = withField (resolve (resolversToMap resolver) flds) fld
 -- | Like 'object' but can be null or a list of objects.
 wrappedObject ::
    Monad m =>
    Name ->
    ActionT m (Type.Wrapping [Resolver m]) ->
    Resolver m
 wrappedObject name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ sels) resolver
        = withField (traverse (resolveMap sels) resolver) fld
    resolveMap = flip (resolve . resolversToMap)
 -- | A scalar represents a primitive value, like a string or an integer.
 scalar :: (Monad m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m
 scalar name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld result = withField (return result) fld
 -- | Like 'scalar' but can be null or a list of scalars.
 wrappedScalar ::
    (Monad m, Aeson.ToJSON a) =>
    Name ->
    ActionT m (Type.Wrapping a) ->
    Resolver m
 wrappedScalar name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld (Type.Named result) = withField (return result) fld
    resolveRight fld Type.Null
        = return $ HashMap.singleton (aliasOrName fld) Aeson.Null
    resolveRight fld (Type.List result) = withField (return result) fld
 resolveFieldValue ::
    Monad m =>
    ActionT m a ->
    (Field -> a -> CollectErrsT m Aeson.Object) ->
    Field ->
    CollectErrsT m (HashMap Text Aeson.Value)
 resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
    result <- lift $ reader . runExceptT . runActionT $ f
    either resolveLeft (resolveRight fld) result
      where
        reader = flip runReaderT $ Context {arguments=args}
        resolveLeft err = do
            _ <- addErrMsg err
            return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 -- | Helper function to facilitate error handling and result emitting.
 withField :: (Monad m, Aeson.ToJSON a)
    => CollectErrsT m a -> Field -> CollectErrsT m (HashMap Text Aeson.Value)
 withField v fld
    = HashMap.singleton (aliasOrName fld) . Aeson.toJSON <$> runAppendErrs v
 -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
 --   'Resolver' to each 'Field'. Resolves into a value containing the
 --   resolved 'Field', or a null value and error information.
 resolve :: Monad m
    => HashMap Text (Field -> CollectErrsT m Aeson.Object)
    -> Seq Selection
    -> CollectErrsT m Aeson.Value
 resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
  where
    resolveTypeName f = do
        value <- f $ Field Nothing "__typename" mempty mempty
        return $ HashMap.lookupDefault "" "__typename" value
    tryResolvers (SelectionField fld@(Field _ name _ _))
        = fromMaybe (errmsg fld) $ HashMap.lookup name resolvers <*> Just fld
    tryResolvers (SelectionFragment (Fragment typeCondition selections')) = do
        that <- traverse resolveTypeName $ HashMap.lookup "__typename" resolvers
        if maybe True (Aeson.String typeCondition ==) that
            then fmap fold . traverse tryResolvers $ selections'
            else return mempty
    errmsg fld@(Field _ name _ _) = do
        addErrMsg $ T.unwords ["field", name, "not resolved."]
        return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 aliasOrName :: Field -> Text
 aliasOrName (Field alias name _ _) = fromMaybe name alias
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@ -0,0 +1,64 @@
 -- | Monad transformer stack used by the @GraphQL@ resolvers.
 module Language.GraphQL.Trans
    ( ActionT(..)
    , Context(..)
    , argument
    ) where
 import Control.Applicative (Alternative(..))
 import Control.Monad (MonadPlus(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Except (ExceptT)
 import Control.Monad.Trans.Reader (ReaderT, asks)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Language.GraphQL.AST.Core
 import Prelude hiding (lookup)
 -- | Resolution context holds resolver arguments.
 newtype Context = Context
    { arguments :: Arguments
    }
 -- | Monad transformer stack used by the resolvers to provide error handling
 --   and resolution context (resolver arguments).
 newtype ActionT m a = ActionT
    { runActionT :: ExceptT Text (ReaderT Context m) a
    }
 instance Functor m => Functor (ActionT m) where
    fmap f = ActionT . fmap f . runActionT
 instance Monad m => Applicative (ActionT m) where
    pure = ActionT . pure
    (ActionT f) <*> (ActionT x) = ActionT $ f <*> x
 instance Monad m => Monad (ActionT m) where
    return = pure
    (ActionT action) >>= f = ActionT $ action >>= runActionT . f
 instance MonadTrans ActionT where
    lift = ActionT . lift . lift
 instance MonadIO m => MonadIO (ActionT m) where
    liftIO = lift . liftIO
 instance Monad m => Alternative (ActionT m) where
    empty = ActionT empty
    (ActionT x) <|> (ActionT y) = ActionT $ x <|> y
 instance Monad m => MonadPlus (ActionT m) where
    mzero = empty
    mplus = (<|>)
 -- | Retrieves an argument by its name. If the argument with this name couldn't
 --   be found, returns 'Value.Null' (i.e. the argument is assumed to
 --   be optional then).
 argument :: Monad m => Name -> ActionT m Value
 argument argumentName = do
    argumentValue <- ActionT $ lift $ asks $ lookup . arguments
    pure $ fromMaybe Null argumentValue
  where
    lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
--- a/src/Language/GraphQL/Type.hs
+++ b/src/Language/GraphQL/Type.hs
@ -0,0 +1,55 @@
 -- | Definitions for @GraphQL@ input types.
 module Language.GraphQL.Type
    ( Wrapping(..)
    ) where
 import Data.Aeson as Aeson (ToJSON, toJSON)
 import qualified Data.Aeson as Aeson
 -- | 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).
 --
 --   This 'Wrapping' type doesn\'t reflect this distinction exactly but it is
 --   used in the resolvers to take into account that the returned value can be
 --   nullable or an (arbitrary nested) list.
 data Wrapping a
    = List [Wrapping a] -- ^ Arbitrary nested list
    | Named a -- ^ Named type without further wrapping
    | Null -- ^ Null
    deriving (Eq, Show)
 instance Functor Wrapping where
    fmap f (List list) = List $ fmap (fmap f) list
    fmap f (Named named) = Named $ f named
    fmap _ Null = Null
 instance Foldable Wrapping where
    foldr f acc (List list) = foldr (flip $ foldr f) acc list
    foldr f acc (Named named) = f named acc
    foldr _ acc Null = acc
 instance Traversable Wrapping where
    traverse f (List list) = List <$> traverse (traverse f) list
    traverse f (Named named) = Named <$> f named
    traverse _ Null = pure Null
 instance Applicative Wrapping where
    pure = Named
    Null <*> _ = Null
    _ <*> Null = Null
    (Named f) <*> (Named x) = Named $ f x
    (List fs) <*> (List xs) = List $ (<*>) <$> fs <*> xs
    (Named f) <*> list = f <$> list
    (List fs) <*> named = List $ (<*> named) <$> fs
 instance Monad Wrapping where
    return = pure
    Null >>= _ = Null
    (Named x) >>= f = f x
    (List xs) >>= f = List $ fmap (>>= f) xs
 instance ToJSON a => ToJSON (Wrapping a) where
    toJSON (List list) = toJSON list
    toJSON (Named named) = toJSON named
    toJSON Null = Aeson.Null
--- a/src/Language/GraphQL/Type/Directive.hs
+++ b/src/Language/GraphQL/Type/Directive.hs
@ -0,0 +1,50 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.Type.Directive
    ( selection
    ) where
 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL.AST.Core
 -- | Directive processing status.
 data Status
    = Skip -- ^ Skip the selection and stop directive processing
    | Include Directive -- ^ The directive was processed, try other handlers
    | Continue Directive -- ^ Directive handler mismatch, try other handlers
 -- | Takes a list of directives, handles supported directives and excludes them
 --   from the result. If the selection should be skipped, returns 'Nothing'.
 selection :: [Directive] -> Maybe [Directive]
 selection = foldr go (Just [])
  where
    go directive' directives' =
        case (skip . include) (Continue directive') of
            (Include _) -> directives'
            Skip -> Nothing
            (Continue x) -> (x :) <$> directives'
 handle :: (Directive -> Status) -> Status -> Status
 handle _ Skip = Skip
 handle handler (Continue directive) = handler directive
 handle handler (Include directive) = handler directive
 -- * Directive implementations
 skip :: Status -> Status
 skip = handle skip'
  where
    skip' directive'@(Directive "skip" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
            (Just (Boolean True)) -> Skip
            _ -> Include directive'
    skip' directive' = Continue directive'
 include :: Status -> Status
 include = handle include'
  where
    include' directive'@(Directive "include" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
            (Just (Boolean True)) -> Include directive'
            _ -> Skip
    include' directive' = Continue directive'
--- a/stack.yaml
+++ b/stack.yaml
@ -1,5 +1,9 @@
-flags: {}
+resolver: lts-15.12
 packages:
- '.'
+- .
 extra-deps: []
-resolver: lts-3.4
+flags: {}
 pvp-bounds: both
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@ -0,0 +1,133 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.EncoderSpec
    ( spec
    ) where
 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)
 import Text.RawString.QQ (r)
 import Data.Text.Lazy (cons, toStrict, unpack)
 spec :: Spec
 spec = do
    describe "value" $ do
        context "null value" $ do
            let testNull formatter = value formatter Null `shouldBe` "null"
            it "minified" $ testNull minified
            it "pretty" $ testNull pretty
        context "minified" $ do
            it "escapes \\" $
                value minified (String "\\") `shouldBe` "\"\\\\\""
            it "escapes double quotes" $
                value minified (String "\"") `shouldBe` "\"\\\"\""
            it "escapes \\f" $
                value minified (String "\f") `shouldBe` "\"\\f\""
            it "escapes \\n" $
                value minified (String "\n") `shouldBe` "\"\\n\""
            it "escapes \\r" $
                value minified (String "\r") `shouldBe` "\"\\r\""
            it "escapes \\t" $
                value minified (String "\t") `shouldBe` "\"\\t\""
            it "escapes backspace" $
                value minified (String "a\bc") `shouldBe` "\"a\\bc\""
            context "escapes Unicode for chars less than 0010" $ do
                it "Null" $ value minified (String "\x0000") `shouldBe` "\"\\u0000\""
                it "bell" $ value minified (String "\x0007") `shouldBe` "\"\\u0007\""
            context "escapes Unicode for char less than 0020" $ do
                it "DLE" $ value minified (String "\x0010") `shouldBe` "\"\\u0010\""
                it "EM" $ value minified (String "\x0019") `shouldBe` "\"\\u0019\""
            context "encodes without escape" $ do
                it "space" $ value minified (String "\x0020") `shouldBe` "\" \""
                it "~" $ value minified (String "\x007E") `shouldBe` "\"~\""
        context "pretty" $ do
            it "uses strings for short string values" $
                value pretty (String "Short text") `shouldBe` "\"Short text\""
            it "uses block strings for text with new lines, with newline symbol" $
                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 (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 (String "Line 1\r\nLine 2")
                    `shouldBe` [r|"""
  Line 1
  Line 2
 """|]
            it "encodes as one line string if has escaped symbols" $ do
                let
                  genNotAllowedSymbol = oneof
                    [ choose ('\x0000', '\x0008')
                    , choose ('\x000B', '\x000C')
                    , choose ('\x000E', '\x001F')
                    , pure '\x007F'
                    ]
                forAll genNotAllowedSymbol $ \x -> do
                    let
                      rawValue = "Short \n" <> cons x "text"
                      encoded = value pretty (String $ toStrict rawValue)
                    shouldStartWith (unpack encoded) "\""
                    shouldEndWith (unpack encoded) "\""
                    shouldNotContain (unpack encoded) "\"\"\""
            it "Hello world" $ value pretty (String "Hello,\n  World!\n\nYours,\n  GraphQL.")
              `shouldBe` [r|"""
  Hello,
    World!
  Yours,
    GraphQL.
 """|]
            it "has only newlines" $ value pretty (String "\n") `shouldBe` [r|"""
 """|]
            it "has newlines and one symbol at the begining" $
              value pretty (String "a\n\n") `shouldBe` [r|"""
  a
 """|]
            it "has newlines and one symbol at the end" $
              value pretty (String "\n\na") `shouldBe` [r|"""
  a
 """|]
            it "has newlines and one symbol in the middle" $
              value pretty (String "\na\n") `shouldBe` [r|"""
  a
 """|]
            it "skip trailing whitespaces" $ value pretty (String "  Short\ntext    ")
              `shouldBe` [r|"""
  Short
  text
 """|]
    describe "definition" $
        it "indents block strings in arguments" $
            let arguments = [Argument "message" (String "line1\nline2")]
                field = Field Nothing "field" arguments [] []
                operation = DefinitionOperation $ SelectionSet $ pure field
             in definition pretty operation `shouldBe` [r|{
  field(message: """
    line1
    line2
  """)
 }
 |]
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@ -0,0 +1,99 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.LexerSpec
    ( spec
    ) where
 import Data.Text (Text)
 import Data.Void (Void)
 import Language.GraphQL.AST.Lexer
 import Test.Hspec (Spec, context, describe, it)
 import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
 import Text.Megaparsec (ParseErrorBundle, parse)
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Lexer" $ do
    context "Reference tests" $ do
        it "accepts BOM header" $
            parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
        it "lexes strings" $ do
            parse string "" [r|"simple"|] `shouldParse` "simple"
            parse string "" [r|" white space "|] `shouldParse` " white space "
            parse string "" [r|"quote \""|] `shouldParse` [r|quote "|]
            parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n"
            parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|]
            parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
                `shouldParse` "unicode ሴ噸邫췯"
        it "lexes block string" $ do
            parse blockString "" [r|"""simple"""|] `shouldParse` "simple"
            parse blockString "" [r|""" white space """|]
                `shouldParse` " white space "
            parse blockString "" [r|"""contains " quote"""|]
                `shouldParse` [r|contains " quote|]
            parse blockString "" [r|"""contains \""" triplequote"""|]
                `shouldParse` [r|contains """ triplequote|]
            parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
            parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|]
                `shouldParse` [r|unescaped \n\r\b\t\f\u1234|]
            parse blockString "" [r|"""slashes \\ \/"""|]
                `shouldParse` [r|slashes \\ \/|]
            parse blockString "" [r|"""
                spans
                  multiple
                    lines
                """|] `shouldParse` "spans\n  multiple\n    lines"
        it "lexes numbers" $ do
            parse integer "" "4" `shouldParse` (4 :: Int)
            parse float "" "4.123" `shouldParse` 4.123
            parse integer "" "-4" `shouldParse` (-4 :: Int)
            parse integer "" "9" `shouldParse` (9 :: Int)
            parse integer "" "0" `shouldParse` (0 :: Int)
            parse float "" "-4.123" `shouldParse` (-4.123)
            parse float "" "0.123" `shouldParse` 0.123
            parse float "" "123e4" `shouldParse` 123e4
            parse float "" "123E4" `shouldParse` 123E4
            parse float "" "123e-4" `shouldParse` 123e-4
            parse float "" "123e+4" `shouldParse` 123e+4
            parse float "" "-1.123e4" `shouldParse` (-1.123e4)
            parse float "" "-1.123E4" `shouldParse` (-1.123E4)
            parse float "" "-1.123e-4" `shouldParse` (-1.123e-4)
            parse float "" "-1.123e+4" `shouldParse` (-1.123e+4)
            parse float "" "-1.123e4567" `shouldParse` (-1.123e4567)
        it "lexes punctuation" $ do
            parse bang "" "!" `shouldParse` "!"
            parse dollar "" "$" `shouldParse` "$"
            runBetween parens `shouldSucceedOn` "()"
            parse spread "" "..." `shouldParse` "..."
            parse colon "" ":" `shouldParse` ":"
            parse equals "" "=" `shouldParse` "="
            parse at "" "@" `shouldParse` "@"
            runBetween brackets `shouldSucceedOn` "[]"
            runBetween braces `shouldSucceedOn` "{}"
            parse pipe "" "|" `shouldParse` "|"
    context "Implementation tests" $ do
        it "lexes empty block strings" $
            parse blockString "" [r|""""""|] `shouldParse` ""
        it "lexes ampersand" $
            parse amp "" "&" `shouldParse` "&"
        it "lexes schema extensions" $
            parseExtend "schema" `shouldSucceedOn` "extend schema"
        it "fails if the given token doesn't match" $
            parseExtend "schema" `shouldFailOn` "extend shema"
 parseExtend :: Text -> (Text -> Either (ParseErrorBundle Text Void) ())
 parseExtend extension = parse (extend extension "" $ pure $ pure ()) ""
 runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
 runBetween parser = parse (parser $ pure ()) ""
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -0,0 +1,144 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.ParserSpec
    ( spec
    ) where
 import Data.List.NonEmpty (NonEmpty(..))
 import Language.GraphQL.AST.Document
 import Language.GraphQL.AST.Parser
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Parser" $ do
    it "accepts BOM header" $
        parse document "" `shouldSucceedOn` "\xfeff{foo}"
    it "accepts block strings as argument" $
        parse document "" `shouldSucceedOn` [r|{
              hello(text: """Argument""")
            }|]
    it "accepts strings as argument" $
        parse document "" `shouldSucceedOn` [r|{
              hello(text: "Argument")
            }|]
    it "accepts two required arguments" $
        parse document "" `shouldSucceedOn` [r|
            mutation auth($username: String!, $password: String!){
              test
            }|]
    it "accepts two string arguments" $
        parse document "" `shouldSucceedOn` [r|
            mutation auth{
              test(username: "username", password: "password")
            }|]
    it "accepts two block string arguments" $
        parse document "" `shouldSucceedOn` [r|
            mutation auth{
              test(username: """username""", password: """password""")
            }|]
    it "parses minimal schema definition" $
        parse document "" `shouldSucceedOn` [r|schema { query: Query }|]
    it "parses minimal scalar definition" $
        parse document "" `shouldSucceedOn` [r|scalar Time|]
    it "parses ImplementsInterfaces" $
        parse document "" `shouldSucceedOn` [r|
            type Person implements NamedEntity & ValuedEntity {
              name: String
            }
        |]
    it "parses a  type without ImplementsInterfaces" $
        parse document "" `shouldSucceedOn` [r|
            type Person {
              name: String
            }
        |]
    it "parses ArgumentsDefinition in an ObjectDefinition" $
        parse document "" `shouldSucceedOn` [r|
            type Person {
              name(first: String, last: String): String
            }
        |]
    it "parses minimal union type definition" $
        parse document "" `shouldSucceedOn` [r|
            union SearchResult = Photo | Person
        |]
    it "parses minimal interface type definition" $
        parse document "" `shouldSucceedOn` [r|
            interface NamedEntity {
              name: String
            }
        |]
    it "parses minimal enum type definition" $
        parse document "" `shouldSucceedOn` [r|
            enum Direction {
              NORTH
              EAST
              SOUTH
              WEST
            }
        |]
    it "parses minimal enum type definition" $
        parse document "" `shouldSucceedOn` [r|
            enum Direction {
              NORTH
              EAST
              SOUTH
              WEST
            }
        |]
    it "parses minimal input object type definition" $
        parse document "" `shouldSucceedOn` [r|
            input Point2D {
              x: Float
              y: Float
            }
        |]
    it "parses minimal input enum definition with an optional pipe" $
        parse document "" `shouldSucceedOn` [r|
            directive @example on
              | FIELD
              | FRAGMENT_SPREAD
        |]
    it "parses schema extension with a new directive" $
        parse document "" `shouldSucceedOn`[r|
            extend schema @newDirective
        |]
    it "parses schema extension with an operation type definition" $
        parse document "" `shouldSucceedOn` [r|extend schema { query: Query }|]
    it "parses schema extension with an operation type and directive" $
        let newDirective = Directive "newDirective" []
            testSchemaExtension = TypeSystemExtension
                $ SchemaExtension
                $ SchemaOperationExtension [newDirective]
                $ OperationTypeDefinition Query "Query" :| []
            query = [r|extend schema @newDirective { query: Query }|]
         in parse document "" query `shouldParse` (testSchemaExtension :| [])
    it "parses an object extension" $
        parse document "" `shouldSucceedOn` [r|
            extend type Story {
              isHiddenLocally: Boolean
            }
        |]
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@ -0,0 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.ErrorSpec
    ( spec
    ) where
 import qualified Data.Aeson as Aeson
 import Language.GraphQL.Error
 import Test.Hspec ( Spec
                  , describe
                  , it
                  , shouldBe
                  )
 spec :: Spec
 spec = describe "singleError" $
    it "constructs an error with the given message" $
        let expected = Aeson.object
                [
                    ("errors", Aeson.toJSON
                        [ Aeson.object [("message", "Message.")]
                        ]
                    )
                ]
         in singleError "Message." `shouldBe` expected
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@ -0,0 +1 @@
 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@ -0,0 +1,88 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.DirectiveSpec
    ( spec
    ) where
 import Data.Aeson (Value, object, (.=))
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.RawString.QQ (r)
 experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
 experimentalResolver = HashMap.singleton "Query"
    $ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
 emptyObject :: Value
 emptyObject = object
    [ "data" .= object []
    ]
 spec :: Spec
 spec =
    describe "Directive executor" $ do
        it "should be able to @skip fields" $ do
            let query = [r|
              {
                experimentalField @skip(if: true)
              }
            |]
            actual <- graphql experimentalResolver query
            actual `shouldBe` emptyObject
        it "should not skip fields if @skip is false" $ do
            let query = [r|
              {
                experimentalField @skip(if: false)
              }
            |]
                expected = object
                    [ "data" .= object
                        [ "experimentalField" .= (5 :: Int)
                        ]
                    ]
            actual <- graphql experimentalResolver query
            actual `shouldBe` expected
        it "should skip fields if @include is false" $ do
            let query = [r|
              {
                experimentalField @include(if: false)
              }
            |]
            actual <- graphql experimentalResolver query
            actual `shouldBe` emptyObject
        it "should be able to @skip a fragment spread" $ do
            let query = [r|
              {
                ...experimentalFragment @skip(if: true)
              }
              fragment experimentalFragment on ExperimentalType {
                experimentalField
              }
            |]
            actual <- graphql experimentalResolver query
            actual `shouldBe` emptyObject
        it "should be able to @skip an inline fragment" $ do
            let query = [r|
              {
                ... on ExperimentalType @skip(if: true) {
                  experimentalField
                }
              }
            |]
            actual <- graphql experimentalResolver query
            actual `shouldBe` emptyObject
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@ -0,0 +1,191 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.FragmentSpec
    ( spec
    ) where
 import Data.Aeson (Value(..), object, (.=))
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
 import Test.Hspec ( Spec
                  , describe
                  , it
                  , shouldBe
                  , shouldSatisfy
                  , shouldNotSatisfy
                  )
 import Text.RawString.QQ (r)
 size :: Schema.Resolver IO
 size = Schema.scalar "size" $ return ("L" :: Text)
 circumference :: Schema.Resolver IO
 circumference = Schema.scalar "circumference" $ return (60 :: Int)
 garment :: Text -> Schema.Resolver IO
 garment typeName = Schema.object "garment" $ return
    [ if typeName == "Hat" then circumference else size
    , Schema.scalar "__typename" $ return typeName
    ]
 inlineQuery :: Text
 inlineQuery = [r|{
  garment {
    ... on Hat {
      circumference
    }
    ... on Shirt {
      size
    }
  }
 }|]
 hasErrors :: Value -> Bool
 hasErrors (Object object') = HashMap.member "errors" object'
 hasErrors _ = True
 spec :: Spec
 spec = do
    describe "Inline fragment executor" $ do
        it "chooses the first selection if the type matches" $ do
            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "chooses the last selection if the type matches" $ do
            actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "size" .= ("L" :: Text)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "embeds inline fragments without type" $ do
            let query = [r|{
              garment {
                circumference
                ... {
                  size
                }
              }
            }|]
                resolvers = Schema.object "garment" $ return [circumference,  size]
            actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            , "size" .= ("L" :: Text)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "evaluates fragments on Query" $ do
            let query = [r|{
              ... {
                size
              }
            }|]
            actual <- graphql (HashMap.singleton "Query" $ size :| []) query
            actual `shouldNotSatisfy` hasErrors
    describe "Fragment spread executor" $ do
        it "evaluates fragment spreads" $ do
            let query = [r|
              {
                ...circumferenceFragment
              }
              fragment circumferenceFragment on Hat {
                circumference
              }
            |]
            actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
            let expected = object
                    [ "data" .= object
                        [ "circumference" .= (60 :: Int)
                        ]
                    ]
             in actual `shouldBe` expected
        it "evaluates nested fragments" $ do
            let query = [r|
              {
                garment {
                  ...circumferenceFragment
                }
              }
              fragment circumferenceFragment on Hat {
                ...hatFragment
              }
              fragment hatFragment on Hat {
                circumference
              }
            |]
            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
            let expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
             in actual `shouldBe` expected
        it "rejects recursive fragments" $ do
            let query = [r|
              {
                ...circumferenceFragment
              }
              fragment circumferenceFragment on Hat {
                ...circumferenceFragment
              }
            |]
            actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
            actual `shouldSatisfy` hasErrors
        it "considers type condition" $ do
            let query = [r|
              {
                garment {
                  ...circumferenceFragment
                  ...sizeFragment
                }
              }
              fragment circumferenceFragment on Hat {
                circumference
              }
              fragment sizeFragment on Shirt {
                size
              }
            |]
                expected = object
                    [ "data" .= object
                        [ "garment" .= object
                            [ "circumference" .= (60 :: Int)
                            ]
                        ]
                    ]
            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
            actual `shouldBe` expected
--- 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/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@ -0,0 +1,191 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data
    ( Character
    , appearsIn
    , artoo
    , getDroid
    , getDroid'
    , getEpisode
    , getFriends
    , getHero
    , getHuman
    , id_
    , homePlanet
    , name
    , secretBackstory
    , typeName
    ) where
 import Data.Functor.Identity (Identity)
 import Control.Applicative (Alternative(..), liftA2)
 import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
 -- ** Characters
 type ID = Text
 data CharCommon = CharCommon
  { _id_        :: ID
  , _name       :: Text
  , _friends    :: [ID]
  , _appearsIn  :: [Int]
  } deriving (Show)
 data Human = Human
  { _humanChar  :: CharCommon
  , homePlanet :: Text
  }
 data Droid = Droid
  { _droidChar       :: CharCommon
  , primaryFunction :: Text
  }
 type Character = Either Droid Human
 id_ :: Character -> ID
 id_ (Left  x) = _id_ . _droidChar $ x
 id_ (Right x) = _id_ . _humanChar $ x
 name :: Character -> Text
 name (Left  x) = _name . _droidChar $ x
 name (Right x) = _name . _humanChar $ x
 friends :: Character -> [ID]
 friends (Left  x) = _friends . _droidChar $ x
 friends (Right x) = _friends . _humanChar $ x
 appearsIn :: Character -> [Int]
 appearsIn (Left  x) = _appearsIn . _droidChar $ x
 appearsIn (Right x) = _appearsIn . _humanChar $ x
 secretBackstory :: Character -> ActionT Identity Text
 secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
 typeName :: Character -> Text
 typeName = either (const "Droid") (const "Human")
 luke :: Character
 luke = Right luke'
 luke' :: Human
 luke' = Human
  { _humanChar = CharCommon
      { _id_        = "1000"
      , _name       = "Luke Skywalker"
      , _friends    = ["1002","1003","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 vader :: Human
 vader = Human
  { _humanChar = CharCommon
      { _id_        = "1001"
      , _name       = "Darth Vader"
      , _friends    = ["1004"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 han :: Human
 han = Human
  { _humanChar = CharCommon
      { _id_        = "1002"
      , _name       = "Han Solo"
      , _friends    = ["1000","1003","2001" ]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = mempty
  }
 leia :: Human
 leia = Human
  { _humanChar = CharCommon
      { _id_        = "1003"
      , _name       = "Leia Organa"
      , _friends    = ["1000","1002","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Alderaan"
  }
 tarkin :: Human
 tarkin = Human
  { _humanChar = CharCommon
    { _id_        = "1004"
    , _name       = "Wilhuff Tarkin"
    , _friends    = ["1001"]
    , _appearsIn  = [4]
    }
  , homePlanet = mempty
  }
 threepio :: Droid
 threepio = Droid
  { _droidChar = CharCommon
      { _id_ = "2000"
      , _name = "C-3PO"
      , _friends = ["1000","1002","1003","2001" ]
      , _appearsIn = [ 4, 5, 6 ]
      }
  , primaryFunction = "Protocol"
  }
 artoo :: Character
 artoo = Left artoo'
 artoo' :: Droid
 artoo' = Droid
  { _droidChar = CharCommon
      { _id_        = "2001"
      , _name       = "R2-D2"
      , _friends    = ["1000","1002","1003"]
      , _appearsIn  = [4,5,6]
      }
  , primaryFunction = "Astrometch"
  }
 -- ** Helper functions
 getHero :: Int -> Character
 getHero 5 = luke
 getHero _ = artoo
 getHuman :: Alternative f => ID -> f Character
 getHuman = fmap Right . getHuman'
 getHuman' :: Alternative f => ID -> f Human
 getHuman' "1000" = pure luke'
 getHuman' "1001" = pure vader
 getHuman' "1002" = pure han
 getHuman' "1003" = pure leia
 getHuman' "1004" = pure tarkin
 getHuman' _      = empty
 getDroid :: Alternative f => ID -> f Character
 getDroid = fmap Left . getDroid'
 getDroid' :: Alternative f => ID -> f Droid
 getDroid' "2000" = pure threepio
 getDroid' "2001" = pure artoo'
 getDroid' _      = empty
 getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 getEpisode :: Int -> Maybe (Type.Wrapping Text)
 getEpisode 4 = pure $ Type.Named "NEWHOPE"
 getEpisode 5 = pure $ Type.Named "EMPIRE"
 getEpisode 6 = pure $ Type.Named "JEDI"
 getEpisode _ = empty
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@ -0,0 +1,365 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.StarWars.QuerySpec
    ( spec
    ) where
 import qualified Data.Aeson as Aeson
 import Data.Aeson ((.=))
 import Data.Functor.Identity (Identity(..))
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL
 import Language.GraphQL.Schema (Subs)
 import Text.RawString.QQ (r)
 import Test.Hspec.Expectations (Expectation, shouldBe)
 import Test.Hspec (Spec, describe, it)
 import Test.StarWars.Schema
 -- * Test
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
 spec :: Spec
 spec = describe "Star Wars Query Tests" $ do
    describe "Basic Queries" $ do
      it "R2-D2 hero" $ testQuery
        [r| query HeroNameQuery {
            hero {
                id
            }
            }
        |]
        $ 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" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          Aeson.object [hanName]
                        , Aeson.object [leiaName]
                        , Aeson.object [c3poName]
                        , Aeson.object [r2d2Name]
                        ]
                    ]
                , Aeson.object [
                      hanName
                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .=
                        [ Aeson.object [lukeName]
                        , Aeson.object [leiaName]
                        , Aeson.object [r2d2Name]
                        ]
                    ]
                , Aeson.object [
                      leiaName
                    , "appearsIn" .= [ "NEWHOPE","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 = runIdentity (graphql schema q) `shouldBe` expected
 testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected =
    runIdentity (graphqlSubs schema f q) `shouldBe` expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -0,0 +1,66 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Schema
    ( character
    , droid
    , hero
    , human
    , schema
    ) where
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Data.Functor.Identity (Identity)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 import Test.StarWars.Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
 schema = HashMap.singleton "Query" $ hero :| [human, droid]
 hero :: Schema.Resolver Identity
 hero = Schema.object "hero" $ do
  episode <- argument "episode"
  character $ case episode of
      Schema.Enum "NEWHOPE" -> getHero 4
      Schema.Enum "EMPIRE" -> getHero 5
      Schema.Enum "JEDI" -> getHero 6
      _ -> artoo
 human :: Schema.Resolver Identity
 human = Schema.wrappedObject "human" $ do
    id' <- argument "id"
    case id' of
        Schema.String i -> do
            humanCharacter <- lift $ return $ getHuman i >>= Just
            case humanCharacter of
                Nothing -> return Type.Null
                Just e -> Type.Named <$> character e
        _ -> ActionT $ throwE "Invalid arguments."
 droid :: Schema.Resolver Identity
 droid = Schema.object "droid" $ do
    id' <- argument "id"
    case id' of
        Schema.String i -> character =<< getDroid i
        _ -> ActionT $ throwE "Invalid arguments."
 character :: Character -> ActionT Identity [Schema.Resolver Identity]
 character char = return
    [ Schema.scalar "id" $ return $ id_ char
    , Schema.scalar "name" $ return $ name char
    , Schema.wrappedObject "friends"
        $ traverse character $ Type.List $ Type.Named <$> getFriends char
    , Schema.wrappedScalar "appearsIn" $ return . Type.List
        $ catMaybes (getEpisode <$> appearsIn char)
    , Schema.scalar "secretBackstory" $ secretBackstory char
    , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
    , Schema.scalar "__typename" $ return $ typeName char
    ]
--- a/tests/data/kitchen-sink.graphql
+++ b/tests/data/kitchen-sink.graphql
@ -7,11 +7,11 @@
 query queryName($foo: ComplexType, $site: Site = MOBILE) {
  whoever123is: node(id: [123, 456]) {
-    id , # Inline test comment
+    id, # Inline test comment
    ... on User @defer {
      field2 {
-        id ,
+        id,
-        alias: field1(first:10, after:$foo,) @include(if: $foo) {
+        alias: field1(first: 10, after: $foo) @include(if: $foo) {
          id,
          ...frag
        }
--- a/tests/data/kitchen-sink.graphql.golden
+++ b/tests/data/kitchen-sink.graphql.golden
@ -1 +0,0 @@
 Document [DefinitionOperation (Query "queryName" [VariableDefinition (Variable "foo") (TypeNamed (NamedType "ComplexType")) Nothing,VariableDefinition (Variable "site") (TypeNamed (NamedType "Site")) (Just (ValueEnum "MOBILE"))] [] [SelectionField (Field "whoever123is" "node" [Argument "id" (ValueList (ListValue [ValueInt 123,ValueInt 456]))] [] [SelectionField (Field "" "id" [] [] []),SelectionInlineFragment (InlineFragment (NamedType "User") [Directive "defer" []] [SelectionField (Field "" "field2" [] [] [SelectionField (Field "" "id" [] [] []),SelectionField (Field "alias" "field1" [Argument "first" (ValueInt 10),Argument "after" (ValueVariable (Variable "foo"))] [Directive "include" [Argument "if" (ValueVariable (Variable "foo"))]] [SelectionField (Field "" "id" [] [] []),SelectionFragmentSpread (FragmentSpread "frag" [])])])])])]),DefinitionOperation (Mutation "likeStory" [] [] [SelectionField (Field "" "like" [Argument "story" (ValueInt 123)] [Directive "defer" []] [SelectionField (Field "" "story" [] [] [SelectionField (Field "" "id" [] [] [])])])]),DefinitionFragment (FragmentDefinition "frag" (NamedType "Friend") [] [SelectionField (Field "" "foo" [Argument "size" (ValueVariable (Variable "size")),Argument "bar" (ValueVariable (Variable "b")),Argument "obj" (ValueObject (ObjectValue [ObjectField "key" (ValueString "value")]))] [] [])])]
--- 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}
--- a/tests/golden.hs
+++ b/tests/golden.hs
@ -1,21 +0,0 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 import Control.Monad ((>=>))
 import Data.Attoparsec.Text (parseOnly)
 import Data.ByteString.Lazy.Char8 as B8
 import qualified Data.Text.IO as TIO
 import Test.Tasty (defaultMain)
 import Test.Tasty.Golden (goldenVsString)
 import Data.GraphQL.Parser (document)
 main :: IO ()
 main = defaultMain
     $ goldenVsString "kitchen-sink.graphql"
                      "./tests/data/kitchen-sink.graphql.golden"
                      (parse "./tests/data/kitchen-sink.graphql")
  where
    parse = fmap (parseOnly document) . TIO.readFile
        >=> pure . either B8.pack (flip B8.snoc '\n' . B8.pack . show)
		`@ -1,2 +0,0 @@`
			`import Data.Attoparsec.Text`
			`import qualified Data.Text.IO as TIO`
		`@ -1 +0,0 @@`
			Document [DefinitionOperation (Query "queryName" [VariableDefinition (Variable "foo") (TypeNamed (NamedType "ComplexType")) Nothing,VariableDefinition (Variable "site") (TypeNamed (NamedType "Site")) (Just (ValueEnum "MOBILE"))] [] [SelectionField (Field "whoever123is" "node" [Argument "id" (ValueList (ListValue [ValueInt 123,ValueInt 456]))] [] [SelectionField (Field "" "id" [] [] []),SelectionInlineFragment (InlineFragment (NamedType "User") [Directive "defer" []] [SelectionField (Field "" "field2" [] [] [SelectionField (Field "" "id" [] [] []),SelectionField (Field "alias" "field1" [Argument "first" (ValueInt 10),Argument "after" (ValueVariable (Variable "foo"))] [Directive "include" [Argument "if" (ValueVariable (Variable "foo"))]] [SelectionField (Field "" "id" [] [] []),SelectionFragmentSpread (FragmentSpread "frag" [])])])])])]),DefinitionOperation (Mutation "likeStory" [] [] [SelectionField (Field "" "like" [Argument "story" (ValueInt 123)] [Directive "defer" []] [SelectionField (Field "" "story" [] [] [SelectionField (Field "" "id" [] [] [])])])]),DefinitionFragment (FragmentDefinition "frag" (NamedType "Friend") [] [SelectionField (Field "" "foo" [Argument "size" (ValueVariable (Variable "size")),Argument "bar" (ValueVariable (Variable "b")),Argument "obj" (ValueObject (ObjectValue [ObjectField "key" (ValueString "value")]))] [] [])])]
		`@ -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}`