Remove cariage return from the qq string

2023-08-05 18:04:23 +02:00
28 changed files with 1060 additions and 1080 deletions
--- a/.gitea/deploy.awk
+++ b/.gitea/deploy.awk
@ -1,3 +0,0 @@
 END {
    system("cabal upload --username belka --password "ENVIRON["HACKAGE_PASSWORD"]" "$0)
 }
--- a/.gitea/workflows/build.yml
+++ b/.gitea/workflows/build.yml
@ -1,33 +0,0 @@
 name: Build
 on:
  push:
    branches:
      - '**'
  pull_request:
    branches: [master]
 jobs:
  audit:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - run: hlint -- src tests
  test:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Install dependencies
        run: cabal update
      - name: Prepare system
        run: cabal build graphql-test
      - run: cabal test --test-show-details=streaming
  doc:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Install dependencies
        run: cabal update
      - run: cabal haddock --enable-documentation
--- a/.gitea/workflows/release.yml
+++ b/.gitea/workflows/release.yml
@ -1,17 +0,0 @@
 name: Release
 on:
  push:
    tags:
      - '**'
 jobs:
  release:
    runs-on: buildenv
    steps:
      - uses: actions/checkout@v4
      - name: Upload a candidate
        env:
          HACKAGE_PASSWORD: ${{ secrets.HACKAGE_PASSWORD }}
        run: |
          cabal sdist | awk -f .gitea/deploy.awk
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -6,43 +6,9 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
-## [1.5.0.0] - 2024-12-03
+## [Unreleased]
 ### Removed
 - Remove deprecated 'gql' quasi quoter.
 ### Changed
 - Validate the subscription root not to be an introspection field
  (`singleFieldSubscriptionsRule`).
 ## [1.4.0.0] - 2024-10-26
 ### Changed
 - `Schema.Directive` is extended to contain a boolean argument, representing
  repeatable directives. The parser can parse repeatable directive definitions.
  Validation allows repeatable directives.
 - `AST.Document.Directive` is a record.
 - `gql` quasi quoter is deprecated (moved to graphql-spice package).
 ### Fixed
 - `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF).
 ### Added
 - @specifiedBy directive.
 ## [1.3.0.0] - 2024-05-01
 ### Changed
 - Remove deprecated `runCollectErrs`, `Resolution`, `CollectErrsT` from the
  `Error` module.
 ## [1.2.0.3] - 2024-01-09
 ### Fixed
 - Fix corrupted source distribution.
 ## [1.2.0.2] - 2024-01-09
 ### Fixed
 - `gql` removes not only leading `\n` but also `\r`.
 - Fix non nullable type string representation in executor error messages.
 - Fix input objects not being coerced to lists.
 - Fix used variables are not found in the properties of input objects.
 ## [1.2.0.1] - 2023-04-25
 ### Fixed
@ -546,11 +512,7 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.
-[1.5.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.4.0.0...v1.5.0.0
+[Unreleased]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...master
 [1.4.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.3.0.0...v1.4.0.0
 [1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0
 [1.2.0.3]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.2...v1.2.0.3
 [1.2.0.2]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.1...v1.2.0.2
 [1.2.0.1]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.0...v1.2.0.1
 [1.2.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.1.0.0...v1.2.0.0
 [1.1.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.0.3.0...v1.1.0.0
--- a/graphql.cabal
+++ b/graphql.cabal
@ -1,7 +1,7 @@
-cabal-version: 3.0
+cabal-version: 2.4
 name:           graphql
-version:        1.5.0.0
+version:        1.2.0.1
 synopsis:       Haskell GraphQL implementation
 description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation.
 category:       Language
@ -11,7 +11,7 @@ author:         Danny Navarro <j@dannynavarro.net>,
                Matthías Páll Gissurarson <mpg@mpg.is>,
                Sólrún Halla Einarsdóttir <she@mpg.is>
 maintainer:     belka@caraus.de
-copyright:      (c) 2019-2024 Eugen Wissner,
+copyright:      (c) 2019-2023 Eugen Wissner,
                (c) 2015-2017 J. Daniel Navarro
 license:        MPL-2.0 AND BSD-3-Clause
 license-files:  LICENSE,
@ -21,7 +21,8 @@ extra-source-files:
  CHANGELOG.md
  README.md
 tested-with:
-  GHC == 9.8.2
+  GHC == 9.2.8,
  GHC == 9.6.2
 source-repository head
  type: git
@ -40,6 +41,7 @@ library
    Language.GraphQL.Execute
    Language.GraphQL.Execute.Coerce
    Language.GraphQL.Execute.OrderedMap
    Language.GraphQL.TH
    Language.GraphQL.Type
    Language.GraphQL.Type.In
    Language.GraphQL.Type.Out
@ -56,12 +58,13 @@ library
  ghc-options: -Wall
  build-depends:
-    base >= 4.15 && < 5,
+    base >= 4.7 && < 5,
    conduit ^>= 1.3.4,
-    containers >= 0.6 && < 0.8,
+    containers ^>= 0.6.2,
    exceptions ^>= 0.10.4,
    megaparsec >= 9.0 && < 10,
    parser-combinators >= 1.3 && < 2,
    template-haskell >= 2.16 && < 3,
    text >= 1.2 && < 3,
    transformers >= 0.5.6 && < 0.7,
    unordered-containers ^>= 0.2.14,
@ -82,6 +85,7 @@ test-suite graphql-test
    Language.GraphQL.Execute.CoerceSpec
    Language.GraphQL.Execute.OrderedMapSpec
    Language.GraphQL.ExecuteSpec
    Language.GraphQL.THSpec
    Language.GraphQL.Type.OutSpec
    Language.GraphQL.Validate.RulesSpec
    Schemas.HeroSchema
@ -90,7 +94,7 @@ test-suite graphql-test
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
  build-depends:
-    QuickCheck >= 2.14 && < 2.16,
+    QuickCheck ^>= 2.14.1,
    base,
    conduit,
    exceptions,
@ -103,6 +107,4 @@ test-suite graphql-test
    unordered-containers,
    containers,
    vector
  build-tool-depends:
    hspec-discover:hspec-discover
  default-language: Haskell2010
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@ -371,8 +371,8 @@ data NonNullType
    deriving Eq
 instance Show NonNullType where
-    show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!"
+    show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName
-    show (NonNullTypeList listType) = concat ["[", show listType, "]!"]
+    show (NonNullTypeList listType) =  concat ["![", show listType, "]"]
 -- ** Directives
@ -380,11 +380,7 @@ instance Show NonNullType where
 --
 -- Directives begin with "@", can accept arguments, and can be applied to the
 -- most GraphQL elements, providing additional information.
-data Directive = Directive
+data Directive = Directive Name [Argument] Location deriving (Eq, Show)
    { name :: Name
    , arguments :: [Argument]
    , location :: Location
    } deriving (Eq, Show)
 -- * Type System
@ -409,7 +405,7 @@ data TypeSystemDefinition
    = SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
    | TypeDefinition TypeDefinition
    | DirectiveDefinition
-        Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation)
+        Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
    deriving (Eq, Show)
 -- ** Type System Extensions
@ -482,9 +478,12 @@ instance Monoid Description
 data TypeDefinition
    = ScalarTypeDefinition Description Name [Directive]
    | ObjectTypeDefinition
-        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
+        Description
-    | InterfaceTypeDefinition
+        Name
-        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
+        (ImplementsInterfaces [])
        [Directive]
        [FieldDefinition]
    | InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
    | UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
    | EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
    | InputObjectTypeDefinition
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@ -159,12 +159,11 @@ typeSystemDefinition formatter = \case
            <> optempty (directives formatter) operationDirectives
            <> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
    Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
-    Full.DirectiveDefinition description' name' arguments' repeatable locations
+    Full.DirectiveDefinition description' name' arguments' locations
        -> description formatter description'
        <> "@"
        <> Lazy.Text.fromStrict name'
        <> argumentsDefinition formatter arguments'
        <> (if repeatable then " repeatable" else mempty)
        <> " on"
        <> pipeList formatter (directiveLocation <$> locations)
@ -226,11 +225,10 @@ typeDefinition formatter = \case
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) fields'
-    Full.InterfaceTypeDefinition description' name' ifaces' directives' fields'
+    Full.InterfaceTypeDefinition description' name' directives' fields'
        -> optempty (description formatter) description'
        <> "interface "
        <> Lazy.Text.fromStrict name'
        <> optempty (" " <>) (implementsInterfaces ifaces')
        <> optempty (directives formatter) directives'
        <> eitherFormat formatter " " ""
        <> bracesList formatter (fieldDefinition nextFormatter) fields'
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@ -29,8 +29,7 @@ module Language.GraphQL.AST.Lexer
    , unicodeBOM
    ) where
-import Control.Applicative (Alternative(..))
+import Control.Applicative (Alternative(..), liftA2)
 import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
 import Data.Foldable (foldl')
 import Data.List (dropWhileEnd)
@ -38,8 +37,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Proxy (Proxy(..))
 import Data.Void (Void)
-import Text.Megaparsec
+import Text.Megaparsec ( Parsec
    ( Parsec
                       , (<?>)
                       , between
                       , chunk
@ -49,6 +47,7 @@ import Text.Megaparsec
                       , option
                       , optional
                       , satisfy
                       , sepBy
                       , skipSome
                       , takeP
                       , takeWhile1P
@ -143,13 +142,12 @@ blockString :: Parser T.Text
 blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
  where
    stringValue = do
-        byLine <- NonEmpty.sepBy1 (many blockStringCharacter) lineTerminator
+        byLine <- sepBy (many blockStringCharacter) lineTerminator
-        let indentSize = foldr countIndent 0 $ NonEmpty.tail byLine
+        let indentSize = foldr countIndent 0 $ tail byLine
-            withoutIndent = NonEmpty.head byLine
+            withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
                : (removeIndent indentSize <$> NonEmpty.tail byLine)
            withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
-        pure $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
+        return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
    removeEmptyLine [] = True
    removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
    removeEmptyLine _ = False
@ -182,8 +180,8 @@ name :: Parser T.Text
 name = do
    firstLetter <- nameFirstLetter
    rest <- many $ nameFirstLetter <|> digitChar
-    void spaceConsumer
+    _ <- spaceConsumer
-    pure $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
+    return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
      where
        nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
@ -199,25 +197,25 @@ lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
 isSourceCharacter :: Char -> Bool
 isSourceCharacter = isSourceCharacter' . ord
  where
-    isSourceCharacter' code
+    isSourceCharacter' code = code >= 0x0020
-        = code >= 0x0020
+                           || code == 0x0009
-        || elem code [0x0009, 0x000a, 0x000d]
+                           || code == 0x000a
                           || code == 0x000d
 escapeSequence :: Parser Char
 escapeSequence = do
-    void $ char '\\'
+    _ <- char '\\'
    escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
    case escaped of
-        'b' -> pure '\b'
+        'b' -> return '\b'
-        'f' -> pure '\f'
+        'f' -> return '\f'
-        'n' -> pure '\n'
+        'n' -> return '\n'
-        'r' -> pure '\r'
+        'r' -> return '\r'
-        't' -> pure '\t'
+        't' -> return '\t'
-        'u' -> chr
+        'u' -> chr . foldl' step 0
            . foldl' step 0
                   . chunkToTokens (Proxy :: Proxy T.Text)
                 <$> takeP Nothing 4
-        _ -> pure escaped
+        _ -> return escaped
  where
    step accumulator = (accumulator * 16 +) . digitToInt
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@ -8,7 +8,7 @@ module Language.GraphQL.AST.Parser
    ( document
    ) where
-import Control.Applicative (Alternative(..), optional)
+import Control.Applicative (Alternative(..), liftA2, optional)
 import Control.Applicative.Combinators (sepBy1)
 import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
@ -27,7 +27,6 @@ import Text.Megaparsec
    , unPos
    , (<?>)
    )
 import Data.Maybe (isJust)
 -- | Parser for the GraphQL documents.
 document :: Parser Full.Document
@ -83,7 +82,6 @@ directiveDefinition description' = Full.DirectiveDefinition description'
    <* at
    <*> name
    <*> argumentsDefinition
    <*> (isJust <$> optional (symbol "repeatable"))
    <* symbol "on"
    <*> directiveLocations
    <?> "DirectiveDefinition"
@ -214,7 +212,6 @@ interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
    <$ symbol "interface"
    <*> name
    <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
    <*> directives
    <*> braces (many fieldDefinition)
    <?> "InterfaceTypeDefinition"
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -8,22 +8,28 @@
 -- | Error handling.
 module Language.GraphQL.Error
-    ( Error(..)
+    ( CollectErrsT
    , Error(..)
    , Path(..)
    , Resolution(..)
    , ResolverException(..)
    , Response(..)
    , ResponseEventStream
    , parseError
    , runCollectErrs
    ) where
 import Conduit
 import Control.Exception (Exception(..))
 import Control.Monad.Trans.State (StateT, runStateT)
 import Data.HashMap.Strict (HashMap)
 import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Language.GraphQL.AST (Location(..))
+import Language.GraphQL.AST (Location(..), Name)
 import Language.GraphQL.Execute.Coerce
 import qualified Language.GraphQL.Type.Schema as Schema
 import Prelude hiding (null)
 import Text.Megaparsec
    ( ParseErrorBundle(..)
@ -91,3 +97,28 @@ instance Show ResolverException where
    show (ResolverException e) = show e
 instance Exception ResolverException
 -- * Deprecated
 {-# DEPRECATED runCollectErrs "runCollectErrs was part of the old executor and isn't used anymore" #-}
 -- | Runs the given query computation, but collects the errors into an error
 -- list, which is then sent back with the data.
 runCollectErrs :: (Monad m, Serialize a)
    => HashMap Name (Schema.Type m)
    -> CollectErrsT m a
    -> m (Response a)
 runCollectErrs types' res = do
    (dat, Resolution{..}) <- runStateT res
        $ Resolution{ errors = Seq.empty, types = types' }
    pure $ Response dat errors
 {-# DEPRECATED Resolution "Resolution was part of the old executor and isn't used anymore" #-}
 -- | Executor context.
 data Resolution m = Resolution
    { errors :: Seq Error
    , types :: HashMap Name (Schema.Type m)
    }
 {-# DEPRECATED CollectErrsT "CollectErrsT was part of the old executor and isn't used anymore" #-}
 -- | A wrapper to pass error messages around.
 type CollectErrsT m = StateT (Resolution m) m
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -556,24 +556,33 @@ coerceArgumentValues argumentDefinitions argumentValues =
                    $ Just inputValue
                | otherwise -> throwM
                    $ InputCoercionException (Text.unpack argumentName) variableType Nothing
    matchFieldValues' = matchFieldValues coerceArgumentValue
        $ Full.node <$> argumentValues
-
+    coerceArgumentValue inputType (Transform.Int integer) =
-    coerceArgumentValue inputType transform =
+        coerceInputLiteral inputType (Type.Int integer)
-      coerceInputLiteral inputType $ extractArgumentValue transform
+    coerceArgumentValue inputType (Transform.Boolean boolean) =
-
+        coerceInputLiteral inputType (Type.Boolean boolean)
-    extractArgumentValue (Transform.Int integer) = Type.Int integer
+    coerceArgumentValue inputType (Transform.String string) =
-    extractArgumentValue (Transform.Boolean boolean) = Type.Boolean boolean
+        coerceInputLiteral inputType (Type.String string)
-    extractArgumentValue (Transform.String string) = Type.String string
+    coerceArgumentValue inputType (Transform.Float float) =
-    extractArgumentValue (Transform.Float float) = Type.Float float
+        coerceInputLiteral inputType (Type.Float float)
-    extractArgumentValue (Transform.Enum enum) = Type.Enum enum
+    coerceArgumentValue inputType (Transform.Enum enum) =
-    extractArgumentValue Transform.Null = Type.Null
+        coerceInputLiteral inputType (Type.Enum enum)
-    extractArgumentValue (Transform.List list) =
+    coerceArgumentValue inputType Transform.Null
-      Type.List $ extractArgumentValue <$> list
+        | In.isNonNullType inputType = Nothing
-    extractArgumentValue (Transform.Object object) =
+        | otherwise = coerceInputLiteral inputType Type.Null
-      Type.Object $ extractArgumentValue <$> object
+    coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) =
-    extractArgumentValue (Transform.Variable variable) = variable
+        let coerceItem = coerceArgumentValue inputType
         in Type.List <$> traverse coerceItem list
    coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)
        | In.InputObjectType _ _ inputFields <- inputType = 
            let go = forEachField object
                resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
             in Type.Object <$> resultMap
    coerceArgumentValue _ (Transform.Variable variable) = pure variable
    coerceArgumentValue _ _ = Nothing
    forEachField object variableName (In.InputField _ variableType defaultValue) =
        matchFieldValues coerceArgumentValue object variableName variableType defaultValue
 collectFields :: Monad m
    => Out.ObjectType m
--- a/src/Language/GraphQL/TH.hs
+++ b/src/Language/GraphQL/TH.hs
@ -0,0 +1,47 @@
 {- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}
 -- | Template Haskell helpers.
 module Language.GraphQL.TH
    ( gql
    ) where
 import Language.Haskell.TH.Quote (QuasiQuoter(..))
 import Language.Haskell.TH (Exp(..), Lit(..))
 stripIndentation :: String -> String
 stripIndentation code = reverse
    $ dropWhile isLineBreak
    $ reverse
    $ unlines
    $ indent spaces <$> lines' withoutLeadingNewlines
  where
    indent 0 xs = xs
    indent count (' ' : xs) = indent (count - 1) xs
    indent _ xs = xs
    withoutLeadingNewlines = dropWhile isLineBreak code
    spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
    lines' "" = []
    lines' string =
        let (line, rest) = break isLineBreak string
            reminder =
                case rest of
                    [] -> []
                    '\r' : '\n' : strippedString -> lines strippedString
                    _ : strippedString -> lines strippedString
         in line : reminder
    isLineBreak = flip any ['\n', '\r'] . (==)
 -- | Removes leading and trailing newlines. Indentation of the first line is
 -- removed from each line of the string.
 gql :: QuasiQuoter
 gql = QuasiQuoter
    { quoteExp = pure . LitE . StringL . stripIndentation
    , quotePat = const
        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a pattern)"
    , quoteType = const
        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a type)"
    , quoteDec = const
        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a declaration)"
    }
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@ -18,8 +18,6 @@ module Language.GraphQL.Type.Definition
    , float
    , id
    , int
    , showNonNullType
    , showNonNullListType
    , selection
    , string
    ) where
@ -209,11 +207,3 @@ include = handle include'
            (Just (Boolean True)) -> Include directive'
            _ -> Skip
    include' directive' = Continue directive'
 showNonNullType :: Show a => a -> String
 showNonNullType = (++ "!") . show
 showNonNullListType :: Show a => a -> String
 showNonNullListType listType =
    let representation = show listType
     in concat ["[", representation, "]!"]
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@ -66,15 +66,13 @@ instance Show Type where
    show (NamedEnumType enumType) = show enumType
    show (NamedInputObjectType inputObjectType) = show inputObjectType
    show (ListType baseType) = concat ["[", show baseType, "]"]
-    show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType
+    show (NonNullScalarType scalarType) = '!' : show scalarType
-    show (NonNullEnumType enumType) = Definition.showNonNullType enumType
+    show (NonNullEnumType enumType) = '!' : show enumType
-    show (NonNullInputObjectType inputObjectType) =
+    show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType
-        Definition.showNonNullType inputObjectType
+    show (NonNullListType baseType) = concat ["![", show baseType, "]"]
    show (NonNullListType baseType) = Definition.showNonNullListType baseType
 -- | Field argument definition.
 data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)
    deriving Eq
 -- | Field argument definitions.
 type Arguments = HashMap Name Argument
--- a/src/Language/GraphQL/Type/Internal.hs
+++ b/src/Language/GraphQL/Type/Internal.hs
@ -48,11 +48,7 @@ data Type m
    deriving Eq
 -- | Directive definition.
--
+data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments
 -- A definition consists of an optional description, arguments, whether the
 -- directive is repeatable, and the allowed directive locations.
 data Directive = Directive (Maybe Text) In.Arguments Bool [DirectiveLocation]
    deriving Eq
 -- | Directive definitions.
 type Directives = HashMap Full.Name Directive
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@ -115,12 +115,12 @@ instance forall a. Show (Type a) where
    show (NamedInterfaceType interfaceType) = show interfaceType
    show (NamedUnionType unionType) = show unionType
    show (ListType baseType) = concat ["[", show baseType, "]"]
-    show (NonNullScalarType scalarType) = showNonNullType scalarType
+    show (NonNullScalarType scalarType) = '!' : show scalarType
-    show (NonNullEnumType enumType) = showNonNullType enumType
+    show (NonNullEnumType enumType) = '!' : show enumType
-    show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType
+    show (NonNullObjectType inputObjectType) = '!' : show inputObjectType
-    show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType
+    show (NonNullInterfaceType interfaceType) = '!' : show interfaceType
-    show (NonNullUnionType unionType) = showNonNullType unionType
+    show (NonNullUnionType unionType) = '!' : show unionType
-    show (NonNullListType baseType) = showNonNullListType baseType
+    show (NonNullListType baseType) = concat ["![", show baseType, "]"]
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@ -85,16 +85,15 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire
        [ ("skip", skipDirective)
        , ("include", includeDirective)
        , ("deprecated", deprecatedDirective)
        , ("specifiedBy", specifiedByDirective)
        ]
    includeDirective =
-        Directive includeDescription includeArguments False skipIncludeLocations
+        Directive includeDescription skipIncludeLocations includeArguments
    includeArguments = HashMap.singleton "if"
        $ In.Argument (Just "Included when true.") ifType Nothing
    includeDescription = Just
        "Directs the executor to include this field or fragment only when the \
        \`if` argument is true."
