Release 0.5.0.1

Fix #12
Deprecate enum, enumA, wrappedEnum, wrappedEnumA
2019-09-10 10:20:40 +02:00 · 2019-09-06 07:48:01 +02:00 · 2019-09-01 03:16:27 +02:00 · 2019-08-30 07:26:04 +02:00 · 2019-08-29 07:40:50 +02:00 · 2019-08-26 10:14:46 +02:00
41 changed files with 2852 additions and 672 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,10 @@
 # Stack
 .stack-work/
 /stack.yaml.lock
 # Cabal
 /dist/
 /dist-newstyle/
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.project.local
--- a/.travis.yml
+++ b/.travis.yml
@ -1,79 +0,0 @@
 # This file has been generated -- see https://github.com/hvr/multi-ghc-travis
 language: c
 sudo: false
 cache:
  directories:
    - $HOME/.cabsnap
    - $HOME/.cabal/packages
 before_cache:
  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
 matrix:
  include:
    - env: CABALVER=1.18 GHCVER=7.8.4
      compiler: ": #GHC 7.8.4"
      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
    - env: CABALVER=1.22 GHCVER=7.10.2
      compiler: ": #GHC 7.10.2"
      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
 before_install:
 - unset CC
 - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
 install:
 - cabal --version
 - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
 - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
   then
     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
   fi
 - travis_retry cabal update -v
 - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
 - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
 - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
 # check whether current requested install-plan matches cached package-db snapshot
 - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
   then
     echo "cabal build-cache HIT";
     rm -rfv .ghc;
     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
   else
     echo "cabal build-cache MISS";
     rm -rf $HOME/.cabsnap;
     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
     cabal install --only-dependencies --enable-tests --enable-benchmarks;
   fi
 # snapshot package-db on cache miss
 - if [ ! -d $HOME/.cabsnap ];
   then
      echo "snapshotting package-db to build-cache";
      mkdir $HOME/.cabsnap;
      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
   fi
 # Here starts the actual work to be performed for the package under test;
 # any command which exits with a non-zero exit code causes the build to fail.
 script:
 - if [ -f configure.ac ]; then autoreconf -i; fi
 - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
 - cabal build   # this builds all libraries and executables (including tests/benchmarks)
 - cabal test
 - cabal check
 - cabal sdist   # tests that a source-distribution can be generated
 # Check that the resulting source distribution can be built & installed.
 # If there are no other `.tar.gz` files in `dist`, this can be even simpler:
 # `cabal install --force-reinstalls dist/*-*.tar.gz`
 - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
 # EOF
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -1,6 +1,75 @@
 # Change Log
 All notable changes to this project will be documented in this file.
 ## [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.
@ -19,5 +88,9 @@ All notable changes to this project will be documented in this file.
 ### Added
 - Data types for the GraphQL language.
-[0.2.1]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2...v0.2.1
+[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
-[0.2]: https://github.com/jdnavarro/graphql-haskell/compare/v0.1...v0.2
+[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/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,327 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 module Data.GraphQL.Parser where
 import Prelude hiding (takeWhile)
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), pure)
 import Data.Monoid (Monoid, mempty)
 #endif
 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 Eugen Wissner, Germany
 Copyright 2015-2017 J. Daniel Navarro
 All rights reserved.