-    skipDirective = Directive skipDescription skipArguments False skipIncludeLocations
+    skipDirective = Directive skipDescription skipIncludeLocations skipArguments
    skipArguments = HashMap.singleton "if"
        $ In.Argument (Just "skipped when true.") ifType Nothing
    ifType = In.NonNullScalarType Definition.boolean
@ -107,15 +106,16 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire
        , ExecutableDirectiveLocation DirectiveLocation.InlineFragment
        ]
    deprecatedDirective =
-        Directive deprecatedDescription deprecatedArguments False deprecatedLocations
+        Directive deprecatedDescription deprecatedLocations deprecatedArguments
    reasonDescription = Just
        "Explains why this element was deprecated, usually also including a \
        \suggestion for how to access supported similar data. Formatted using \
        \the Markdown syntax, as specified by \
        \[CommonMark](https://commonmark.org/).'"
    deprecatedArguments = HashMap.singleton "reason"
-        $ In.Argument reasonDescription (In.NamedScalarType Definition.string)
+        $ In.Argument reasonDescription reasonType
        $ Just "No longer supported"
    reasonType = In.NamedScalarType Definition.string
    deprecatedDescription = Just
        "Marks an element of a GraphQL schema as no longer supported."
    deprecatedLocations =
@ -124,16 +124,6 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire
        , TypeSystemDirectiveLocation DirectiveLocation.InputFieldDefinition
        , TypeSystemDirectiveLocation DirectiveLocation.EnumValue
        ]
    specifiedByDirective =
        Directive specifiedByDescription specifiedByArguments False specifiedByLocations
    urlDescription = Just
        "The URL that specifies the behavior of this scalar."
    specifiedByArguments = HashMap.singleton "url"
        $ In.Argument urlDescription (In.NonNullScalarType Definition.string) Nothing
    specifiedByDescription = Just
        "Exposes a URL that specifies the behavior of this scalar."
    specifiedByLocations =
        [TypeSystemDirectiveLocation DirectiveLocation.Scalar]
 -- | Traverses the schema and finds all referenced types.
 collectReferencedTypes :: forall m
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@ -200,7 +200,7 @@ typeSystemDefinition context rule = \case
        directives context rule schemaLocation directives'
    Full.TypeDefinition typeDefinition' ->
        typeDefinition context rule typeDefinition'
-    Full.DirectiveDefinition _ _ arguments' _ _ ->
+    Full.DirectiveDefinition _ _ arguments' _ ->
        argumentsDefinition context rule arguments'
 typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
@ -210,7 +210,7 @@ typeDefinition context rule = \case
    Full.ObjectTypeDefinition _ _ _ directives' fields
        -> directives context rule objectLocation directives'
        >< foldMap (fieldDefinition context rule) fields
-    Full.InterfaceTypeDefinition _ _ _ directives' fields
+    Full.InterfaceTypeDefinition _ _ directives' fields
        -> directives context rule interfaceLocation directives'
        >< foldMap (fieldDefinition context rule) fields
    Full.UnionTypeDefinition _ _ directives' _ ->
@ -482,4 +482,4 @@ directive context rule (Full.Directive directiveName arguments' _) =
            $ Validation.schema context
     in arguments rule argumentTypes arguments'
  where
-    directiveArguments (Schema.Directive _ argumentTypes _ _) = argumentTypes
+    directiveArguments (Schema.Directive _ _ argumentTypes) = argumentTypes
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@ -2,13 +2,11 @@
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 -- | This module contains default rules defined in the GraphQL specification.
@ -50,21 +48,19 @@ import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
 import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
 import Data.Bifunctor (first)
-import Data.Foldable (Foldable(..), find)
+import Data.Foldable (find, fold, foldl', toList)
 import qualified Data.HashMap.Strict as HashMap
 import Data.HashMap.Strict (HashMap)
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
-import Data.List (sortBy)
+import Data.List (groupBy, sortBy, sortOn)
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Ord (comparing)
 import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
 import GHC.Records (HasField(..))
 import qualified Language.GraphQL.AST.Document as Full
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Internal as Type
@ -137,28 +133,25 @@ singleFieldSubscriptionsRule :: forall m. Rule m
 singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
    Full.OperationDefinition Full.Subscription name' _ _ rootFields location' -> do
        groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty
-        case HashSet.toList groupedFieldSet of
+        case HashSet.size groupedFieldSet of
-            [rootName]
+            1 -> lift mempty
-                | Text.isPrefixOf "__" rootName -> makeError location' name'
+            _
-                    "exactly one top level field, which must not be an introspection field."
+                | Just name <- name' -> pure $ Error
                | otherwise -> lift mempty
            [] -> makeError location' name' "exactly one top level field."
            _ -> makeError location' name' "only one top level field."
    _ -> lift mempty
  where
    makeError location' (Just operationName) errorLine = pure $ Error
                    { message = concat
                        [ "Subscription \""
-            , Text.unpack operationName
+                        , Text.unpack name
-            , "\" must select "
+                        , "\" must select only one top level field."
            , errorLine
                        ]
                    , locations = [location']
                    }
-    makeError location' Nothing errorLine = pure $ Error
+                | otherwise -> pure $ Error
-        { message = "Anonymous Subscription must select " <> errorLine
+                    { message = errorMessage
                    , locations = [location']
                    }
    _ -> lift mempty
  where
    errorMessage =
        "Anonymous Subscription must select only one top level field."
    collectFields = foldM forEach HashSet.empty
    forEach accumulator = \case
        Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
@ -257,16 +250,14 @@ findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
    -> Full.Location
    -> String
    -> RuleT m
-findDuplicates filterByName thisLocation errorMessage =
+findDuplicates filterByName thisLocation errorMessage = do
-    asks ast >>= go . foldr filterByName []
+    ast' <- asks ast
    let locations' = foldr filterByName [] ast'
    if length locations' > 1 && head locations' == thisLocation
        then pure $ error' locations'
        else lift mempty
  where
-    go locations' =
+    error' locations' = Error 
        case locations' of
            headLocation : otherLocations -- length locations' > 1
                | not $ null otherLocations
                , headLocation == thisLocation -> pure $ makeError locations'
            _ -> lift mempty
    makeError locations' = Error
        { message = errorMessage
        , locations = locations'
        }
@ -536,20 +527,16 @@ uniqueArgumentNamesRule = ArgumentsRule fieldRule directiveRule
 -- used, the expected metadata or behavior becomes ambiguous, therefore only one
 -- of each directive is allowed per location.
 uniqueDirectiveNamesRule :: forall m. Rule m
-uniqueDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
+uniqueDirectiveNamesRule = DirectivesRule
-    definitions' <- asks $ Schema.directives . schema
+    $ const $ lift . filterDuplicates extract "directive"
    let filterNonRepeatable = flip HashSet.member nonRepeatableSet
            . getField @"name"
        nonRepeatableSet =
            HashMap.foldlWithKey foldNonRepeatable HashSet.empty definitions'
    lift $ filterDuplicates extract "directive"
        $ filter filterNonRepeatable directives'
  where
-    foldNonRepeatable  hashSet directiveName' (Schema.Directive _ _ False _) =
+    extract (Full.Directive directiveName _ location') =
-        HashSet.insert directiveName' hashSet
+        (directiveName, location')
-    foldNonRepeatable hashSet _ _ = hashSet
+
-    extract (Full.Directive directiveName' _ location') =
+groupSorted :: forall a. (a -> Text) -> [a] -> [[a]]
-        (directiveName', location')
+groupSorted getName = groupBy equalByName . sortOn getName
  where
    equalByName lhs rhs = getName lhs == getName rhs
 filterDuplicates :: forall a
    . (a -> (Text, Full.Location))
@ -559,12 +546,12 @@ filterDuplicates :: forall a
 filterDuplicates extract nodeType = Seq.fromList
    . fmap makeError
    . filter ((> 1) . length)
-    . NonEmpty.groupAllWith getName
+    . groupSorted getName
  where
    getName = fst . extract
    makeError directives' = Error
-        { message = makeMessage $ NonEmpty.head directives'
+        { message = makeMessage $ head directives'
-        , locations = snd . extract <$> toList directives'
+        , locations = snd . extract <$> directives'
        }
    makeMessage directive = concat
        [ "There can be only one "
@ -631,10 +618,6 @@ noUndefinedVariablesRule =
        , "\"."
        ]
 -- Used to find the difference between defined and used variables. The first
 -- argument are variables defined in the operation, the second argument are
 -- variables used in the query. It should return the difference between these
 -- 2 sets.
 type UsageDifference
    = HashMap Full.Name [Full.Location]
    -> HashMap Full.Name [Full.Location]
@ -681,17 +664,11 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
        = filterSelections' selections
        >>= lift . mapReaderT (<> mapDirectives directives') . pure
    findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
-    mapArguments = Seq.fromList . (>>= findArgumentVariables)
+    mapArguments = Seq.fromList . mapMaybe findArgumentVariables
    mapDirectives = foldMap findDirectiveVariables
-
+    findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) =
-    findArgumentVariables (Full.Argument _ value _) = findNodeVariables value
+        Just (value', [location])
-    findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value
+    findArgumentVariables _ = Nothing
    findValueVariables location (Full.Variable value') = [(value', [location])]
    findValueVariables _ (Full.List values) = values >>= findNodeVariables
    findValueVariables _ (Full.Object fields) = fields
        >>= findNodeVariables . getField @"value"
    findValueVariables _ _ = []
    makeError operationName (variableName, locations') = Error
        { message = errorMessage operationName variableName
        , locations = locations'
@ -843,7 +820,7 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
            . Schema.directives . schema
        Full.Argument argumentName _ location' <- lift $ Seq.fromList arguments
        case available of
-            Just (Schema.Directive _ definitions _ _)
+            Just (Schema.Directive _ _ definitions)
                | not $ HashMap.member argumentName definitions ->
                    pure $ makeError argumentName directiveName location'
            _ -> lift mempty
@ -859,23 +836,23 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
        , "\"."
        ]
-- | GraphQL services define what directives they support. For each usage of a
+-- | GraphQL servers define what directives they support. For each usage of a
-- directive, the directive must be available on that service.
+-- directive, the directive must be available on that server.
 knownDirectiveNamesRule :: Rule m
 knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
    definitions' <- asks $ Schema.directives . schema
-    let directiveSet = HashSet.fromList $ fmap (getField @"name") directives'
+    let directiveSet = HashSet.fromList $ fmap directiveName directives'
-        definitionSet = HashSet.fromList $ HashMap.keys definitions'
+    let definitionSet = HashSet.fromList $ HashMap.keys definitions'
-        difference = HashSet.difference directiveSet definitionSet
+    let difference = HashSet.difference directiveSet definitionSet
-        undefined' = filter (definitionFilter difference) directives'
+    let undefined' = filter (definitionFilter difference) directives'
    lift $ Seq.fromList $ makeError <$> undefined'
  where
    definitionFilter :: HashSet Full.Name -> Full.Directive -> Bool
    definitionFilter difference = flip HashSet.member difference
-        . getField @"name"
+        . directiveName
-    makeError Full.Directive{..} = Error
+    directiveName (Full.Directive directiveName' _ _) = directiveName'
-        { message = errorMessage name
+    makeError (Full.Directive directiveName' _ location') = Error
-        , locations = [location]
+        { message = errorMessage directiveName'
        , locations = [location']
        }
    errorMessage directiveName' = concat
        [ "Unknown directive \"@"
@ -912,9 +889,9 @@ knownInputFieldNamesRule = ValueRule go constGo
        , "\"."
        ]
-- | GraphQL services define what directives they support and where they support
+-- | GraphQL servers define what directives they support and where they support
 -- them. For each usage of a directive, the directive must be used in a location
-- that the service has declared support for.
+-- that the server has declared support for.
 directivesInValidLocationsRule :: Rule m
 directivesInValidLocationsRule = DirectivesRule directivesRule
  where
@ -923,7 +900,7 @@ directivesInValidLocationsRule = DirectivesRule directivesRule
        maybeDefinition <- asks
            $ HashMap.lookup directiveName . Schema.directives . schema
        case maybeDefinition of
-            Just (Schema.Directive _ _ _ allowedLocations)
+            Just (Schema.Directive _ allowedLocations _)
                | directiveLocation `notElem` allowedLocations -> pure $ Error
                    { message = errorMessage directiveName directiveLocation
                    , locations = [location]
@ -953,7 +930,7 @@ providedRequiredArgumentsRule = ArgumentsRule fieldRule directiveRule
        available <- asks
            $ HashMap.lookup directiveName . Schema.directives . schema
        case available of
-            Just (Schema.Directive _ definitions _ _) ->
+            Just (Schema.Directive _ _ definitions) ->
                let forEach = go (directiveMessage directiveName) arguments location'
                 in lift $ HashMap.foldrWithKey forEach Seq.empty definitions
            _ -> lift mempty
@ -1421,7 +1398,7 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
        let Full.Directive directiveName arguments _ = directive
        directiveDefinitions <- lift $ asks $ Schema.directives . schema
        case HashMap.lookup directiveName directiveDefinitions of
-            Just (Schema.Directive _ directiveArguments _ _) ->
+            Just (Schema.Directive _ _ directiveArguments) ->
                mapArguments variables directiveArguments arguments
            Nothing -> pure mempty
    mapArguments variables argumentTypes = fmap fold
--- a/tests/Language/GraphQL/AST/Arbitrary.hs
+++ b/tests/Language/GraphQL/AST/Arbitrary.hs
@ -1,26 +1,14 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Language.GraphQL.AST.Arbitrary
+module Language.GraphQL.AST.Arbitrary where
    ( AnyArgument(..)
    , AnyLocation(..)
    , AnyName(..)
    , AnyNode(..)
    , AnyObjectField(..)
    , AnyValue(..)
    , printArgument
    ) where
 import qualified Language.GraphQL.AST.Document as Doc
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
 import Test.QuickCheck.Gen (Gen (..))
-import Data.Text (Text)
+import Data.Text (Text, pack)
 import qualified Data.Text as Text
 import Data.Functor ((<&>))
-newtype AnyPrintableChar = AnyPrintableChar
+newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
    { getAnyPrintableChar :: Char
    } deriving (Eq, Show)
 alpha :: String
 alpha = ['a'..'z'] <> ['A'..'Z']
@ -33,40 +21,28 @@ instance Arbitrary AnyPrintableChar where
        where
           chars = alpha <> num <> ['_'] 
-newtype AnyPrintableText = AnyPrintableText
+newtype AnyPrintableText = AnyPrintableText { getAnyPrintableText :: Text } deriving (Eq, Show)
    { getAnyPrintableText :: Text
    } deriving (Eq, Show)
 instance Arbitrary AnyPrintableText where
    arbitrary = do
        nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
-        pure $ AnyPrintableText
+        pure $ AnyPrintableText (pack $ map getAnyPrintableChar nonEmptyStr)
            $ Text.pack
            $ map getAnyPrintableChar nonEmptyStr
 -- https://spec.graphql.org/June2018/#Name
-newtype AnyName = AnyName
+newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show)
    { getAnyName :: Text
    } deriving (Eq, Show)
 instance Arbitrary AnyName where
    arbitrary = do
        firstChar <- elements $ alpha <> ['_']
        rest <- (arbitrary :: Gen [AnyPrintableChar])
-        pure $ AnyName
+        pure $ AnyName (pack $ firstChar : map getAnyPrintableChar rest)
            $ Text.pack
            $ firstChar : map getAnyPrintableChar rest
-newtype AnyLocation = AnyLocation
+newtype AnyLocation = AnyLocation { getAnyLocation :: Doc.Location } deriving (Eq, Show)
    { getAnyLocation :: Doc.Location
    } deriving (Eq, Show)
 instance Arbitrary AnyLocation where
    arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
-newtype AnyNode a = AnyNode
+newtype AnyNode a = AnyNode { getAnyNode :: Doc.Node a } deriving (Eq, Show)
    { getAnyNode :: Doc.Node a
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyNode a) where
    arbitrary = do
@ -74,9 +50,7 @@ instance Arbitrary a => Arbitrary (AnyNode a) where
        node' <- flip Doc.Node location' <$> arbitrary
        pure $ AnyNode node'
-newtype AnyObjectField a = AnyObjectField
+newtype AnyObjectField a = AnyObjectField { getAnyObjectField :: Doc.ObjectField a } deriving (Eq, Show)
    { getAnyObjectField :: Doc.ObjectField a
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyObjectField a) where
    arbitrary = do
@ -85,38 +59,34 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
        location' <- getAnyLocation <$> arbitrary
        pure $ AnyObjectField $ Doc.ObjectField name' value' location'
-newtype AnyValue = AnyValue
+newtype AnyValue = AnyValue { getAnyValue :: Doc.Value } deriving (Eq, Show)
    { getAnyValue :: Doc.Value
    } deriving (Eq, Show)
-instance Arbitrary AnyValue
+instance Arbitrary AnyValue where
-  where
+    arbitrary = AnyValue <$> oneof
    arbitrary =
        let variableGen :: Gen Doc.Value
            variableGen = Doc.Variable . getAnyName <$> arbitrary
            listGen :: Gen [Doc.Node Doc.Value]
            listGen = (resize 5 . listOf) nodeGen
            nodeGen :: Gen (Doc.Node Doc.Value)
            nodeGen = fmap getAnyNode arbitrary <&> fmap getAnyValue
            objectGen :: Gen [Doc.ObjectField Doc.Value]
            objectGen = resize 1
                $ fmap getNonEmpty arbitrary
                <&> map (fmap getAnyValue . getAnyObjectField)
         in AnyValue <$> oneof
        [ variableGen
        , Doc.Int <$> arbitrary
        , Doc.Float <$> arbitrary
-            , Doc.String . getAnyPrintableText <$> arbitrary
+        , Doc.String <$> (getAnyPrintableText <$> arbitrary)
        , Doc.Boolean <$> arbitrary
        , MkGen $ \_ _ -> Doc.Null
-            , Doc.Enum . getAnyName <$> arbitrary
+        , Doc.Enum <$> (getAnyName <$> arbitrary)
        , Doc.List <$> listGen
        , Doc.Object <$> objectGen
        ]
            where
                variableGen :: Gen Doc.Value
                variableGen = Doc.Variable <$> (getAnyName <$> arbitrary)
                listGen :: Gen [Doc.Node Doc.Value]
                listGen = (resize 5 . listOf) nodeGen
                nodeGen = do
                    node' <- getAnyNode <$> (arbitrary :: Gen (AnyNode AnyValue))
                    pure (getAnyValue <$> node')
                objectGen :: Gen [Doc.ObjectField Doc.Value]
                objectGen = resize 1 $ do
                    list <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList (AnyObjectField AnyValue)))
                    pure $ map (fmap getAnyValue . getAnyObjectField) list
-newtype AnyArgument a = AnyArgument
+newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument } deriving (Eq, Show)
    { getAnyArgument :: Doc.Argument
    } deriving (Eq, Show)
 instance Arbitrary a => Arbitrary (AnyArgument a) where
    arbitrary = do
@ -126,5 +96,4 @@ instance Arbitrary a => Arbitrary (AnyArgument a) where
        pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
 printArgument :: AnyArgument AnyValue -> Text
-printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
+printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) = name' <> ": " <> (pack . show) value'
    name' <> ": " <> (Text.pack . show) value'
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.EncoderSpec
    ( spec
    ) where
@ -6,17 +7,20 @@ module Language.GraphQL.AST.EncoderSpec
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Language.GraphQL.AST.Document as Full
 import Language.GraphQL.AST.Encoder
 import Language.GraphQL.TH
 import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
 import Test.QuickCheck (choose, oneof, forAll)
 import qualified Data.Text.Lazy as Text.Lazy
 import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 spec :: Spec
 spec = do
    describe "value" $ do
        context "null value" $ do
            let testNull formatter = value formatter Full.Null `shouldBe` "null"
            it "minified" $ testNull minified
            it "pretty" $ testNull pretty
        context "minified" $ do
            it "encodes null" $
                value minified Full.Null `shouldBe` "null"
            it "escapes \\" $
                value minified (Full.String "\\") `shouldBe` "\"\\\\\""
            it "escapes double quotes" $
@ -42,95 +46,113 @@ spec = do
                it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
        context "pretty" $ do
            it "encodes null" $
                value pretty Full.Null `shouldBe` "null"
            it "uses strings for short string values" $
                value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
            it "uses block strings for text with new lines, with newline symbol" $
-                let expected = "\"\"\"\n\
+                let expected = [gql|
-                        \  Line 1\n\
+                  """
-                        \  Line 2\n\
+                    Line 1
-                        \\"\"\""
+                    Line 2
                  """
                |]
                    actual = value pretty $ Full.String "Line 1\nLine 2"
                 in actual `shouldBe` expected
            it "uses block strings for text with new lines, with CR symbol" $
-                let expected = "\"\"\"\n\
+                let expected = [gql|
-                        \  Line 1\n\
+                  """
-                        \  Line 2\n\
+                    Line 1
-                        \\"\"\""
+                    Line 2
                  """
                |]
                    actual = value pretty $ Full.String "Line 1\rLine 2"
                 in actual `shouldBe` expected
            it "uses block strings for text with new lines, with CR symbol followed by newline" $
-                let expected = "\"\"\"\n\
+                let expected = [gql|
-                        \  Line 1\n\
+                  """
-                        \  Line 2\n\
+                    Line 1
-                        \\"\"\""
+                    Line 2
                  """
                |]
                    actual = value pretty $ Full.String "Line 1\r\nLine 2"
                 in actual `shouldBe` expected
            it "encodes as one line string if has escaped symbols" $ do
-                let genNotAllowedSymbol = oneof
+                let
                  genNotAllowedSymbol = oneof
                    [ choose ('\x0000', '\x0008')
                    , choose ('\x000B', '\x000C')
                    , choose ('\x000E', '\x001F')
                    , pure '\x007F'
                    ]
                forAll genNotAllowedSymbol $ \x -> do
-                    let rawValue = "Short \n" <> Text.Lazy.cons x "text"
+                    let
-                        encoded = Text.Lazy.unpack
+                      rawValue = "Short \n" <> Text.Lazy.cons x "text"
-                            $ value pretty
+                      encoded = value pretty
-                            $ Full.String
+                          $ Full.String $ Text.Lazy.toStrict rawValue
-                            $ Text.Lazy.toStrict rawValue
+                    shouldStartWith (Text.Lazy.unpack encoded) "\""
-                    shouldStartWith encoded "\""
+                    shouldEndWith (Text.Lazy.unpack encoded) "\""
-                    shouldEndWith encoded "\""
+                    shouldNotContain (Text.Lazy.unpack encoded) "\"\"\""
                    shouldNotContain encoded "\"\"\""
            it "Hello world" $
                let actual = value pretty
                        $ Full.String "Hello,\n  World!\n\nYours,\n  GraphQL."
-                    expected = "\"\"\"\n\
+                    expected = [gql|
-                        \  Hello,\n\
+                      """
-                        \    World!\n\
+                        Hello,
-                        \\n\
+                          World!
-                        \  Yours,\n\
+
-                        \    GraphQL.\n\
+                        Yours,
-                        \\"\"\""
+                          GraphQL.
                      """
                    |]
                  in actual `shouldBe` expected
            it "has only newlines" $
                let actual = value pretty $ Full.String "\n"
-                    expected = "\"\"\"\n\n\n\"\"\""
+                    expected = [gql|
                      """
                      """
                    |]
                 in actual `shouldBe` expected
            it "has newlines and one symbol at the begining" $
                let actual = value pretty $ Full.String "a\n\n"
-                    expected = "\"\"\"\n\
+                    expected = [gql|
-                        \  a\n\
+                      """
-                        \\n\
+                        a
-                        \\n\
+
-                        \\"\"\""
+
                      """|]
                 in actual `shouldBe` expected
            it "has newlines and one symbol at the end" $
                let actual = value pretty $ Full.String "\n\na"
-                    expected = "\"\"\"\n\
+                    expected = [gql|
-                        \\n\
+                      """
-                        \\n\
+
-                        \  a\n\
+
-                        \\"\"\""
+                        a
                      """
                    |]
                 in actual `shouldBe` expected
            it "has newlines and one symbol in the middle" $
                let actual = value pretty $ Full.String "\na\n"
-                    expected = "\"\"\"\n\
+                    expected = [gql|
-                        \\n\
+                      """
-                        \  a\n\
+
-                        \\n\
+                        a
-                        \\"\"\""
+
                      """
                    |]
                 in actual `shouldBe` expected
            it "skip trailing whitespaces" $
                let actual = value pretty $ Full.String "  Short\ntext    "
-                    expected = "\"\"\"\n\
+                    expected = [gql|
-                        \  Short\n\
+                      """
-                        \  text\n\
+                        Short
-                        \\"\"\""
+                        text
                      """
                    |]
                 in actual `shouldBe` expected
    describe "definition" $
@ -142,12 +164,14 @@ spec = do
                fieldSelection = pure $ Full.FieldSelection field
                operation = Full.DefinitionOperation
                    $ Full.SelectionSet fieldSelection location
-                expected = "{\n\
+                expected = Text.Lazy.snoc [gql|
-                    \  field(message: \"\"\"\n\
+                  {
-                    \    line1\n\
+                    field(message: """
-                    \    line2\n\
+                      line1
-                    \  \"\"\")\n\
+                      line2
-                    \}\n"
+                    """)
                  }
                |] '\n'
                actual = definition pretty operation
             in actual `shouldBe` expected