--- a/README.md
+++ b/README.md
@ -1,26 +1,41 @@
 # Haskell GraphQL
 [![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql)
-[![Build Status](https://img.shields.io/travis/jdnavarro/graphql-haskell.svg)](https://travis-ci.org/jdnavarro/graphql-haskell)
+[![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).
 ## 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,153 @@
 ---
 title: GraphQL Haskell Tutorial
 ---
 == Getting started ==
 Welcome to graphql-haskell!
 We have written a small tutorial to help you (and ourselves) understand the graphql package.
 Since this file is a literate haskell file, we start by importing some dependencies.
 > {-# LANGUAGE OverloadedStrings #-}
 > {-# LANGUAGE LambdaCase #-}
 > module Main where
 >
 > import Control.Monad.IO.Class (liftIO)
 > import Control.Monad.Trans.Except (throwE)
 > import Data.Aeson (encode)
 > import Data.ByteString.Lazy.Char8 (putStrLn)
 > import Data.List.NonEmpty (NonEmpty(..))
 > import Data.Text (Text)
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
 > import qualified Language.GraphQL.Schema as Schema
 > import Language.GraphQL.Trans (ActionT(..))
 >
 > import Prelude hiding (putStrLn)
 === First example ===
 Now, as our first example, we are going to look at the
 example from [graphql.js](https://github.com/graphql/graphql-js).
 First we build a GraphQL schema.
 > schema1 :: NonEmpty (Schema.Resolver IO)
 > schema1 = hello :| []
 >
 > hello :: Schema.Resolver IO
 > hello = Schema.scalar "hello" (return ("it's me" :: Text))
 This defines a simple schema with one type and one field, that resolves to a fixed value.
 Next we define our query.
 > query1 :: Text
 > query1 = "{ hello }"
 To run the query, we call the `graphql` with the schema and the query.
 > main1 :: IO ()
 > main1 = putStrLn =<< encode <$> graphql schema1 query1
 This runs the query by fetching the one field defined,
 returning
 ```{"data" : {"hello":"it's me"}}```
 === Monadic actions ===
 For this example, we're going to be using time.
 > schema2 :: NonEmpty (Schema.Resolver IO)
 > schema2 = time :| []
 >
 > time :: Schema.Resolver IO
 > time = Schema.scalarA "time" $ \case
 >   [] -> do t <- liftIO getCurrentTime
 >            return $ show t
 >   _ -> ActionT $ throwE "Invalid arguments."
 This defines a simple schema with one type and one field,
 which resolves to the current time.
 Next we define our query.
 > query2 :: Text
 > query2 = "{ time }"
 >
 > main2 :: IO ()
 > main2 = putStrLn =<< encode <$> graphql schema2 query2
 This runs the query, returning the current time
 ```{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}```
 === Errors ===
 Errors are handled according to the spec,
 with fields that cause erros being resolved to `null`,
 and an error being added to the error list.
 An example of this is the following query:
 > queryShouldFail :: Text
 > queryShouldFail = "{ boyhowdy }"
 Since there is no `boyhowdy` field in our schema, it will not resolve,
 and the query will fail, as we can see in the following example.
 > mainShouldFail :: IO ()
 > mainShouldFail = do
 >   success <- graphql schema1 query1
 >   putStrLn $ encode success
 >   putStrLn "This will fail"
 >   failure <- graphql schema1 queryShouldFail
 >   putStrLn $ encode failure
 >
 This outputs:
 ```
 {"data": {"hello": "it's me"}}
 This will fail
 {"data": {"boyhowdy": null}, "errors":[{"message": "the field boyhowdy did not resolve."}]}
 ```
 === Combining resolvers ===
 Now that we have two resolvers, we can define a schema which uses them both.
 > schema3 :: NonEmpty (Schema.Resolver IO)
 > schema3 = hello :| [time]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
 >
 > main3 :: IO ()
 > main3 = putStrLn =<< encode <$> graphql schema3 query3
 This queries for both time and hello, returning
 ```{ "data": {"hello":"it's me","time":"2016-03-08 23:29:11.62108 UTC"}}```
 Notice that we can name our queries, as we did with `timeAndHello`. Since we have only been using single queries, we can use the shorthand `{ time hello}`, as we have been doing in the previous examples.
 In GraphQL there can only be one operation per query.
 == Further examples ==
 More examples on queries and a more complex schema can be found in the test directory,
 in the [Test.StarWars](../../tests/Test/StarWars) module. This includes a more complex schema, and more complex queries.
 > main :: IO ()
 > main = main1 >> main2 >> mainShouldFail >> main3
--- a/graphql.cabal
+++ b/graphql.cabal
@ -1,47 +1,91 @@
 cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.31.2.
 --
 -- see: https://github.com/sol/hpack
 --
 -- hash: 0b3b2cb6ec02a4eeaee98d4c003d4cbe68ab81fde1810b06b0b6eeb61010298c
 name:           graphql
-version:             0.2.1
+version:        0.5.0.1
 synopsis:       Haskell GraphQL implementation
-description:
+description:    This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
-  This package provides a rudimentary parser for the
+category:       Language
-  <https://facebook.github.io/graphql/ GraphQL> language.
+homepage:       https://github.com/caraus-ecms/graphql#readme
-homepage:            https://github.com/jdnavarro/graphql-haskell
+bug-reports:    https://github.com/caraus-ecms/graphql/issues
-bug-reports:         https://github.com/jdnavarro/graphql-haskell/issues
+author:         Danny Navarro <j@dannynavarro.net>,
                Matthías Páll Gissurarson <mpg@mpg.is>,
                Sólrún Halla Einarsdóttir <she@mpg.is>
 maintainer:     belka@caraus.de
 copyright:      (c) 2019 Eugen Wissner,
                (c) 2015-2017 J. Daniel Navarro
 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
+extra-source-files:
-tested-with:         GHC == 7.8.4, GHC == 7.10.2
+    CHANGELOG.md
-extra-source-files:  README.md CHANGELOG.md stack.yaml
+    README.md
-data-files:          tests/data/*.graphql
+    LICENSE
-                     tests/data/*.graphql.golden
+    docs/tutorial/tutorial.lhs
-
+data-files:
-library
+    tests/data/kitchen-sink.graphql
-  default-language:    Haskell2010
+    tests/data/kitchen-sink.min.graphql
  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
+  location: https://github.com/caraus-ecms/graphql
 library
  exposed-modules:
      Language.GraphQL
      Language.GraphQL.AST
      Language.GraphQL.AST.Core
      Language.GraphQL.AST.Transform
      Language.GraphQL.Encoder
      Language.GraphQL.Error
      Language.GraphQL.Execute
      Language.GraphQL.Lexer
      Language.GraphQL.Parser
      Language.GraphQL.Schema
      Language.GraphQL.Trans
      Language.GraphQL.Type
  other-modules:
      Paths_graphql
  hs-source-dirs:
      src
  build-depends:
      aeson
    , base >=4.7 && <5
    , megaparsec
    , text
    , transformers
    , unordered-containers
  default-language: Haskell2010
 test-suite tasty
  type: exitcode-stdio-1.0
  main-is: Spec.hs
  other-modules:
      Language.GraphQL.EncoderSpec
      Language.GraphQL.ErrorSpec
      Language.GraphQL.LexerSpec
      Language.GraphQL.ParserSpec
      Test.KitchenSinkSpec
      Test.StarWars.Data
      Test.StarWars.QuerySpec
      Test.StarWars.Schema
      Paths_graphql
  hs-source-dirs:
      tests
  ghc-options: -threaded -rtsopts -with-rtsopts=-N
  build-depends:
      aeson
    , base >=4.7 && <5
    , graphql
    , hspec
    , hspec-expectations
    , megaparsec
    , raw-strings-qq
    , text
    , transformers
  default-language: Haskell2010
--- a/package.yaml
+++ b/package.yaml
@ -0,0 +1,52 @@
 name:                graphql
 version:             0.5.0.1
 synopsis:            Haskell GraphQL implementation
 description:
  This package provides a rudimentary parser for the
  <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
 maintainer:          belka@caraus.de
 github:              caraus-ecms/graphql
 category:            Language
 copyright:
 - (c) 2019 Eugen Wissner
 - (c) 2015-2017 J. Daniel Navarro
 author:
 - Danny Navarro <j@dannynavarro.net>
 - Matthías Páll Gissurarson <mpg@mpg.is>
 - Sólrún Halla Einarsdóttir <she@mpg.is>
 extra-source-files:
 - CHANGELOG.md
 - README.md
 - LICENSE
 - docs/tutorial/tutorial.lhs
 data-files:
 - tests/data/*.graphql
 - tests/data/*.min.graphql
 dependencies:
 - aeson
 - base >= 4.7 && < 5
 - megaparsec
 - text
 - transformers
 library:
  source-dirs: src
  dependencies:
  - unordered-containers
 tests:
  tasty:
    main: Spec.hs
    source-dirs: tests
    ghc-options:
    - -threaded
    - -rtsopts
    - -with-rtsopts=-N
    dependencies:
    - graphql
    - hspec
    - hspec-expectations
    - raw-strings-qq
--- a/semaphoreci.sh
+++ b/semaphoreci.sh
@ -0,0 +1,34 @@
 #!/bin/bash
 STACK=$SEMAPHORE_CACHE_DIR/stack
 setup() {
 	if [ ! -e "$STACK" ]
 	then
 		curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C $SEMAPHORE_CACHE_DIR '*/stack'
 	fi
 	$STACK --no-terminal setup
 }
 setup_test() {
 	$STACK --no-terminal test --only-snapshot
 }
 test() {
 	$STACK --no-terminal test --pedantic
 }
 test_docs() {
 	$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
        $STACK --no-terminal haddock --no-haddock-deps
 }
 setup_lint() {
 	$STACK --no-terminal install hlint
 }
 lint() {
 	$STACK --no-terminal exec hlint -- src tests
 }
 $1
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@ -0,0 +1,35 @@
 -- | This module provides the functions to parse and execute @GraphQL@ queries.
 module Language.GraphQL
    ( graphql
    , graphqlSubs
    ) where
 import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Aeson as Aeson
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Text as T
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import Language.GraphQL.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 :: MonadIO m
    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
    -> T.Text -- ^ Text representing a @GraphQL@ request document.
    -> m Aeson.Value -- ^ Response.
 graphql = flip graphqlSubs $ const Nothing
 -- | 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 :: MonadIO m
    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
    -> Schema.Subs -- ^ Variable substitution function.
    -> T.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,163 @@
 -- | This module defines an abstract syntax tree for the @GraphQL@ language based on
 --   <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
 --
 -- Target AST for Parser.
 module Language.GraphQL.AST
    ( Alias
    , Argument(..)
    , Arguments
    , Definition(..)
    , Directive(..)
    , Directives
    , Document
    , Field(..)
    , FragmentDefinition(..)
    , FragmentName
    , FragmentSpread(..)
    , InlineFragment(..)
    , Name
    , NonNullType(..)
    , ObjectField(..)
    , OperationDefinition(..)
    , OperationType(..)
    , Selection(..)
    , SelectionSet
    , SelectionSetOpt
    , Type(..)
    , TypeCondition
    , Value(..)
    , VariableDefinition(..)
    , VariableDefinitions
    ) where
 import Data.Int (Int32)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Text (Text)
 import Language.GraphQL.AST.Core ( Alias
                                 , Name
                                 )
 -- * Document
 -- | GraphQL document.
 type Document = NonEmpty Definition
 -- * Operations
 -- | Top-level definition of a document, either an operation or a fragment.
 data Definition = DefinitionOperation OperationDefinition
                | DefinitionFragment  FragmentDefinition
                  deriving (Eq, Show)
 -- | Operation definition.
 data OperationDefinition = OperationSelectionSet SelectionSet
                         | OperationDefinition   OperationType
                                                 (Maybe Name)
                                                 VariableDefinitions
                                                 Directives
                                                 SelectionSet
                           deriving (Eq, Show)
 -- | GraphQL has 3 operation types: queries, mutations and subscribtions.
 --
 -- Currently only queries and mutations are supported.
 data OperationType = Query | Mutation deriving (Eq, Show)
 -- * Selections
 -- | "Top-level" selection, selection on a operation.
 type SelectionSet = NonEmpty Selection
 type SelectionSetOpt = [Selection]
 -- | Single selection element.
 data Selection
    = SelectionField          Field
    | SelectionFragmentSpread FragmentSpread
    | SelectionInlineFragment InlineFragment
    deriving (Eq, Show)
 -- * Field
 -- | GraphQL field.
 data Field
    = Field (Maybe Alias) Name Arguments Directives SelectionSetOpt
    deriving (Eq, Show)
 -- * Arguments
 -- | Argument list.
 type Arguments = [Argument]
 -- | Argument.
 data Argument = Argument Name Value deriving (Eq,Show)
 -- * Fragments
 -- | Fragment spread.
 data FragmentSpread = FragmentSpread Name Directives deriving (Eq, Show)
 -- | Inline fragment.
 data InlineFragment = InlineFragment (Maybe TypeCondition) Directives SelectionSet
                      deriving (Eq, Show)
 -- | Fragment definition.
 data FragmentDefinition
    = FragmentDefinition Name TypeCondition Directives SelectionSet
    deriving (Eq, Show)
 {-# DEPRECATED FragmentName "Use Name instead" #-}
 type FragmentName = Name
 -- | Type condition.
 type TypeCondition = Name
 -- * Input values
 -- | Input value.
 data Value = ValueVariable Name
           | ValueInt Int32
           | ValueFloat Double
           | ValueString Text
           | ValueBoolean Bool
           | ValueNull
           | ValueEnum Name
           | ValueList [Value]
           | ValueObject [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 list.
 type VariableDefinitions = [VariableDefinition]
 -- | Variable definition.
 data VariableDefinition = VariableDefinition Name Type (Maybe Value)
                          deriving (Eq, Show)
 -- * Input types
 -- | Type representation.
 data Type = TypeNamed   Name
          | TypeList    Type
          | TypeNonNull NonNullType
            deriving (Eq, Show)
 -- | Helper type to represent Non-Null types and lists of such types.
 data NonNullType = NonNullTypeNamed Name
                 | NonNullTypeList  Type
                   deriving (Eq, Show)
 -- * Directives
 -- | Directive list.
 type Directives = [Directive]
 -- | Directive.
 data Directive = Directive Name [Argument] deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@ -0,0 +1,102 @@
 -- | This is the AST meant to be executed.
 module Language.GraphQL.AST.Core
    ( Alias
    , Argument(..)
    , Document
    , Field(..)
    , Name
    , ObjectField(..)
    , Operation(..)
    , Value(..)
    ) where
 import Data.Int (Int32)
 import Data.List.NonEmpty (NonEmpty)
 import Data.String
 import Data.Text (Text)
 -- | Name
 type Name = Text
 -- | 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) (NonEmpty Field)
    | Mutation (Maybe Text) (NonEmpty Field)
    deriving (Eq, Show)
 -- | A single GraphQL field.
 --
 -- Only required property of a field, is its name. Optionally it can also have
 -- an alias, arguments or a list of subfields.
 --
 -- Given the following query:
 --
 -- @
 -- {
 --   zuck: user(id: 4) {
 --     id
 --     name
 --   }
 -- }
 -- @
 --
 -- * "user", "id" and "name" are field names.
 -- * "user" has two subfields, "id" and "name".
 -- * "zuck" is an alias for "user". "id" and "name" have no aliases.
 -- * "id: 4" is an argument for "name". "id" and "name don't have any
 -- arguments.
 data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq, Show)
 -- | Alternative field name.
 --
 -- @
 -- {
 --   smallPic: profilePic(size: 64)
 --   bigPic: profilePic(size: 1024)
 -- }
 -- @
 --
 -- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
 -- used to distinquish between profile pictures with different arguments
 -- (sizes).
 type Alias = Name
 -- | Single argument.
 --
 -- @
 -- {
 --   user(id: 4) {
 --     name
 --   }
 -- }
 -- @
 --
 --  Here "id" is an argument for the field "user" and its value is 4.
 data Argument = Argument Name Value deriving (Eq, Show)
 -- | Represents accordingly typed GraphQL values.
 data Value
    = ValueInt Int32
    -- GraphQL Float is double precision
    | ValueFloat Double
    | ValueString Text
    | ValueBoolean Bool
    | ValueNull
    | ValueEnum Name
    | ValueList [Value]
    | ValueObject [ObjectField]
    deriving (Eq, Show)
 instance IsString Value where
  fromString = ValueString . fromString
 -- | Key-value pair.
 --
 -- A list of 'ObjectField's represents a GraphQL object type.
 data ObjectField = ObjectField Name Value deriving (Eq, Show)
--- a/src/Language/GraphQL/AST/Transform.hs
+++ b/src/Language/GraphQL/AST/Transform.hs
@ -0,0 +1,120 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.AST.Transform
    ( document
    ) where
 import Control.Applicative (empty)
 import Control.Monad ((<=<))
 import Data.Bifunctor (first)
 import Data.Either (partitionEithers)
 import Data.Foldable (fold, foldMap)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Monoid (Alt(Alt,getAlt), (<>))
 import qualified Language.GraphQL.AST as Full
 import qualified Language.GraphQL.AST.Core as Core
 import qualified Language.GraphQL.Schema as Schema
 -- | Replaces a fragment name by a list of 'Field'. If the name doesn't match an
 --   empty list is returned.
 type Fragmenter = Core.Name -> [Core.Field]
 -- | Rewrites the original syntax tree into an intermediate representation used
 -- for query execution.
 document :: Schema.Subs -> Full.Document -> Maybe Core.Document
 document subs doc = operations subs fr ops
  where
    (fr, ops) = first foldFrags
              . partitionEithers
              . NonEmpty.toList
              $ defrag subs
            <$> doc
    foldFrags :: [Fragmenter] -> Fragmenter
    foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs
 -- * Operation
 -- TODO: Replace Maybe by MonadThrow CustomError
 operations
  :: Schema.Subs
  -> Fragmenter
  -> [Full.OperationDefinition]
  -> Maybe Core.Document
 operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr)
 operation
  :: Schema.Subs
  -> Fragmenter
  -> Full.OperationDefinition
  -> Maybe Core.Operation
 operation subs fr (Full.OperationSelectionSet sels) =
  operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels
 -- TODO: Validate Variable definitions with substituter
 operation subs fr (Full.OperationDefinition operationType name _vars _dirs sels)
    = case operationType of
        Full.Query -> Core.Query name <$> node
        Full.Mutation -> Core.Mutation name <$> node
  where
    node = traverse (hush . selection subs fr) sels
 selection
  :: Schema.Subs
  -> Fragmenter
  -> Full.Selection
  -> Either [Core.Field] Core.Field
 selection subs fr (Full.SelectionField fld) =
  Right $ field subs fr fld
 selection _    fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) =
  Left $ fr n
 selection _ _  (Full.SelectionInlineFragment _)  =
  error "Inline fragments not supported yet"
 -- * Fragment replacement
 -- | Extract Fragments into a single Fragmenter function and a Operation
 --   Definition.
 defrag
  :: Schema.Subs
  -> Full.Definition
  -> Either Fragmenter Full.OperationDefinition
 defrag _    (Full.DefinitionOperation op) =
  Right op
 defrag subs (Full.DefinitionFragment fragDef) =
  Left $ fragmentDefinition subs fragDef
 fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter
 fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' =
  -- TODO: Support fragments within fragments. Fold instead of map.
  if name == name'
  then either id pure =<< NonEmpty.toList (selection subs mempty <$> sels)
  else empty
 field :: Schema.Subs -> Fragmenter -> Full.Field -> Core.Field
 field subs fr (Full.Field a n args _dirs sels) =
    Core.Field a n (fold $ argument subs `traverse` args) (foldr go empty sels)
  where
    go :: Full.Selection -> [Core.Field] -> [Core.Field]
    go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) = (fr name <>)
    go sel =  (either id pure (selection subs fr sel) <>)
 argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument
 argument subs (Full.Argument n v) = Core.Argument n <$> value subs v
 value :: Schema.Subs -> Full.Value -> Maybe Core.Value
 value subs (Full.ValueVariable n) = subs n
 value _    (Full.ValueInt      i) = pure $ Core.ValueInt i
 value _    (Full.ValueFloat    f) = pure $ Core.ValueFloat f
 value _    (Full.ValueString   x) = pure $ Core.ValueString x
 value _    (Full.ValueBoolean  b) = pure $ Core.ValueBoolean b
 value _     Full.ValueNull        = pure   Core.ValueNull
 value _    (Full.ValueEnum     e) = pure $ Core.ValueEnum e
 value subs (Full.ValueList     l) =
  Core.ValueList   <$> traverse (value subs) l
 value subs (Full.ValueObject   o) =
  Core.ValueObject <$> traverse (objectField subs) o
 objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField
 objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v
 hush :: Either a b -> Maybe b
 hush = either (const Nothing) Just
--- a/src/Language/GraphQL/Encoder.hs
+++ b/src/Language/GraphQL/Encoder.hs
@ -0,0 +1,277 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ExplicitForAll #-}
 -- | This module defines a minifier and a printer for the @GraphQL@ language.
 module Language.GraphQL.Encoder
    ( Formatter
    , definition
    , directive
    , document
    , minified
    , pretty
    , type'
    , value
    ) where
 import Data.Foldable (fold)
 import Data.Monoid ((<>))
 import qualified Data.List.NonEmpty as NonEmpty (toList)
 import Data.Text.Lazy (Text)
 import qualified Data.Text.Lazy as Text.Lazy
 import Data.Text.Lazy.Builder (toLazyText)
 import Data.Text.Lazy.Builder.Int (decimal)
 import Data.Text.Lazy.Builder.RealFloat (realFloat)
 import Language.GraphQL.AST
 -- | Instructs the encoder whether a GraphQL should be minified or pretty
 --   printed.
 --   
 --   Use 'pretty' and '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 -> Text
 document formatter defs
    | Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument
    | Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n'
  where
    encodeDocument = NonEmpty.toList $ definition formatter <$> defs
 -- | Converts a 'Definition' into a string.
 definition :: Formatter -> Definition -> Text
 definition formatter x
    | Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n'
    | Minified <- formatter = encodeDefinition x
  where
    encodeDefinition (DefinitionOperation operation)
        = operationDefinition formatter operation
    encodeDefinition (DefinitionFragment fragment)
        = fragmentDefinition formatter fragment
 operationDefinition :: Formatter -> OperationDefinition -> Text
 operationDefinition formatter (OperationSelectionSet sels)
    = selectionSet formatter sels
 operationDefinition formatter (OperationDefinition Query name vars dirs sels)
    = "query " <> node formatter name vars dirs sels
 operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
    = "mutation " <> node formatter name vars dirs sels
 node :: Formatter
     -> Maybe Name
     -> VariableDefinitions
     -> Directives
     -> SelectionSet
     -> Text
 node formatter name vars dirs sels
    = Text.Lazy.fromStrict (fold name)
    <> optempty (variableDefinitions formatter) vars
    <> optempty (directives formatter) dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 variableDefinitions :: Formatter -> [VariableDefinition] -> Text
 variableDefinitions formatter
    = parensCommas formatter $ variableDefinition formatter
 variableDefinition :: Formatter -> VariableDefinition -> Text
 variableDefinition formatter (VariableDefinition var ty dv)
    = variable var
    <> eitherFormat formatter ": " ":"
    <> type' ty
    <> maybe mempty (defaultValue formatter) dv
 defaultValue :: Formatter -> Value -> Text
 defaultValue formatter val
    = eitherFormat formatter " = " "="
    <> value formatter val
 variable :: Name -> Text
 variable var = "$" <> Text.Lazy.fromStrict var
 selectionSet :: Formatter -> SelectionSet -> Text
 selectionSet formatter
    = bracesList formatter (selection formatter)
    . NonEmpty.toList
 selectionSetOpt :: Formatter -> SelectionSetOpt -> Text
 selectionSetOpt formatter = bracesList formatter $ selection formatter
 selection :: Formatter -> Selection -> Text
 selection formatter = Text.Lazy.append indent . f
  where
    f (SelectionField x) = field incrementIndent x
    f (SelectionInlineFragment x) = inlineFragment incrementIndent x
    f (SelectionFragmentSpread x) = fragmentSpread incrementIndent x
    incrementIndent
        | Pretty n <- formatter = Pretty $ n + 1
        | otherwise = Minified
    indent
        | Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) "  "
        | otherwise = mempty
 field :: Formatter -> Field -> Text
 field formatter (Field alias name args dirs selso)
    = optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias)
    <> Text.Lazy.fromStrict name
    <> optempty (arguments formatter) args
    <> optempty (directives formatter) dirs
    <> selectionSetOpt'
  where
    colon = eitherFormat formatter ": " ":"
    selectionSetOpt'
        | null selso = mempty
        | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
 arguments :: Formatter -> [Argument] -> Text
 arguments formatter = parensCommas formatter $ argument formatter
 argument :: Formatter -> Argument -> Text
 argument formatter (Argument name v)
    = Text.Lazy.fromStrict name
    <> eitherFormat formatter ": " ":"
    <> value formatter v
 -- * Fragments
 fragmentSpread :: Formatter -> FragmentSpread -> Text
 fragmentSpread formatter (FragmentSpread name ds)
    = "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds
 inlineFragment :: Formatter -> InlineFragment -> Text
 inlineFragment formatter (InlineFragment tc dirs sels)
    = "... on "
    <> Text.Lazy.fromStrict (fold tc)
    <> directives formatter dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 fragmentDefinition :: Formatter -> FragmentDefinition -> Text
 fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
    = "fragment " <> Text.Lazy.fromStrict name
    <> " on " <> Text.Lazy.fromStrict tc
    <> optempty (directives formatter) dirs
    <> eitherFormat formatter " " mempty
    <> selectionSet formatter sels
 -- * Miscellaneous
 -- | Converts a 'Directive' into a string.
 directive :: Formatter -> Directive -> Text
 directive formatter (Directive name args)
    = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args
 directives :: Formatter -> Directives -> Text
 directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
 directives Minified = spaces (directive Minified)
 -- | Converts a 'Value' into a string.
 value :: Formatter -> Value -> Text
 value _ (ValueVariable x) = variable x
 value _ (ValueInt x) = toLazyText $ decimal x
 value _ (ValueFloat x) = toLazyText $ realFloat x
 value _ (ValueBoolean  x) = booleanValue x
 value _ ValueNull = mempty
 value _ (ValueString x) = stringValue $ Text.Lazy.fromStrict x
 value _ (ValueEnum x) = Text.Lazy.fromStrict x
 value formatter (ValueList x) = listValue formatter x
 value formatter (ValueObject x) = objectValue formatter x
 booleanValue :: Bool -> Text
 booleanValue True  = "true"
 booleanValue False = "false"
 stringValue :: Text -> Text
 stringValue
    = quotes
    . Text.Lazy.replace "\"" "\\\""
    . Text.Lazy.replace "\\" "\\\\"
 listValue :: Formatter -> [Value] -> Text
 listValue formatter = bracketsCommas formatter $ value formatter
 objectValue :: Formatter -> [ObjectField] -> Text
 objectValue formatter = intercalate $ objectField formatter
  where
    intercalate f
        = braces
        . Text.Lazy.intercalate (eitherFormat formatter ", " ",")
        . fmap f
 objectField :: Formatter -> ObjectField -> Text
 objectField formatter (ObjectField name v)
    = Text.Lazy.fromStrict name <> colon <> value formatter v
  where
    colon
      | Pretty _ <- formatter = ": "
      | Minified <- formatter = ":"
 -- | Converts a 'Type' a type into a string.
 type' :: Type -> Text
 type' (TypeNamed   x) = Text.Lazy.fromStrict x
 type' (TypeList    x) = listType x
 type' (TypeNonNull x) = nonNullType x
 listType :: Type -> Text
 listType x = brackets (type' x)
 nonNullType :: NonNullType -> Text
 nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
 nonNullType (NonNullTypeList  x) = listType x <> "!"
 -- * Internal
 between :: Char -> Char -> Text -> Text
 between open close = Text.Lazy.cons open . (`Text.Lazy.snoc` close)
 parens :: Text -> Text
 parens = between '(' ')'
 brackets :: Text -> Text
 brackets = between '[' ']'
 braces :: Text -> Text
 braces = between '{' '}'
 quotes :: Text -> Text
 quotes = between '"' '"'
 spaces :: forall a. (a -> Text) -> [a] -> Text
 spaces f = Text.Lazy.intercalate "\SP" . fmap f
 parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text
 parensCommas formatter f
    = parens
    . Text.Lazy.intercalate (eitherFormat formatter ", " ",")
    . fmap f
 bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text
 bracketsCommas formatter f
    = brackets
    . Text.Lazy.intercalate (eitherFormat formatter ", " ",")
    . fmap f
 bracesList :: forall a. Formatter -> (a -> Text) -> [a] -> Text
 bracesList (Pretty intendation) f xs
    = Text.Lazy.snoc (Text.Lazy.intercalate "\n" content) '\n'
    <> (Text.Lazy.snoc $ Text.Lazy.replicate (fromIntegral intendation) "  ") '}'
  where
    content = "{" : fmap f xs
 bracesList Minified f xs = braces $ Text.Lazy.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/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -0,0 +1,83 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 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(..)
                       , 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 (sourcePosition, _, newState) = reachOffset (errorOffset x) state
         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,76 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
    ( execute
    , executeWithName
    ) where
 import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Aeson as Aeson
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as AST
 import qualified Language.GraphQL.AST.Core as AST.Core
 import qualified Language.GraphQL.AST.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 :: MonadIO m
    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
    -> Schema.Subs -- ^ Variable substitution function.
    -> AST.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 :: MonadIO m
    => NonEmpty (Schema.Resolver m) -- ^ Resolvers
    -> Text -- ^ Operation name.
    -> Schema.Subs -- ^ Variable substitution function.
    -> AST.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 :: MonadIO m
    => 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 NE.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 :: MonadIO m
    => NonEmpty (Schema.Resolver m)
    -> AST.Core.Operation
    -> m Aeson.Value
 operation schema (AST.Core.Query _ flds)
    = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
 operation schema (AST.Core.Mutation _ flds)
    = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
--- a/src/Language/GraphQL/Lexer.hs
+++ b/src/Language/GraphQL/Lexer.hs
@ -0,0 +1,228 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module defines a bunch of small parsers used to parse individual
 --   lexemes.
 module Language.GraphQL.Lexer 
    ( Parser
    , amp
    , at
    , bang
    , blockString
    , braces
    , brackets
    , colon
    , dollar
    , comment
    , equals
    , 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 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 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 Char
 bang = char '!'
 -- | Parser for "$".
 dollar :: Parser Char
 dollar = char '$'
 -- | Parser for "@".
 at :: Parser Char
 at = char '@'
 -- | 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
  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
  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 ()
--- a/src/Language/GraphQL/Parser.hs
+++ b/src/Language/GraphQL/Parser.hs
@ -0,0 +1,186 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.Parser
    ( document
    ) where
 import Control.Applicative ( Alternative(..)
                           , optional
                           )
 import Data.List.NonEmpty (NonEmpty(..))
 import Language.GraphQL.AST
 import Language.GraphQL.Lexer
 import Text.Megaparsec ( lookAhead
                       , option
                       , try
                       , (<?>)
                       )
 -- | Parser for the GraphQL documents.
 document :: Parser Document
 document = unicodeBOM >> spaceConsumer >> lexeme (manyNE definition)
 definition :: Parser Definition
 definition = DefinitionOperation <$> operationDefinition
         <|> DefinitionFragment  <$> fragmentDefinition
         <?> "definition error!"
 operationDefinition :: Parser OperationDefinition
 operationDefinition = OperationSelectionSet <$> selectionSet
                  <|> OperationDefinition   <$> operationType
                                            <*> optional name
                                            <*> opt variableDefinitions
                                            <*> opt directives
                                            <*> selectionSet
                  <?> "operationDefinition error"
 operationType :: Parser OperationType
 operationType = Query <$ symbol "query"
    <|> Mutation <$ symbol "mutation"
    <?> "operationType error"
 -- * SelectionSet
 selectionSet :: Parser SelectionSet
 selectionSet = braces $ manyNE selection
 selectionSetOpt :: Parser SelectionSetOpt
 selectionSetOpt = braces $ some selection
 selection :: Parser Selection
 selection = SelectionField          <$> field
        <|> try (SelectionFragmentSpread <$> fragmentSpread)
        <|> SelectionInlineFragment <$> inlineFragment
        <?> "selection error!"
 -- * Field
 field :: Parser Field
 field = Field <$> optional alias
              <*> name
              <*> opt arguments
              <*> opt directives
              <*> opt selectionSetOpt
 alias :: Parser Alias
 alias = try $ name <* colon
 -- * Arguments
 arguments :: Parser Arguments
 arguments = parens $ some argument
 argument :: Parser Argument
 argument = Argument <$> name <* colon <*> value
 -- * Fragments
 fragmentSpread :: Parser FragmentSpread
 fragmentSpread = FragmentSpread <$  spread
                                <*> fragmentName
                                <*> opt directives
 inlineFragment :: Parser InlineFragment
 inlineFragment = InlineFragment <$  spread
                                <*> optional typeCondition
                                <*> opt directives
                                <*> selectionSet
 fragmentDefinition :: Parser FragmentDefinition
 fragmentDefinition = FragmentDefinition
                 <$  symbol "fragment"
                 <*> name
                 <*> typeCondition
                 <*> opt directives
                 <*> selectionSet
 fragmentName :: Parser Name
 fragmentName = but (symbol "on") *> name
 typeCondition :: Parser TypeCondition
 typeCondition = symbol "on" *> name
 -- * Input Values
 value :: Parser Value
 value = ValueVariable <$> variable
    <|> ValueFloat    <$> try float
    <|> ValueInt      <$> integer
    <|> ValueBoolean  <$> booleanValue
    <|> ValueNull     <$  symbol "null"
    <|> ValueString   <$> blockString
    <|> ValueString   <$> string
    <|> ValueEnum     <$> try enumValue
    <|> ValueList     <$> listValue
    <|> ValueObject   <$> objectValue
    <?> "value error!"
  where
    booleanValue :: Parser Bool
    booleanValue = True  <$ symbol "true"
               <|> False <$ symbol "false"
    enumValue :: Parser Name
    enumValue = but (symbol "true") *> but (symbol "false") *> but (symbol "null") *> name
    listValue :: Parser [Value]
    listValue = brackets $ some value
    objectValue :: Parser [ObjectField]
    objectValue = braces $ some objectField
 objectField :: Parser ObjectField
 objectField = ObjectField <$> name <* symbol ":" <*> value
 -- * Variables
 variableDefinitions :: Parser VariableDefinitions
 variableDefinitions = parens $ some variableDefinition
 variableDefinition :: Parser VariableDefinition
 variableDefinition = VariableDefinition <$> variable
                                        <*  colon
                                        <*> type_
                                        <*> optional defaultValue
 variable :: Parser Name
 variable = dollar *> name
 defaultValue :: Parser Value
 defaultValue = equals *> value
 -- * Input Types
 type_ :: Parser Type
 type_ = try (TypeNamed <$> name <* but "!")
    <|> TypeList       <$> brackets type_
    <|> TypeNonNull    <$> nonNullType
    <?> "type_ error!"
 nonNullType :: Parser NonNullType
 nonNullType = NonNullTypeNamed <$> name <* bang
          <|> NonNullTypeList  <$> brackets type_  <* bang
          <?> "nonNullType error!"
 -- * Directives
 directives :: Parser Directives
 directives = some directive
 directive :: Parser Directive
 directive = Directive
        <$  at
        <*> name
        <*> opt arguments
 -- * Internal
 opt :: Monoid a => Parser a -> Parser a
 opt = option mempty
 -- Hack to reverse parser success
 but :: Parser a -> Parser ()
 but pn = False <$ lookAhead pn <|> pure True >>= \case
    False -> empty
    True  -> pure ()
 manyNE :: Alternative f => f a -> f (NonEmpty a)
 manyNE p = (:|) <$> p <*> many p
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@ -0,0 +1,172 @@
 {-# 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
    , Schema
    , Subs
    , object
    , objectA
    , scalar
    , scalarA
    , enum
    , enumA
    , resolve
    , wrappedEnum
    , wrappedEnumA
    , wrappedObject
    , wrappedObjectA
    , wrappedScalar
    , wrappedScalarA
    -- * AST Reexports
    , Field
    , Argument(..)
    , Value(..)
    ) where
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Data.Foldable ( find
                     , fold
                     )
 import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as Aeson
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as T
 import Language.GraphQL.Error
 import Language.GraphQL.Trans
 import Language.GraphQL.Type
 import Language.GraphQL.AST.Core
 {-# DEPRECATED Schema "Use NonEmpty (Resolver m) instead" #-}
 -- | A GraphQL schema.
 --   @m@ is usually expected to be an instance of 'MonadIO'.
 type Schema m = NonEmpty (Resolver m)
 -- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information
 --   (or 'empty'). @m@ is usually expected to be an instance of 'MonadIO.
 data Resolver m = Resolver
    Text -- ^ Name
    (Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
 type Fields = [Field]
 type Arguments = [Argument]
 -- | Variable substitution function.
 type Subs = Name -> Maybe Value
 -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
 object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m
 object name = objectA name . const
 -- | Like 'object' but also taking 'Argument's.
 objectA :: MonadIO m
    => Name -> (Arguments -> ActionT m [Resolver m]) -> Resolver m
 objectA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ flds) resolver = withField (resolve resolver flds) fld
 -- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
 wrappedObjectA :: MonadIO m
    => Name -> (Arguments -> ActionT m (Wrapping [Resolver m])) -> Resolver m
 wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld@(Field _ _ _ sels) resolver
        = withField (traverse (`resolve` sels) resolver) fld
 -- | Like 'object' but can be null or a list of objects.
 wrappedObject :: MonadIO m
    => Name -> ActionT m (Wrapping [Resolver m]) -> Resolver m
 wrappedObject name = wrappedObjectA name . const
 -- | A scalar represents a primitive value, like a string or an integer.
 scalar :: (MonadIO m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m
 scalar name = scalarA name . const
 -- | Like 'scalar' but also taking 'Argument's.
 scalarA :: (MonadIO m, Aeson.ToJSON a)
    => Name -> (Arguments -> ActionT m a) -> Resolver m
 scalarA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld result = withField (return result) fld
 -- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars.
 wrappedScalarA :: (MonadIO m, Aeson.ToJSON a)
    => Name -> (Arguments -> ActionT m (Wrapping a)) -> Resolver m
 wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld (Named result) = withField (return result) fld
    resolveRight fld Null
        = return $ HashMap.singleton (aliasOrName fld) Aeson.Null
    resolveRight fld (List result) = withField (return result) fld
 -- | Like 'scalar' but can be null or a list of scalars.
 wrappedScalar :: (MonadIO m, Aeson.ToJSON a)
    => Name -> ActionT m (Wrapping a) -> Resolver m
 wrappedScalar name = wrappedScalarA name . const
 {-# DEPRECATED enum "Use scalar instead" #-}
 enum :: MonadIO m => Name -> ActionT m [Text] -> Resolver m
 enum name = enumA name . const
 {-# DEPRECATED enumA "Use scalarA instead" #-}
 enumA :: MonadIO m => Name -> (Arguments -> ActionT m [Text]) -> Resolver m
 enumA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld resolver = withField (return resolver) fld
 {-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-}
 wrappedEnumA :: MonadIO m
    => Name -> (Arguments -> ActionT m (Wrapping [Text])) -> Resolver m
 wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
  where
    resolveRight fld (Named resolver) = withField (return resolver) fld
    resolveRight fld Null
        = return $ HashMap.singleton (aliasOrName fld) Aeson.Null
    resolveRight fld (List resolver) = withField (return resolver) fld
 {-# DEPRECATED wrappedEnum "Use wrappedScalar instead" #-}
 wrappedEnum :: MonadIO m => Name -> ActionT m (Wrapping [Text]) -> Resolver m
 wrappedEnum name = wrappedEnumA name . const
 resolveFieldValue :: MonadIO m
    => ([Argument] -> ActionT m a)
    -> (Field -> a -> CollectErrsT m (HashMap Text Aeson.Value))
    -> Field
    -> CollectErrsT m (HashMap Text Aeson.Value)
 resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
    result <- lift $ runExceptT . runActionT $ f args
    either resolveLeft (resolveRight fld) result
      where
        resolveLeft err = do
            _ <- addErrMsg err
            return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 -- | Helper function to facilitate 'Argument' handling.
 withField :: (MonadIO m, Aeson.ToJSON a)
    => CollectErrsT m a -> Field -> CollectErrsT m (HashMap Text Aeson.Value)
 withField v fld
    = HashMap.singleton (aliasOrName fld) . Aeson.toJSON <$> runAppendErrs v
 -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
 --   'Resolver' to each 'Field'. Resolves into a value containing the
 --   resolved 'Field', or a null value and error information.
 resolve :: MonadIO m
    => [Resolver m] -> Fields -> CollectErrsT m Aeson.Value
 resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
  where
    tryResolvers fld = maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers fld) resolvers
    compareResolvers (Field _ name _ _) (Resolver name' _) = name == name'
    tryResolver fld (Resolver _ resolver)  = resolver fld
    errmsg fld@(Field _ name _ _) = do
        addErrMsg $ T.unwords ["field", name, "not resolved."]
        return $ HashMap.singleton (aliasOrName fld) Aeson.Null
 aliasOrName :: Field -> Text
 aliasOrName (Field alias name _ _) = fromMaybe name alias
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@ -0,0 +1,38 @@
 module Language.GraphQL.Trans
    ( ActionT(..)
    ) 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 Data.Text (Text)
 -- | Monad transformer stack used by the resolvers to provide error handling.
 newtype ActionT m a = ActionT { runActionT :: ExceptT Text 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
 instance MonadIO m => MonadIO (ActionT m) where
    liftIO = lift . liftIO
 instance Monad m => Alternative (ActionT m) where
    empty = ActionT empty
    (ActionT x) <|> (ActionT y) = ActionT $ x <|> y
 instance Monad m => MonadPlus (ActionT m) where
    mzero = empty
    mplus = (<|>)
--- a/src/Language/GraphQL/Type.hs
+++ b/src/Language/GraphQL/Type.hs
@ -0,0 +1,57 @@
 -- | Definitions for @GraphQL@ type system.
 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/stack-7.10.yaml
+++ b/stack-7.10.yaml
@ -1,5 +0,0 @@
 flags: {}
 packages:
 - '.'
 extra-deps: []
 resolver: lts-3.4
--- a/stack-7.8.yaml
+++ b/stack-7.8.yaml
@ -1,5 +0,0 @@
 flags: {}
 packages:
 - '.'
 extra-deps: []
 resolver: lts-2.22
--- a/stack.yaml
+++ b/stack.yaml
@ -1 +0,0 @@
 stack-7.10.yaml
--- a/stack.yaml
+++ b/stack.yaml
@ -0,0 +1,6 @@
 resolver: lts-14.5
 packages:
 - '.'
 extra-deps: []
 flags: {}
 extra-package-dbs: []
--- a/tests/Language/GraphQL/EncoderSpec.hs
+++ b/tests/Language/GraphQL/EncoderSpec.hs
@ -0,0 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.EncoderSpec
    ( spec
    ) where
 import Language.GraphQL.AST ( Value(..))
 import Language.GraphQL.Encoder ( value
                                , minified
                                )
 import Test.Hspec ( Spec
                  , describe
                  , it
                  , shouldBe
                  )
 spec :: Spec
 spec = describe "value" $ do
    it "escapes \\" $
        value minified (ValueString "\\") `shouldBe` "\"\\\\\""
    it "escapes quotes" $
        value minified (ValueString "\"") `shouldBe` "\"\\\"\""
--- 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/Language/GraphQL/LexerSpec.hs
+++ b/tests/Language/GraphQL/LexerSpec.hs
@ -0,0 +1,104 @@
 {-# LANGUAGE ExplicitForAll #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.LexerSpec
    ( spec
    ) where
 import Data.Either (isRight)
 import Data.Text (Text)
 import Data.Void (Void)
 import Language.GraphQL.Lexer
 import Test.Hspec ( Spec
                  , context
                  , describe
                  , it
                  , shouldBe
                  , shouldSatisfy
                  )
 import Text.Megaparsec ( ParseErrorBundle
                       , parse
                       )
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Lexer" $ do
    context "Reference tests" $ do
        it "accepts BOM header" $
            runParser unicodeBOM "\xfeff" `shouldSatisfy` isRight
        it "lexes strings" $ do
            runParser string [r|"simple"|] `shouldBe` Right "simple"
            runParser string [r|" white space "|] `shouldBe` Right " white space "
            runParser string [r|"quote \""|] `shouldBe` Right [r|quote "|]
            runParser string [r|"escaped \n"|] `shouldBe` Right "escaped \n"
            runParser string [r|"slashes \\ \/"|] `shouldBe` Right [r|slashes \ /|]
            runParser string [r|"unicode \u1234\u5678\u90AB\uCDEF"|]
                `shouldBe` Right "unicode ሴ噸邫췯"
        it "lexes block string" $ do
            runParser blockString [r|"""simple"""|] `shouldBe` Right "simple"
            runParser blockString [r|""" white space """|]
                `shouldBe` Right " white space "
            runParser blockString [r|"""contains " quote"""|]
                `shouldBe` Right [r|contains " quote|]
            runParser blockString [r|"""contains \""" triplequote"""|]
                `shouldBe` Right [r|contains """ triplequote|]
            runParser blockString "\"\"\"multi\nline\"\"\"" `shouldBe` Right "multi\nline"
            runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldBe` Right "multi\nline\nnormalized"
            runParser blockString "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldBe` Right "multi\nline\nnormalized"
            runParser blockString [r|"""unescaped \n\r\b\t\f\u1234"""|]
                `shouldBe` Right [r|unescaped \n\r\b\t\f\u1234|]
            runParser blockString [r|"""slashes \\ \/"""|]
                `shouldBe` Right [r|slashes \\ \/|]
            runParser blockString [r|"""
                spans
                  multiple
                    lines
                """|] `shouldBe` Right "spans\n  multiple\n    lines"
        it "lexes numbers" $ do
            runParser integer "4" `shouldBe` Right (4 :: Int)
            runParser float "4.123" `shouldBe` Right 4.123
            runParser integer "-4" `shouldBe` Right (-4 :: Int)
            runParser integer "9" `shouldBe` Right (9 :: Int)
            runParser integer "0" `shouldBe` Right (0 :: Int)
            runParser float "-4.123" `shouldBe` Right (-4.123)
            runParser float "0.123" `shouldBe` Right 0.123
            runParser float "123e4" `shouldBe` Right 123e4
            runParser float "123E4" `shouldBe` Right 123E4
            runParser float "123e-4" `shouldBe` Right 123e-4
            runParser float "123e+4" `shouldBe` Right 123e+4
            runParser float "-1.123e4" `shouldBe` Right (-1.123e4)
            runParser float "-1.123E4" `shouldBe` Right (-1.123E4)
            runParser float "-1.123e-4" `shouldBe` Right (-1.123e-4)
            runParser float "-1.123e+4" `shouldBe` Right (-1.123e+4)
            runParser float "-1.123e4567" `shouldBe` Right (-1.123e4567)
        it "lexes punctuation" $ do
            runParser bang "!" `shouldBe` Right '!'
            runParser dollar "$" `shouldBe` Right '$'
            runBetween parens "()" `shouldSatisfy` isRight
            runParser spread "..." `shouldBe` Right "..."
            runParser colon ":" `shouldBe` Right ":"
            runParser equals "=" `shouldBe` Right "="
            runParser at "@" `shouldBe` Right '@'
            runBetween brackets "[]" `shouldSatisfy` isRight
            runBetween braces "{}" `shouldSatisfy` isRight
            runParser pipe "|" `shouldBe` Right "|"
    context "Implementation tests" $ do
        it "lexes empty block strings" $
            runParser blockString [r|""""""|] `shouldBe` Right ""
        it "lexes ampersand" $
            runParser amp "&" `shouldBe` Right "&"
 runParser :: forall a. Parser a -> Text -> Either (ParseErrorBundle Text Void) a
 runParser = flip parse ""
 runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) ()
 runBetween parser = parse (parser $ pure ()) ""
--- a/tests/Language/GraphQL/ParserSpec.hs
+++ b/tests/Language/GraphQL/ParserSpec.hs
@ -0,0 +1,30 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.ParserSpec
    ( spec
    ) where
 import Data.Either (isRight)
 import Language.GraphQL.Parser (document)
 import Test.Hspec ( Spec
                  , describe
                  , it
                  , shouldSatisfy
                  )
 import Text.Megaparsec (parse)
 import Text.RawString.QQ (r)
 spec :: Spec
 spec = describe "Parser" $ do
    it "accepts BOM header" $
        parse document "" "\xfeff{foo}" `shouldSatisfy` isRight
    it "accepts block strings as argument" $
        parse document "" [r|{
              hello(text: """Argument""")
            }|] `shouldSatisfy` isRight
    it "accepts strings as argument" $
        parse document "" [r|{
              hello(text: "Argument")
            }|] `shouldSatisfy` isRight
--- a/tests/Spec.hs
+++ b/tests/Spec.hs
@ -0,0 +1 @@
 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--- a/tests/Test/KitchenSinkSpec.hs
+++ b/tests/Test/KitchenSinkSpec.hs
@ -0,0 +1,76 @@
 {-# 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 Language.GraphQL.Encoder as Encoder
 import qualified Language.GraphQL.Parser as Parser
 import Paths_graphql (getDataFileName)
 import Test.Hspec ( Spec
                  , describe
                  , it
                  )
 import Test.Hspec.Expectations ( expectationFailure
                               , shouldBe
                               )
 import Text.Megaparsec ( errorBundlePretty
                       , 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"
        actual <- Text.IO.readFile dataFileName
        expected <- Text.Lazy.IO.readFile minFileName
        either
            (expectationFailure . errorBundlePretty)
            (flip shouldBe expected . Encoder.document Encoder.minified)
            $ parse Parser.document dataFileName actual
    it "pretty prints the query" $ do
        dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"
        actual <- Text.IO.readFile dataFileName
        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
 }
 |]
        either
            (expectationFailure . errorBundlePretty)
            (flip shouldBe expected . Encoder.document Encoder.pretty)
            $ parse Parser.document dataFileName actual
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@ -0,0 +1,198 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data
    ( Character
    , appearsIn
    , artoo
    , getDroid
    , getDroid'
    , getEpisode
    , getFriends
    , getHero
    , getHeroIO
    , getHuman
    , id_
    , homePlanet
    , name
    , secretBackstory
    , typeName
    ) where
 import Data.Monoid (mempty)
 import Control.Applicative ( Alternative(..)
                           , liftA2 
                           )
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Language.GraphQL.Trans
 import Language.GraphQL.Type
 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
 -- ** Characters
 type ID = Text
 data CharCommon = CharCommon
  { _id_        :: ID
  , _name       :: Text
  , _friends    :: [ID]
  , _appearsIn  :: [Int]
  } deriving (Show)
 data Human = Human
  { _humanChar  :: CharCommon
  , homePlanet :: Text
  }
 data Droid = Droid
  { _droidChar       :: CharCommon
  , primaryFunction :: Text
  }
 type Character = Either Droid Human
 id_ :: Character -> ID
 id_ (Left  x) = _id_ . _droidChar $ x
 id_ (Right x) = _id_ . _humanChar $ x
 name :: Character -> Text
 name (Left  x) = _name . _droidChar $ x
 name (Right x) = _name . _humanChar $ x
 friends :: Character -> [ID]
 friends (Left  x) = _friends . _droidChar $ x
 friends (Right x) = _friends . _humanChar $ x
 appearsIn :: Character -> [Int]
 appearsIn (Left  x) = _appearsIn . _droidChar $ x
 appearsIn (Right x) = _appearsIn . _humanChar $ x
 secretBackstory :: MonadIO m => Character -> ActionT m Text
 secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
 typeName :: Character -> Text
 typeName = either (const "Droid") (const "Human")
 luke :: Character
 luke = Right luke'
 luke' :: Human
 luke' = Human
  { _humanChar = CharCommon
      { _id_        = "1000"
      , _name       = "Luke Skywalker"
      , _friends    = ["1002","1003","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 vader :: Human
 vader = Human
  { _humanChar = CharCommon
      { _id_        = "1001"
      , _name       = "Darth Vader"
      , _friends    = ["1004"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Tatooine"
  }
 han :: Human
 han = Human
  { _humanChar = CharCommon
      { _id_        = "1002"
      , _name       = "Han Solo"
      , _friends    = ["1000","1003","2001" ]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = mempty
  }
 leia :: Human
 leia = Human
  { _humanChar = CharCommon
      { _id_        = "1003"
      , _name       = "Leia Organa"
      , _friends    = ["1000","1002","2000","2001"]
      , _appearsIn  = [4,5,6]
      }
  , homePlanet = "Alderaan"
  }
 tarkin :: Human
 tarkin = Human
  { _humanChar = CharCommon
    { _id_        = "1004"
    , _name       = "Wilhuff Tarkin"
    , _friends    = ["1001"]
    , _appearsIn  = [4]
    }
  , homePlanet = mempty
  }
 threepio :: Droid
 threepio = Droid
  { _droidChar = CharCommon
      { _id_ = "2000"
      , _name = "C-3PO"
      , _friends = ["1000","1002","1003","2001" ]
      , _appearsIn = [ 4, 5, 6 ]
      }
  , primaryFunction = "Protocol"
  }
 artoo :: Character
 artoo = Left artoo'
 artoo' :: Droid
 artoo' = Droid
  { _droidChar = CharCommon
      { _id_        = "2001"
      , _name       = "R2-D2"
      , _friends    = ["1000","1002","1003"]
      , _appearsIn  = [4,5,6]
      }
  , primaryFunction = "Astrometch"
  }
 -- ** Helper functions
 getHero :: Int -> Character
 getHero 5 = luke
 getHero _ = artoo
 getHeroIO :: Int -> IO Character
 getHeroIO = pure . getHero
 getHuman :: Alternative f => ID -> f Character
 getHuman = fmap Right . getHuman'
 getHuman' :: Alternative f => ID -> f Human
 getHuman' "1000" = pure luke'
 getHuman' "1001" = pure vader
 getHuman' "1002" = pure han
 getHuman' "1003" = pure leia
 getHuman' "1004" = pure tarkin
 getHuman' _      = empty
 getDroid :: Alternative f => ID -> f Character
 getDroid = fmap Left . getDroid'
 getDroid' :: Alternative f => ID -> f Droid
 getDroid' "2000" = pure threepio
 getDroid' "2001" = pure artoo'
 getDroid' _      = empty
 getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 getEpisode :: Int -> Maybe (Wrapping Text)
 getEpisode 4 = pure $ Named "NEWHOPE"
 getEpisode 5 = pure $ Named "EMPIRE"
 getEpisode 6 = pure $ Named "JEDI"
 getEpisode _ = empty
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@ -0,0 +1,351 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Test.StarWars.QuerySpec
    ( spec
    ) where
 import qualified Data.Aeson as Aeson
 import Data.Aeson ( object
                  , (.=)
                  )
 import Data.Text (Text)
 import Language.GraphQL
 import Language.GraphQL.Schema (Subs)
 import Text.RawString.QQ (r)
 import Test.Hspec.Expectations ( Expectation
                               , shouldBe
                               )
 import Test.Hspec ( Spec
                  , describe
                  , it
                  )
 import Test.StarWars.Schema
 -- * Test
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
 spec :: Spec
 spec = describe "Star Wars Query Tests" $ do
    describe "Basic Queries" $ do
      it "R2-D2 hero" $ testQuery
        [r| query HeroNameQuery {
            hero {
                id
            }
            }
        |]
        $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
      it "R2-D2 ID and friends" $ testQuery
        [r| query HeroNameAndFriendsQuery {
            hero {
                id
                name
                friends {
                name
                }
            }
            }
        |]
        $ object [ "data" .= object [
            "hero" .= object
                [ "id" .= ("2001" :: Text)
                , r2d2Name
                , "friends" .=
                    [ object [lukeName]
                    , object [hanName]
                    , object [leiaName]
                    ]
                ]
        ]]
    describe "Nested Queries" $ do
      it "R2-D2 friends" $ testQuery
        [r| query NestedQuery {
              hero {
                name
                friends {
                  name
                  appearsIn
                    friends {
                      name
                    }
                }
              }
            }
        |]
        $ object [ "data" .= object [
          "hero" .= object [
              "name" .= ("R2-D2" :: Text)
            , "friends" .= [
                  object [
                      "name" .= ("Luke Skywalker" :: Text)
                    , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [hanName]
                        , object [leiaName]
                        , object [c3poName]
                        , object [r2d2Name]
                        ]
                    ]
                , object [
                      hanName
                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [lukeName]
                        , object [leiaName]
                        , object [r2d2Name]
                        ]
                    ]
                , object [
                      leiaName
                    , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
                    , "friends" .= [
                          object [lukeName]
                        , object [hanName]
                        , object [c3poName]
                        , object [r2d2Name]
                        ]
                    ]
                ]
            ]
        ]]
      it "Luke ID" $ testQuery
        [r| query FetchLukeQuery {
              human(id: "1000") {
                name
              }
            }
        |]
        $ object [ "data" .= object [
          "human" .= object [lukeName]
        ]]
    it "Luke ID with variable" $ testQueryParams
      (\v -> if v == "someId" then Just "1000" else Nothing)
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "human" .= object [lukeName]
      ]]
    it "Han ID with variable" $ testQueryParams
      (\v -> if v == "someId" then Just "1002" else Nothing)
      [r| query FetchSomeIDQuery($someId: String!) {
            human(id: $someId) {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "human" .= object [hanName]
      ]]
    it "Invalid ID" $ testQueryParams
      (\v -> if v == "id" then Just "Not a valid ID" else Nothing)
      [r| query humanQuery($id: String!) {
            human(id: $id) {
              name
            }
          }
      |] $ object ["data" .= object ["human" .= Aeson.Null]]
    it "Luke aliased" $ testQuery
      [r| query FetchLukeAliased {
            luke: human(id: "1000") {
              name
            }
          }
      |]
      $ object [ "data" .= object [
       "luke" .= object [lukeName]
      ]]
    it "R2-D2 ID and friends aliased" $ testQuery
      [r| query HeroNameAndFriendsQuery {
            hero {
              id
              name
              friends {
                friendName: name
              }
            }
          }
      |]
      $ object [ "data" .= object [
        "hero" .= object [
            "id" .= ("2001" :: Text)
          , r2d2Name
          , "friends" .= [
                object ["friendName" .= ("Luke Skywalker" :: Text)]
              , object ["friendName" .= ("Han Solo" :: Text)]
              , object ["friendName" .= ("Leia Organa" :: Text)]
              ]
          ]
      ]]
    it "Luke and Leia aliased" $ testQuery
      [r| query FetchLukeAndLeiaAliased {
            luke: human(id: "1000") {
              name
            }
            leia: human(id: "1003") {
              name
            }
          }
      |]
      $ object [ "data" .= object [
        "luke" .= object [lukeName]
      , "leia" .= object [leiaName]
      ]]
    describe "Fragments for complex queries" $ do
      it "Aliases to query for duplicate content" $ testQuery
        [r| query DuplicateFields {
              luke: human(id: "1000") {
                name
                homePlanet
              }
              leia: human(id: "1003") {
                name
                homePlanet
              }
            }
        |]
        $ object [ "data" .= object [
          "luke" .= object [lukeName, tatooine]
        , "leia" .= object [leiaName, alderaan]
        ]]
      it "Fragment for duplicate content" $ testQuery
        [r|  query UseFragment {
              luke: human(id: "1000") {
                ...HumanFragment
              }
              leia: human(id: "1003") {
                ...HumanFragment
              }
            }
            fragment HumanFragment on Human {
              name
              homePlanet
            }
        |]
        $ object [ "data" .= object [
          "luke" .= object [lukeName, tatooine]
        , "leia" .= object [leiaName, alderaan]
        ]]
    describe "__typename" $ do
      it "R2D2 is a Droid" $ testQuery
        [r| query CheckTypeOfR2 {
              hero {
                __typename
                name
              }
            }
          |]
        $ object ["data" .= object [
            "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
        ]]
      it "Luke is a human" $ testQuery
        [r| query CheckTypeOfLuke {
              hero(episode: EMPIRE) {
                __typename
                name
              }
            }
          |]
        $ object ["data" .= object [
            "hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
        ]]
    describe "Errors in resolvers" $ do
        it "error on secretBackstory" $ testQuery
          [r|
            query HeroNameQuery {
              hero {
                name
                  secretBackstory
              }
            }
          |]
          $ object
              [ "data" .= object
                  [ "hero" .= object
                      [ "name" .= ("R2-D2" :: Text)
                      , "secretBackstory" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ object
                      ["message" .= ("secretBackstory is secret." :: Text)]
                  ]
              ]
        it "Error in a list" $ testQuery
          [r| query HeroNameQuery {
                hero {
                  name
                  friends {
                    name
                    secretBackstory
                  }
                }
              }
            |]
          $ object ["data" .= object
            [ "hero" .= object
                [ "name" .= ("R2-D2" :: Text)
                , "friends" .=
                    [ object
                        [ "name" .= ("Luke Skywalker" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , object
                        [ "name" .= ("Han Solo" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    , object
                        [ "name" .= ("Leia Organa" :: Text)
                        , "secretBackstory" .= Aeson.Null
                        ]
                    ]
                ]
            ]
            , "errors" .=
                [ object ["message" .= ("secretBackstory is secret." :: Text)]
                , object ["message" .= ("secretBackstory is secret." :: Text)]
                , object ["message" .= ("secretBackstory is secret." :: Text)]
                ]
            ]
        it "error on secretBackstory with alias" $ testQuery
          [r| query HeroNameQuery {
                mainHero: hero {
                  name
                  story: secretBackstory
                }
              }
            |]
          $ object
              [ "data" .= object
                  [ "mainHero" .= object
                      [ "name" .= ("R2-D2" :: Text)
                      , "story" .= Aeson.Null
                      ]
                  ]
              , "errors" .=
                  [ object ["message" .= ("secretBackstory is secret." :: Text)]
                  ]
              ]
  where
    lukeName = "name" .= ("Luke Skywalker" :: Text)
    leiaName = "name" .= ("Leia Organa" :: Text)
    hanName = "name" .= ("Han Solo" :: Text)
    r2d2Name = "name" .= ("R2-D2" :: Text)
    c3poName = "name" .= ("C-3PO" :: Text)
    tatooine = "homePlanet" .= ("Tatooine" :: Text)
    alderaan = "homePlanet" .= ("Alderaan" :: Text)
 testQuery :: Text -> Aeson.Value -> Expectation
 testQuery q expected = graphql schema q >>= flip shouldBe expected
 testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
 testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@ -0,0 +1,59 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Schema
    ( character
    , droid
    , hero
    , human
    , schema
    ) where
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
 import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
 import Language.GraphQL.Type
 import Test.StarWars.Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 schema :: MonadIO m => NonEmpty (Schema.Resolver m)
 schema = hero :| [human, droid]
 hero :: MonadIO m => Schema.Resolver m
 hero = Schema.objectA "hero" $ \case
  [] -> character artoo
  [Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4
  [Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5
  [Schema.Argument "episode" (Schema.ValueEnum "JEDI"   )] -> character $ getHero 6
  _ -> ActionT $ throwE "Invalid arguments."
 human :: MonadIO m => Schema.Resolver m
 human = Schema.wrappedObjectA "human" $ \case
  [Schema.Argument "id" (Schema.ValueString i)] -> do
      humanCharacter <- lift $ return $ getHuman i >>= Just
      case humanCharacter of
        Nothing -> return Null
        Just e -> Named <$> character e
  _ -> ActionT $ throwE "Invalid arguments."
 droid :: MonadIO m => Schema.Resolver m
 droid = Schema.objectA "droid" $ \case
   [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i)
   _ -> ActionT $ throwE "Invalid arguments."
 character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
 character char = return
    [ Schema.scalar "id" $ return $ id_ char
    , Schema.scalar "name" $ return $ name char
    , Schema.wrappedObject "friends"
        $ traverse character $ List $ Named <$> getFriends char
    , Schema.wrappedScalar "appearsIn" $ return . 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
@ -11,7 +11,7 @@ query queryName($foo: ComplexType, $site: Site = MOBILE) {
    ... on User @defer {
      field2 {
        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,25 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative ((<$>), (<*>), pure)
 #endif
 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 Paths_graphql (getDataFileName)
 import Data.GraphQL.Parser (document)
 main :: IO ()
 main = defaultMain
   =<< goldenVsString "kitchen-sink.graphql"
   <$> getDataFileName "tests/data/kitchen-sink.graphql.graphql.golden"
   <*> (parse <$> getDataFileName "tests/data/kitchen-sink.graphql")
  where
    parse = fmap (parseOnly document) . TIO.readFile
        >=> pure . either B8.pack (flip B8.snoc '\n' . B8.pack . show)
Author	SHA1	Message	Date
Eugen Wissner	721cbaee17	Release 0.5.0.1	2019-09-10 10:20:40 +02:00
Eugen Wissner	1704022e74	Fix #12	2019-09-06 07:48:01 +02:00
Eugen Wissner	63d4de485d	Deprecate enum, enumA, wrappedEnum, wrappedEnumA These functions are from Language.GraphQL.Schema. There are actually only two generic types in GraphQL: Scalars and objects. Enum is a scalar value. According to the specification enums may be serailized to strings. And in the current implementation they used untyped strings anyway, so there is no point to have differently named functions with the same implementation as their scalar counterparts.	2019-09-01 03:16:27 +02:00
Eugen Wissner	22313d05df	Deprecate 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.	2019-08-30 07:26:04 +02:00
Eugen Wissner	c1943c1979	Document all public symbols. Mostly basic documentation. Fixes #4.	2019-08-29 07:40:50 +02:00
Eugen Wissner	5175586def	Provide more documentation on functions and types	2019-08-26 10:14:46 +02:00
Eugen Wissner	f54e9451d2	Release 0.5.0.0	2019-08-14 08:49:07 +02:00
Eugen Wissner	045b6d15fb	Escape special characters in the encoded strings Fixes #2.	2019-08-13 07:24:05 +02:00
Eugen Wissner	6604fba7f4	Update stack snapshot to 14.0	2019-08-12 07:25:40 +02:00
Eugen Wissner	a3354e7f58	Make all encoder functions return lazy text	2019-08-05 09:00:11 +02:00
Eugen Wissner	f9dd363457	Provide more information in the REAME Provide more information and documentation references in the README.	2019-08-04 12:38:01 +02:00
Eugen Wissner	7a8a90aba8	Implement indentation in the encoder	2019-08-03 23:57:27 +02:00
Eugen Wissner	989e418cc2	Put spaces between tokens in the pretty printer	2019-08-02 13:52:51 +02:00
Eugen Wissner	4812c8f039	Introduce formatter type for the encoder ... to distinguish between minified and pretty printing.	2019-07-31 05:40:17 +02:00
Eugen Wissner	d690d22ce8	Test the encoder with the unminified document	2019-07-27 07:31:09 +02:00
Eugen Wissner	15568a3b99	Implement multiple operation support	2019-07-25 07:37:36 +02:00
Eugen Wissner	282946560e	Add singleError utility function	2019-07-23 07:22:32 +02:00
Eugen Wissner	1b5094b6a3	Parse the BOM header if any	2019-07-22 05:50:00 +02:00
Eugen Wissner	9d15b83164	Make the tutorial to compile again - Remove generated documentation leaving only documentation sources. - Add CI job checking that the tutorial is up to date.	2019-07-20 07:11:10 +02:00
Eugen Wissner	5cf10b38ec	Report parse errors with line and column numbers	2019-07-19 06:38:54 +02:00
Eugen Wissner	bc6a7dddd1	Reuse common types from AST.Core	2019-07-18 05:10:02 +02:00
Eugen Wissner	74801b0483	Remove TODO Issues should be created instead.	2019-07-17 07:06:35 +02:00
Eugen Wissner	f3b8d9b74c	Make all exports explicit	2019-07-14 05:58:05 +02:00
Eugen Wissner	eb40810f25	Replace tasty and HUnit with Hspec	2019-07-10 05:57:35 +02:00
Eugen Wissner	61879fb124	Constrain the resolvers with MonadIO This replaces the most usages of MonadPlus, which is not appropriate for the resolvers, since a resolver is unambiguously chosen by the name (no need for 'mplus'), and the resolvers are often doing IO.	2019-07-08 10:15:47 +02:00
Eugen Wissner	22d4a4e583	Change the main namespace to Language.GraphQL	2019-07-07 06:31:53 +02:00
Eugen Wissner	1431db7e63	Add licence badge	2019-07-06 07:57:18 +02:00
Eugen Wissner	d7b6fd0329	Allow resolvers to return arbitrary nested lists	2019-07-05 20:05:04 +02:00
Eugen Wissner	2fa50d4f62	Update CI settings	2019-07-04 06:32:04 +02:00
Eugen Wissner	6238b2fbfa	Add nullable types	2019-07-03 17:54:50 +02:00
Eugen Wissner	91679650b5	Introduce monad transformer for resolvers Now the errors in the resolvers can be handled and 3 tests throwing errors pass now. Another test fail but it requires distinguisching nullable and non-nullable values.	2019-07-02 20:07:26 +02:00
Eugen Wissner	1017b728d9	Pass root field names together with resolvers	2019-07-01 07:05:10 +02:00
Eugen Wissner	f64e186c60	Move the source code into src/	2019-06-30 06:07:32 +02:00
Eugen Wissner	28aaa6a70b	Remove GHCI config	2019-06-29 04:46:45 +02:00
Eugen Wissner	79c734fa62	Replace Alternative with MonadPlus	2019-06-28 11:12:28 +02:00
Eugen Wissner	ae4038eb47	Restore error handling	2019-06-27 08:00:59 +02:00
Eugen Wissner	3cc38343db	Fix ambigious Int resolution in the lexer tests	2019-06-26 15:41:30 +02:00
Eugen Wissner	2172de3729	Enable mutations	2019-06-23 05:38:45 +02:00
Eugen Wissner	5e9bf9648d	Parse queries with megaparsec	2019-06-21 10:44:58 +02:00
Eugen Wissner	ce169ecef2	Add package.yaml, update stack snapshot to 13.25	2019-06-11 06:34:15 +02:00
Danny Navarro	40f9024b51	Merge pull request #22 from Lupino/master update docs	2017-03-07 20:03:12 -03:00
Lupino	8d21972c42	update docs	2017-03-05 11:01:07 +08:00
Danny Navarro	2b5648efda	When argument is not found return null The relevant test was restored too.	2017-03-03 17:02:19 -03:00
Danny Navarro	fb071210cf	Fix wrong scientific exponent when parsing	2017-03-03 15:23:43 -03:00
Danny Navarro	285ccb0af9	Implement type instrospection tests The main intention with this commit is to show a poor's man way to support type instrospection.	2017-03-01 17:04:13 -03:00
Danny Navarro	6a10e28ba8	Garden	2017-03-01 16:05:49 -03:00
Danny Navarro	5954962de1	Make alternate Schema functions work with AST.Core	2017-03-01 16:04:35 -03:00
Danny Navarro	1327bcf7f7	Merge pull request #20 from Lupino/master	2017-03-01 15:13:20 -03:00
Danny Navarro	e521d92c7f	Use builtin scientific `toBoundInteger` to check for Int32 bounds	2017-02-28 17:22:06 -03:00
Danny Navarro	1b8fca3658	Merge branch 'core' This introduces a distinction between a Full and a Core AST. Fragments and variables are replaced when transforming from Full to Core.	2017-02-28 16:07:00 -03:00
Danny Navarro	bada28ce24	Simplify fragment substitution	2017-02-24 16:46:51 -03:00
Danny Navarro	d2c138f8d1	Add basic Fragment Support Only field names are supported for now.	2017-02-23 15:29:58 -03:00
Lupino	3be86bf69e	Enable Monad for array and object resolver When I use facebook/haxl, I can not find any way to the sub resolver. so I add Monad resolver to support it.	2017-02-23 11:08:47 +08:00
Danny Navarro	39731ff233	Fix parsing of Named Types	2017-02-13 15:31:56 -03:00
Danny Navarro	b7a72591fd	Support variables in AST transformation	2017-02-13 15:19:13 -03:00
Danny Navarro	e716bc57e7	Wrap executed result in "data" object	2017-02-10 17:10:09 -03:00
Danny Navarro	4ab4660d36	Initial implementation of AST.Full -> AST.Core This focused mainly on fragments.	2017-02-10 15:00:22 -03:00
Danny Navarro	8b09c8aa76	Make operation name optional	2017-02-03 12:57:21 -03:00
Danny Navarro	693b7d18dc	Introduce Tranform module In the Transform module the Full AST will converted to Core AST. This commit also includes a partial implementation of Fragment replacement.	2017-02-02 12:44:03 -03:00
Danny Navarro	f35e1f949a	Define Schema using Core AST Also, temporarily remove error reporting to simplify execution. This should be restored once the new execution model is nailed.	2017-01-30 15:20:17 -03:00
Danny Navarro	337b620717	Update .gitignore	2017-01-29 11:11:30 -03:00
Danny Navarro	642eab312f	Merge pull request #19 from jasonzoladz/master Fix Int32 bounds checking in Value parser.	2017-01-28 14:36:44 -03:00
Danny Navarro	5390c4ca1e	Split AST in 2 One AST is meant to be a target parser and tries to adhere as much as possible to the spec. The other is a simplified version of that AST meant for execution. Also newtypes have been replaced by type synonyms and NonEmpty lists are being used where it makes sense.	2017-01-28 14:15:14 -03:00
jasonzoladz	140c7df6fb	Fix Int32 bounds checking in Value parser.	2017-01-28 12:06:28 -05:00
Danny Navarro	3e991adf4e	Add Graphql Core AST	2017-01-26 12:52:07 -03:00
Danny Navarro	10fdf05aa7	Remove Type Definition support	2017-01-26 11:56:22 -03:00
Danny Navarro	933cfd2852	Tokenize number parser The essential change hidden behind the code golfing is using the `tok` combinator. This was making fail the Kitchen Sink test.	2016-12-18 12:19:59 -03:00
Danny Navarro	aa66236081	Add homePlanet to test schema	2016-12-18 11:43:45 -03:00
Danny Navarro	afb2fc4eb9	Include GHC-8.0.1 in travis build	2016-12-18 10:59:02 -03:00
Danny Navarro	5dc9222025	Merge pull request #16 from teh/master Parse number as scientific and interpret meaning separately.	2016-12-12 16:42:18 -03:00
Tom Hunger	87c92e9d6e	Parse number as scientific and interpret meaning separately. The current parser will fail parsing floats because it parses an int, and then stumbles on the dot. To fix I interpret the value with the scientific library which already is a dependency through attoparsec, so we're not introducing any extra downloads or compiling. I think this is still subtly wrong because "10.0" will be parsed as ValueInt, but because input argument ints are allowed to be coerced into doubles (according to the spec) this is probably acceptable.	2016-12-09 00:03:20 +00:00
Danny Navarro	61f0a06096	Drop support for GHC-7.8.4	2016-11-27 12:56:44 -03:00
Danny Navarro	2cc6b00051	Merge pull request #11 from pweaver/starwars_tests Remaining Starwars Tests	2016-07-11 19:33:48 -04:00
Pweaver (Paul Weaver)	c396a4b545	add pweaver to contributors	2016-07-09 10:55:16 -04:00
Pweaver (Paul Weaver)	a6c0d63049	add tests for errors in queries for queries in starwars tests	2016-07-08 18:10:14 -04:00
Pweaver (Paul Weaver)	624efbbb35	adds __typename tests to starwars testfile	2016-07-08 16:51:54 -04:00
Pweaver (Paul Weaver)	cb73e9d53c	adds the starwars tests for fragments Also refactors some deplicate objects into a where clause	2016-07-08 16:11:03 -04:00
Danny Navarro	e944c76040	Add @Tritlo and @solrun as authors	2016-03-17 15:57:18 +01:00
Danny Navarro	77853b17ae	Merge branch 'all-improvements' This adds general API documentation, a tutorial and error handling.	2016-03-15 14:02:34 +01:00
solrun	61d6af7778	Added documentation of functions and modules and included tutorial.lhs.	2016-03-14 01:42:55 +01:00
Matthías Páll Gissurarson	d195389102	Added exception handling with Alternative constraint according to spec.	2016-03-14 01:01:24 +01:00
Matthías Páll Gissurarson	b74278cd19	Added a tutorial, based on graphql-js and servant documentation.	2016-03-14 01:01:20 +01:00
Danny Navarro	d8a731fe30	Remove `StringValue` type	2016-02-22 13:59:38 +01:00
Danny Navarro	770df82718	Simplify Schema definition API Now there is one `Resolver` type and the `Output` and `Scalar` types have been removed. This should be closer to the final Schema definition API.	2016-02-19 19:21:32 +01:00
Danny Navarro	8ee50727bd	Overhaul Schema DSL Aside of making the definition of Schemas easier, it takes care of issues like nested aliases which previously wasn't possible. The naming of the DSL functions is still provisional.	2016-02-18 13:49:02 +01:00
Danny Navarro	a6b2fd297b	Garden	2016-02-17 13:20:56 +01:00
Danny Navarro	7131d1c142	Initial support for aliases in `execute`	2016-02-17 13:20:56 +01:00
Danny Navarro	a0f12455c5	Add remaining tests with variables in arguments The test with invalid ID is commented out until proper exception handling is implemented.	2016-02-17 12:35:54 +01:00
Danny Navarro	98d2d41cda	Initial support for variable substitution The correspondent end-to-end test has been ported. The variable definition still needs to be checked.	2016-02-15 14:43:52 +01:00
Danny Navarro	119f94b38e	Clean up StarWars test queries	2016-02-15 11:19:05 +01:00
Danny Navarro	04d8d40b3a	Split StarWars tests in different modules	2016-02-12 13:27:46 +01:00
Danny Navarro	a088c81944	Handle Field arguments in Schema definition The `Schema` has been overhauled to make `Output` monomorphic. Traversing the `GraphQL` document is handled implicitly while defining the `Schema`. The 4th end-to-end test from `graphql-js` has been ported.	2016-02-12 12:51:18 +01:00
Danny Navarro	70fbaf359e	Split Character data type into Droid and Human `Character` is now a synonym of the sum type of `Droid` and `Human`. For now I don't see the need to implement GraphQL Schema interfaces with type classes or lens. Plain Haskell ADTs should be good enough.	2016-02-09 14:38:19 +01:00
Danny Navarro	df8e43c9aa	Handle Output enumerations in Schema definition The third end-to-end test from graphql-js was implemented.	2016-02-09 13:31:28 +01:00
Danny Navarro	c385566912	Bump copyright year	2016-02-08 17:35:33 +01:00
Danny Navarro	781788e306	Drop support for older stackage versions	2016-02-08 17:33:51 +01:00
Danny Navarro	1561e62489	Extend `execute` for deeper queries The second graphql-js end-to-end test was ported and passed successfully.	2016-02-08 17:30:18 +01:00
Danny Navarro	53e101f35e	Simplify JSON notation in tests	2016-02-05 12:54:04 +01:00
Danny Navarro	c81ddb0335	Introduce `graphql` function This simplifies Attoparsec parsing when executing a GraphQL query.	2016-02-05 12:32:35 +01:00
Danny Navarro	eca3c2d8d4	Generalize `Maybe` type constructor to any Monad This allows schema definitions with side-effects for any type with a Monadic/Alternative implementation like IO for example.	2016-01-30 12:29:49 +01:00
Danny Navarro	a832991ac0	Remove unnecessary import	2016-01-27 18:52:20 +01:00
Danny Navarro	b72cfc097a	Fix for GHC-7.8.4	2016-01-26 13:57:58 +01:00
Danny Navarro	78e0d871d5	Garden	2016-01-26 13:38:02 +01:00
Danny Navarro	a70732a4b6	Pin stack to LTS-4.2	2016-01-26 13:35:53 +01:00
Danny Navarro	bb685c9afa	Rough implementation of `execute` The first end-to-end test taken from `graphql-js` passes but this still needs to be extended to support more general cases. - `Data.GraphQL.Schema` has been heavily modified to support the execution model. More drastic changes are expected in this module. - When defining a `Schema` ordinary functions taking fields as input are being used instead of maps. This makes the implementation of `execute` easier, and, arguably, makes `Schema` definitions more Haskellish. - Drop explicit `unordered-containers` dependency. `Aeson.Value`s and field functions should be good enough for now.	2016-01-26 12:43:18 +01:00
Danny Navarro	4e5dc3433a	Implement first StarWars end-to-end test `execute` still needs to be implemented.	2015-10-19 12:19:39 +02:00
Danny Navarro	3f30a44d1d	Test fixtures for Schema toplevel This includes simplications to the Schema data types.	2015-10-17 17:49:56 +02:00
Danny Navarro	8e3bae4b5c	Initial stub for a `GraphQL` and `execute`	2015-10-17 13:23:49 +02:00
Danny Navarro	c8f629e826	Merge pull request #2 from timmytofu/isstring-variable `IsString` variable and .gitignore	2015-09-26 09:23:46 +02:00
timmy_tofu	85941139c1	Adds IsString instance to Variable for easier REPL playing	2015-09-25 19:12:22 -04:00
timmy_tofu	0848e65da2	Adds dist/ dir and cabal sandbox dir and file to gitignore	2015-09-25 19:11:42 -04:00
Danny Navarro	6ce2004264	Version Bump This also includes updates to CHANGELOG, TODO and README.	2015-09-22 14:27:10 +02:00
Danny Navarro	af42e5577c	Rename `Data.GraphQL.Printer` -> `Data.GraphQL.Encoder`	2015-09-22 14:23:18 +02:00
Danny Navarro	a4db99ea5d	Fixes for ghc-7.8	2015-09-22 14:02:49 +02:00
Danny Navarro	06b3302862	Add kitchen sink parse/encode unit test This also includes the fixes to make it work. Golden tests have been removed.	2015-09-22 14:02:49 +02:00
Danny Navarro	4508364266	Fix alias colon order	2015-09-22 11:16:36 +02:00
Danny Navarro	99b4d86702	Polish printer code - Add printing combinators to make code more readable. - Optimize printing for encoding. Pretty printing will be in a different module.	2015-09-22 11:13:09 +02:00
Danny Navarro	da97387042	Parser fixes: - Braces instead of parens for `inputValueDefinitions`. - Rename `bool` -> `booleanValue`. - Some code rearrangements.	2015-09-22 10:39:14 +02:00
Danny Navarro	e74ee640a8	Initial implementation of GraphQL pretty printer This just typechecks. It needs to be cleaned and tested. Tests have been deactivated.	2015-09-21 18:26:22 +02:00
Danny Navarro	3d97b3e2ff	Introduce `Node` data type to simplify `OperationDefinition` Thanks to @swolchok for the suggestion.	2015-09-21 10:05:09 +02:00
Danny Navarro	88ca3d1866	Add errors for all parser `Alternative`s	2015-09-21 09:28:51 +02:00
Danny Navarro	899fa1b531	Handle escaped quotes for GraphQL String Values This also includes a new type for Value String. The tests fail now, although it parses successfully. I'll use a pretty printer in next commit so that it's easier to spot the differences. Onces this is working I'll add the rest of the escaped characters.	2015-09-18 18:11:11 +02:00
Danny Navarro	cb9977141d	Golf	2015-09-18 16:29:40 +02:00
Danny Navarro	4f4e31805a	Parse secure names	2015-09-18 15:43:22 +02:00
Danny Navarro	d88acf3d0e	Refine numeric types	2015-09-18 15:02:51 +02:00
Danny Navarro	c9c1137ceb	Garden	2015-09-18 14:55:59 +02:00
		`@ -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}`