@ -162,10 +186,12 @@ spec = do
                mutationType = Full.OperationTypeDefinition Full.Mutation "MutationType"
                operations = queryType :| pure mutationType
                definition' = Full.SchemaDefinition [] operations
-                expected = "schema {\n\
+                expected = Text.Lazy.snoc [gql|
-                    \  query: QueryRootType\n\
+                  schema {
-                    \  mutation: MutationType\n\
+                    query: QueryRootType
-                    \}\n"
+                    mutation: MutationType
                  }
                |] '\n'
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
@ -181,12 +207,14 @@ spec = do
                argument = Full.InputValueDefinition mempty "arg" someType Nothing mempty
                arguments = Full.ArgumentsDefinition [argument]
                definition' = Full.TypeDefinition
-                    $ Full.InterfaceTypeDefinition mempty "UUID" (Full.ImplementsInterfaces []) mempty
+                    $ Full.InterfaceTypeDefinition mempty "UUID" mempty
                    $ pure
                    $ Full.FieldDefinition mempty "value" arguments someType mempty
-                expected = "interface UUID {\n\
+                expected = [gql|
-                    \  value(arg: String): String\n\
+                  interface UUID {
-                    \}"
+                    value(arg: String): String
                  }
                |]
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
@ -194,9 +222,11 @@ spec = do
            let definition' = Full.TypeDefinition
                    $ Full.UnionTypeDefinition mempty "SearchResult" mempty
                    $ Full.UnionMemberTypes ["Photo", "Person"]
-                expected = "union SearchResult =\n\
+                expected = [gql|
-                    \  | Photo\n\
+                  union SearchResult =
-                    \  | Person"
+                    | Photo
                    | Person
                |]
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
@ -209,12 +239,14 @@ spec = do
                    ]
                definition' = Full.TypeDefinition
                    $ Full.EnumTypeDefinition mempty "Direction" mempty values
-                expected = "enum Direction {\n\
+                expected = [gql|
-                    \  NORTH\n\
+                  enum Direction {
-                    \  EAST\n\
+                    NORTH
-                    \  SOUTH\n\
+                    EAST
-                    \  WEST\n\
+                    SOUTH
-                    \}"
+                    WEST
                  }
                |]
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
@ -227,28 +259,11 @@ spec = do
                    ]
                definition' = Full.TypeDefinition
                    $ Full.InputObjectTypeDefinition mempty "ExampleInputObject" mempty fields
-                expected = "input ExampleInputObject {\n\
+                expected = [gql|
-                    \  a: String\n\
+                  input ExampleInputObject {
-                    \  b: Int!\n\
+                    a: String
-                    \}"
+                    b: Int!
-                actual = typeSystemDefinition pretty definition'
+                  }
-             in actual `shouldBe` expected
+                |]
        context "directive definition" $ do
            it "encodes a directive definition" $ do
                let definition' = Full.DirectiveDefinition mempty "example" mempty False
                        $ pure
                        $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
                    expected = "@example() on\n\
                        \  | FIELD"
                    actual = typeSystemDefinition pretty definition'
                 in actual `shouldBe` expected
            it "encodes a repeatable directive definition" $ do
                let definition' = Full.DirectiveDefinition mempty "example" mempty True
                        $ pure
                        $ DirectiveLocation.ExecutableDirectiveLocation DirectiveLocation.Field
                    expected = "@example() repeatable on\n\
                        \  | FIELD"
                actual = typeSystemDefinition pretty definition'
             in actual `shouldBe` expected
--- a/tests/Language/GraphQL/AST/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.LexerSpec
    ( spec
    ) where
@ -6,6 +7,7 @@ module Language.GraphQL.AST.LexerSpec
 import Data.Text (Text)
 import Data.Void (Void)
 import Language.GraphQL.AST.Lexer
 import Language.GraphQL.TH
 import Test.Hspec (Spec, context, describe, it)
 import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
 import Text.Megaparsec (ParseErrorBundle, parse)
@ -17,39 +19,38 @@ spec = describe "Lexer" $ do
            parse unicodeBOM "" `shouldSucceedOn` "\xfeff"
        it "lexes strings" $ do
-            parse string "" "\"simple\"" `shouldParse` "simple"
+            parse string "" [gql|"simple"|] `shouldParse` "simple"
-            parse string "" "\" white space \"" `shouldParse` " white space "
+            parse string "" [gql|" white space "|] `shouldParse` " white space "
-            parse string "" "\"quote \\\"\"" `shouldParse` "quote \""
+            parse string "" [gql|"quote \""|] `shouldParse` [gql|quote "|]
-            parse string "" "\"escaped \\n\"" `shouldParse` "escaped \n"
+            parse string "" [gql|"escaped \n"|] `shouldParse` "escaped \n"
-            parse string "" "\"slashes \\\\ \\/\"" `shouldParse` "slashes \\ /"
+            parse string "" [gql|"slashes \\ \/"|] `shouldParse` [gql|slashes \ /|]
-            parse string "" "\"unicode \\u1234\\u5678\\u90AB\\uCDEF\""
+            parse string "" [gql|"unicode \u1234\u5678\u90AB\uCDEF"|]
                `shouldParse` "unicode ሴ噸邫췯"
        it "lexes block string" $ do
-            parse blockString "" "\"\"\"simple\"\"\"" `shouldParse` "simple"
+            parse blockString "" [gql|"""simple"""|] `shouldParse` "simple"
-            parse blockString "" "\"\"\" white space \"\"\""
+            parse blockString "" [gql|""" white space """|]
                `shouldParse` " white space "
-            parse blockString "" "\"\"\"contains \" quote\"\"\""
+            parse blockString "" [gql|"""contains " quote"""|]
-                `shouldParse` "contains \" quote"
+                `shouldParse` [gql|contains " quote|]
-            parse blockString "" "\"\"\"contains \\\"\"\" triplequote\"\"\""
+            parse blockString "" [gql|"""contains \""" triplequote"""|]
-                `shouldParse` "contains \"\"\" triplequote"
+                `shouldParse` [gql|contains """ triplequote|]
            parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
            parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\""
                `shouldParse` "multi\nline\nnormalized"
-            parse blockString "" "\"\"\"unescaped \\n\\r\\b\\t\\f\\u1234\"\"\""
+            parse blockString "" [gql|"""unescaped \n\r\b\t\f\u1234"""|]
-                `shouldParse` "unescaped \\n\\r\\b\\t\\f\\u1234"
+                `shouldParse` [gql|unescaped \n\r\b\t\f\u1234|]
-            parse blockString "" "\"\"\"slashes \\\\ \\/\"\"\""
+            parse blockString "" [gql|"""slashes \\ \/"""|]
-                `shouldParse` "slashes \\\\ \\/"
+                `shouldParse` [gql|slashes \\ \/|]
-            parse blockString "" "\"\"\"\n\
+            parse blockString "" [gql|"""
-                \\n\
+
-                \  spans\n\
+                spans
-                \    multiple\n\
+                  multiple
-                \      lines\n\
+                    lines
-                \\n\
+
-                \\"\"\""
+                """|] `shouldParse` "spans\n  multiple\n    lines"
                `shouldParse` "spans\n  multiple\n    lines"
        it "lexes numbers" $ do
            parse integer "" "4" `shouldParse` (4 :: Int)
@ -83,7 +84,7 @@ spec = describe "Lexer" $ do
    context "Implementation tests" $ do
        it "lexes empty block strings" $
-            parse blockString "" "\"\"\"\"\"\"" `shouldParse` ""
+            parse blockString "" [gql|""""""|] `shouldParse` ""
        it "lexes ampersand" $
            parse amp "" "&" `shouldParse` "&"
        it "lexes schema extensions" $
--- a/tests/Language/GraphQL/AST/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@ -1,20 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.ParserSpec
    ( spec
    ) where
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
 import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
 import Language.GraphQL.AST.Parser
 import Language.GraphQL.TH
 import Test.Hspec (Spec, describe, it, context)
-import Test.Hspec.Megaparsec
+import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn)
    ( shouldParse
    , shouldFailOn
    , parseSatisfies
    , shouldSucceedOn
    )
 import Text.Megaparsec (parse)
 import Test.QuickCheck (property, NonEmptyList (..), mapSize)
 import Language.GraphQL.AST.Arbitrary
@ -26,159 +24,181 @@ spec = describe "Parser" $ do
    context "Arguments" $ do
       it "accepts block strings as argument" $
-            parse document "" `shouldSucceedOn`
+           parse document "" `shouldSucceedOn` [gql|{
-                "{ hello(text: \"\"\"Argument\"\"\") }"
+                 hello(text: """Argument""")
               }|]
       it "accepts strings as argument" $
-            parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
+           parse document "" `shouldSucceedOn` [gql|{
                 hello(text: "Argument")
               }|]
-        it "accepts int as argument" $
+       it "accepts int as argument1" $
-            parse document "" `shouldSucceedOn` "{ user(id: 4) }"
+           parse document "" `shouldSucceedOn` [gql|{
                 user(id: 4)
               }|]
       it "accepts boolean as argument" $
-            parse document "" `shouldSucceedOn`
+           parse document "" `shouldSucceedOn` [gql|{
-                "{ hello(flag: true) { field1 } }"
+                 hello(flag: true) { field1 }
               }|]
       it "accepts float as argument" $
-            parse document "" `shouldSucceedOn`
+           parse document "" `shouldSucceedOn` [gql|{
-                "{ body(height: 172.5) { height } }"
+                 body(height: 172.5) { height }
               }|]
       it "accepts empty list as argument" $
-            parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
+           parse document "" `shouldSucceedOn` [gql|{
                 query(list: []) { field1 }
               }|]
       it "accepts two required arguments" $
-            parse document "" `shouldSucceedOn`
+           parse document "" `shouldSucceedOn` [gql|
-                "mutation auth($username: String!, $password: String!) { test }"
+               mutation auth($username: String!, $password: String!){
                 test
               }|]
       it "accepts two string arguments" $
-            parse document "" `shouldSucceedOn`
+           parse document "" `shouldSucceedOn` [gql|
-                "mutation auth { test(username: \"username\", password: \"password\") }"
+               mutation auth{
                 test(username: "username", password: "password")
               }|]
       it "accepts two block string arguments" $
-            let given = "mutation auth {\n\
+           parse document "" `shouldSucceedOn` [gql|
-                    \  test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
+               mutation auth{
-                    \}"
+                 test(username: """username""", password: """password""")
-             in parse document "" `shouldSucceedOn` given
+               }|]
        it "fails to parse an empty argument list in parens" $
            parse document "" `shouldFailOn` "{ test() }"
       it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
-            let arguments' = map printArgument
+            let
-                    $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
+                query' :: Text
-                query' = "query(" <> Text.intercalate ", " arguments' <> ")"
+                arguments = map printArgument $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
-             in parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
+                query' = "query(" <> Text.intercalate ", " arguments <> ")" in
            parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
    it "parses minimal schema definition" $
-        parse document "" `shouldSucceedOn` "schema { query: Query }"
+        parse document "" `shouldSucceedOn` [gql|schema { query: Query }|]
    it "parses minimal scalar definition" $
-        parse document "" `shouldSucceedOn` "scalar Time"
+        parse document "" `shouldSucceedOn` [gql|scalar Time|]
    it "parses ImplementsInterfaces" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "type Person implements NamedEntity & ValuedEntity {\n\
+            type Person implements NamedEntity & ValuedEntity {
-            \  name: String\n\
+              name: String
-            \}"
+            }
        |]
    it "parses a  type without ImplementsInterfaces" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "type Person {\n\
+            type Person {
-            \  name: String\n\
+              name: String
-            \}"
+            }
        |]
    it "parses ArgumentsDefinition in an ObjectDefinition" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "type Person {\n\
+            type Person {
-            \  name(first: String, last: String): String\n\
+              name(first: String, last: String): String
-            \}"
+            }
        |]
    it "parses minimal union type definition" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "union SearchResult = Photo | Person"
+            union SearchResult = Photo | Person
        |]
    it "parses minimal interface type definition" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "interface NamedEntity {\n\
+            interface NamedEntity {
-            \  name: String\n\
+              name: String
-            \}"
+            }
-
+        |]
    it "parses ImplementsInterfaces on interfaces" $
        parse document "" `shouldSucceedOn`
            "interface Person implements NamedEntity & ValuedEntity {\n\
            \  name: String\n\
            \}"
    it "parses minimal enum type definition" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "enum Direction {\n\
+            enum Direction {
-            \  NORTH\n\
+              NORTH
-            \  EAST\n\
+              EAST
-            \  SOUTH\n\
+              SOUTH
-            \  WEST\n\
+              WEST
-            \}"
+            }
        |]
    it "parses minimal input object type definition" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "input Point2D {\n\
+            input Point2D {
-            \  x: Float\n\
+              x: Float
-            \  y: Float\n\
+              y: Float
-            \}"
+            }
        |]
    it "parses minimal input enum definition with an optional pipe" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "directive @example on\n\
+            directive @example on
-            \  | FIELD\n\
+              | FIELD
-            \  | FRAGMENT_SPREAD"
+              | FRAGMENT_SPREAD
        |]
    it "parses two minimal directive definitions" $
-        let directive name' loc = TypeSystemDefinition
+        let directive nm loc =
-                $ DirectiveDefinition
+                TypeSystemDefinition
                    (DirectiveDefinition
                         (Description Nothing)
-                    name'
+                         nm
                         (ArgumentsDefinition [])
-                    False
+                         (loc :| []))
-                    (loc :| [])
+            example1 =
-            example1 = directive "example1"
+                directive "example1"
                    (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
                    (Location {line = 1, column = 1})
-            example2 = directive "example2"
+            example2 =
                directive "example2"
                    (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
                    (Location {line = 2, column = 1})
            testSchemaExtension = example1 :| [ example2 ]
-            query = Text.unlines
+            query = [gql|
-                [ "directive @example1 on FIELD_DEFINITION"
+              directive @example1 on FIELD_DEFINITION
-                , "directive @example2 on FIELD"
+              directive @example2 on FIELD
-                ]
+            |]
         in parse document "" query `shouldParse` testSchemaExtension
    it "parses a directive definition with a default empty list argument" $
-        let argumentValue = Just
+        let directive nm loc args =
-                $ Node (ConstList [])
+                TypeSystemDefinition
-                $ Location{ line = 1, column = 33 }
+                    (DirectiveDefinition
            loc = DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition
            argumentValueDefinition = InputValueDefinition
                         (Description Nothing)
-                "foo"
+                         nm
-                (TypeList (TypeNamed "String"))
+                         (ArgumentsDefinition
-                argumentValue
+                              [ InputValueDefinition
                                    (Description Nothing)
                                    argName
                                    argType
                                    argValue
                                    []
-            definition = DirectiveDefinition
+                              | (argName, argType, argValue) <- args])
-                (Description Nothing)
+                         (loc :| []))
-                "test"
+            defn =
-                (ArgumentsDefinition [argumentValueDefinition])
+                directive "test"
-                False
+                    (DirLoc.TypeSystemDirectiveLocation DirLoc.FieldDefinition)
-                (loc :| [])
+                    [("foo",
-            directive = TypeSystemDefinition definition
+                      TypeList (TypeNamed "String"),
-                $ Location{ line = 1, column = 1 }
+                      Just
-            query = "directive @test(foo: [String] = []) on FIELD_DEFINITION"
+                          $ Node (ConstList [])
-         in parse document "" query `shouldParse` (directive :| [])
+                          $ Location {line = 1, column = 33})]
                    (Location {line = 1, column = 1})
            query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
         in parse document "" query `shouldParse` (defn :| [ ])
    it "parses schema extension with a new directive" $
-        parse document "" `shouldSucceedOn` "extend schema @newDirective"
+        parse document "" `shouldSucceedOn`[gql|
            extend schema @newDirective
        |]
    it "parses schema extension with an operation type definition" $
-        parse document "" `shouldSucceedOn` "extend schema { query: Query }"
+        parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|]
    it "parses schema extension with an operation type and directive" $
        let newDirective = Directive "newDirective" [] $ Location 1 15
@ -187,42 +207,45 @@ spec = describe "Parser" $ do
                $ OperationTypeDefinition Query "Query" :| []
            testSchemaExtension = TypeSystemExtension schemaExtension
                $ Location 1 1
-            query = "extend schema @newDirective { query: Query }"
+            query = [gql|extend schema @newDirective { query: Query }|]
         in parse document "" query `shouldParse` (testSchemaExtension :| [])
    it "parses a repeatable directive definition" $
        let given = "directive @test repeatable on FIELD_DEFINITION"
            isRepeatable (TypeSystemDefinition definition' _ :| [])
                | DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
            isRepeatable _ = False
         in parse document "" given `parseSatisfies` isRepeatable
    it "parses an object extension" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "extend type Story { isHiddenLocally: Boolean }"
+            extend type Story {
              isHiddenLocally: Boolean
            }
        |]
    it "rejects variables in DefaultValue" $
-        parse document "" `shouldFailOn`
+        parse document "" `shouldFailOn` [gql|
-            "query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
+            query ($book: String = "Zarathustra", $author: String = $book) {
-            \  title\n\
+              title
-            \}"
+            }
        |]
    it "rejects empty selection set" $
-       parse document "" `shouldFailOn` "query { innerField {} }"
+       parse document "" `shouldFailOn` [gql|
            query {
              innerField {}
            }
        |]
    it "parses documents beginning with a comment" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "\"\"\"\n\
+            """
-            \Query\n\
+            Query
-            \\"\"\"\n\
+            """
-            \type Query {\n\
+            type Query {
-            \  queryField: String\n\
+                queryField: String
-            \}"
+            }
        |]
    it "parses subscriptions" $
-        parse document "" `shouldSucceedOn`
+        parse document "" `shouldSucceedOn` [gql|
-            "subscription NewMessages {\n\
+            subscription NewMessages {
-            \  newMessage(roomId: 123) {\n\
+              newMessage(roomId: 123) {
-            \    sender\n\
+                sender
-            \  }\n\
+              }
-            \}"
+            }
        |]
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@ -5,7 +5,9 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.ExecuteSpec
    ( spec
@ -21,6 +23,7 @@ import Language.GraphQL.AST (Document, Location(..), Name)
 import Language.GraphQL.AST.Parser (document)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute (execute)
 import Language.GraphQL.TH
 import qualified Language.GraphQL.Type.Schema as Schema
 import qualified Language.GraphQL.Type as Type
 import Language.GraphQL.Type
@ -66,7 +69,6 @@ queryType = Out.ObjectType "Query" Nothing []
    , ("throwing", ValueResolver throwingField throwingResolver)
    , ("count", ValueResolver countField countResolver)
    , ("sequence", ValueResolver sequenceField sequenceResolver)
    , ("withInputObject", ValueResolver withInputObjectField withInputObjectResolver)
    ]
  where
    philosopherField =
@ -87,17 +89,6 @@ queryType = Out.ObjectType "Query" Nothing []
        let fieldType = Out.ListType $ Out.NonNullScalarType int
         in Out.Field Nothing fieldType HashMap.empty
    sequenceResolver = pure intSequence
    withInputObjectResolver = pure $ Type.Int 0
    withInputObjectField =
        Out.Field Nothing (Out.NonNullScalarType int) $ HashMap.fromList
            [("values", In.Argument Nothing withInputObjectArgumentType Nothing)]
    withInputObjectArgumentType = In.NonNullListType
        $ In.NonNullInputObjectType inputObjectType
 inputObjectType :: In.InputObjectType
 inputObjectType = In.InputObjectType "InputObject" Nothing $
    HashMap.singleton "name" $
        In.InputField Nothing (In.NonNullScalarType int) Nothing
 intSequence :: Value
 intSequence = Type.List [Type.Int 1, Type.Int 2, Type.Int 3]
@ -266,15 +257,15 @@ spec :: Spec
 spec =
    describe "execute" $ do
        it "rejects recursive fragments" $
-            let sourceQuery = "\
+            let sourceQuery = [gql|
-              \{\n\
+              {
-              \  ...cyclicFragment\n\
+                ...cyclicFragment
-              \}\n\
+              }
-              \\n\
+
-              \fragment cyclicFragment on Query {\n\
+              fragment cyclicFragment on Query {
-              \  ...cyclicFragment\n\
+                ...cyclicFragment
-              \}\
+              }
-              \"
+            |]
                expected = Response (Object mempty) mempty
             in sourceQuery `shouldResolveTo` expected
@ -304,7 +295,7 @@ spec =
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message =
-                            "Value completion error. Expected type School!, found: EXISTENTIALISM."
+                            "Value completion error. Expected type !School, found: EXISTENTIALISM."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "school"]
                        }
@ -316,7 +307,7 @@ spec =
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message =
-                            "Value completion error. Expected type Interest!, found: { instrument: \"piano\" }."
+                            "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "interest"]
                        }
@ -328,7 +319,7 @@ spec =
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message
-                            = "Value completion error. Expected type Work!, found:\
+                            = "Value completion error. Expected type !Work, found:\
                            \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }."
                        , locations = [Location 1 17]
                        , path = [Segment "philosopher", Segment "majorWork"]
@ -337,10 +328,22 @@ spec =
                    sourceQuery = "{ philosopher { majorWork { title } } }"
                 in sourceQuery `shouldResolveTo` expected
            it "gives location information for invalid scalar arguments" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
                        { message =
                            "Argument \"id\" has invalid type. Expected type ID, found: True."
                        , locations = [Location 1 15]
                        , path = [Segment "philosopher"]
                        }
                    expected = Response data'' executionErrors
                    sourceQuery = "{ philosopher(id: true) { lastName } }"
                 in sourceQuery `shouldResolveTo` expected
            it "gives location information for failed result coercion" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
-                        { message = "Unable to coerce result to Int!."
+                        { message = "Unable to coerce result to !Int."
                        , locations = [Location 1 26]
                        , path = [Segment "philosopher", Segment "century"]
                        }
@ -361,7 +364,7 @@ spec =
            it "sets data to null if a root field isn't nullable" $
                let executionErrors = pure $ Error
-                        { message = "Unable to coerce result to Int!."
+                        { message = "Unable to coerce result to !Int."
                        , locations = [Location 1 3]
                        , path = [Segment "count"]
                        }
@ -372,7 +375,7 @@ spec =
            it "detects nullability errors" $
                let data'' = Object $ HashMap.singleton "philosopher" Null
                    executionErrors = pure $ Error
-                        { message = "Value completion error. Expected type String!, found: null."
+                        { message = "Value completion error. Expected type !String, found: null."
                        , locations = [Location 1 26]
                        , path = [Segment "philosopher", Segment "firstLanguage"]
                        }
@ -386,25 +389,6 @@ spec =
                    sourceQuery = "{ sequence }"
                in sourceQuery `shouldResolveTo` expected
            context "Arguments" $ do
                it "gives location information for invalid scalar arguments" $
                    let data'' = Object $ HashMap.singleton "philosopher" Null
                        executionErrors = pure $ Error
                            { message =
                                "Argument \"id\" has invalid type. Expected type ID, found: True."
                            , locations = [Location 1 15]
                            , path = [Segment "philosopher"]
                            }
                        expected = Response data'' executionErrors
                        sourceQuery = "{ philosopher(id: true) { lastName } }"
                    in sourceQuery `shouldResolveTo` expected
                it "puts an object in a list if needed" $
                    let data'' = Object $ HashMap.singleton "withInputObject" $ Type.Int 0
                        expected = Response data'' mempty
                        sourceQuery = "{ withInputObject(values: { name: 0 }) }"
                    in sourceQuery `shouldResolveTo` expected
            context "queryError" $ do
                let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"
                    twoQueries = namedQuery "A" <> " " <> namedQuery "B"
--- a/tests/Language/GraphQL/THSpec.hs
+++ b/tests/Language/GraphQL/THSpec.hs
@ -0,0 +1,23 @@
 {- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}
 {-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.THSpec
    ( spec
    ) where
 import Language.GraphQL.TH (gql)
 import Test.Hspec (Spec, describe, it, shouldBe)
 spec :: Spec
 spec =
    describe "gql" $
        it "replaces CRNL with NL" $
            let expected = "line1\nline2"
                actual = [gql|
                  line1
                  line2
                |]
             in actual `shouldBe` expected
--- a/tests/Language/GraphQL/Validate/RulesSpec.hs
+++ b/tests/Language/GraphQL/Validate/RulesSpec.hs