graphql 0.9.0.0 → 0.10.0.0

raw patch · 27 files changed

+721/−296 lines, 27 filesdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−5
• CONTRIBUTING.md +31/−0
• README.md +107/−7
• graphql.cabal +34/−28
• src/Language/GraphQL/AST.hs +4/−0
• src/Language/GraphQL/AST/DirectiveLocation.hs +7/−3
• src/Language/GraphQL/AST/Document.hs +10/−3
• src/Language/GraphQL/AST/Encoder.hs +7/−7
• src/Language/GraphQL/AST/Parser.hs +25/−20
• src/Language/GraphQL/Execute/Coerce.hs +4/−0
• src/Language/GraphQL/Execute/Execution.hs +0/−24
• src/Language/GraphQL/Execute/Transform.hs +12/−24
• src/Language/GraphQL/Type/In.hs +4/−0
• src/Language/GraphQL/Type/Internal.hs +39/−0
• src/Language/GraphQL/Type/Schema.hs +4/−0
• src/Language/GraphQL/Validate.hs +31/−47
• src/Language/GraphQL/Validate/Rules.hs +198/−14
• src/Language/GraphQL/Validate/Validation.hs +54/−0
• src/Test/Hspec/GraphQL.hs +5/−4
• tests/Language/GraphQL/AST/EncoderSpec.hs +3/−1
• tests/Language/GraphQL/ErrorSpec.hs +4/−0
• tests/Language/GraphQL/Execute/CoerceSpec.hs +4/−0
• tests/Language/GraphQL/Type/OutSpec.hs +4/−0
• tests/Language/GraphQL/ValidateSpec.hs +113/−1
• tests/Test/KitchenSinkSpec.hs +0/−69
• tests/data/kitchen-sink.graphql +0/−38
• tests/data/kitchen-sink.min.graphql +0/−1

@@ -6,7 +6,20 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## [Unreleased]+## [0.10.0.0] - 2020-08-29+## Changed+- `Test.Hspec.GraphQL.*`: replace `IO` in the resolver with any `MonadCatch`.+- The `Location` argument of `AST.Document.Definition.ExecutableDefinition` was+  moved to `OperationDefinition` and `FragmentDefinition` since these are the+  actual elements that have a location in the document.+- `Validate.Rules` get the whole validation context (AST and schema).++## Added+- `Validate.Validation` contains data structures and functions used by the+  validator and concretet rules.+- `Validate.Rules`: operation validation rules.++## [0.9.0.0] - 2020-07-24 ## Fixed - Location of a parse error is returned in a singleton array with key   `locations`.@@ -21,7 +34,7 @@ - `Error.Error` is an error representation with a message and source location. - `Error.Response` represents a result of running a GraphQL query. - `Type.Schema` exports `Type` which lists all types possible in the schema.-- Parsing subscriptions (the execution always fails yet).+- Parsing subscriptions. - `Error.ResponseEventStream`, `Type.Out.Resolve`, `Type.Out.Subscribe` and   `Type.Out.SourceEventStream` define subscription resolvers. - `Error.ResolverException` is an exception that can be thrown by (field value@@ -57,8 +70,6 @@ ## Removed - `Trans.ActionT` is an unneeded layer of complexity. `Type.Out.Resolver`   represents possible resolver configurations.-- `Type.Out.Resolver`: It . Resolvers are a-  part of the fields and are called `Trans.ResolverT`. - `Execute.executeWithName`. `Execute.execute` takes the operation name and    completely replaces `executeWithName`. @@ -323,7 +334,8 @@ ### Added - Data types for the GraphQL language. -[Unreleased]: https://github.com/caraus-ecms/graphql/compare/v0.8.0.0...HEAD+[0.10.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.9.0.0...v0.10.0.0+[0.9.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.8.0.0...v0.9.0.0 [0.8.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.7.0.0...v0.8.0.0 [0.7.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...v0.7.0.0 [0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0

@@ -0,0 +1,31 @@+# Contributing guidelines++## Testing++To ensure all code changes adhere to existing code quality standards, some+automatic checks can be run locally.++Ensure that the code builds without warnings and passes the tests:++```sh+stack test --pedantic+```++And also run the linter on your code:++```sh+stack build hlint+stack exec hlint -- src tests+```++Build the documentation and check if you get any warnings:++```sh+stack haddock+```++Validate that literate Haskell (tutorials) files compile without any warnings:++```sh+stack ghc -- -Wall -fno-code docs/tutorial/*.lhs+```

@@ -1,10 +1,9 @@-# Haskell GraphQL+# GraphQL implementation in Haskell  [![Hackage Version](https://img.shields.io/hackage/v/graphql.svg)](https://hackage.haskell.org/package/graphql) [![Build Status](https://github.com/caraus-ecms/graphql/workflows/Haskell%20CI/badge.svg)](https://github.com/caraus-ecms/graphql/actions?query=workflow%3A%22Haskell+CI%22) [![License](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](https://raw.githubusercontent.com/caraus-ecms/graphql/master/LICENSE)--GraphQL implementation in Haskell.+[![Simple Haskell](https://www.simplehaskell.org/badges/badge.svg)](https://www.simplehaskell.org)  This implementation is relatively low-level by design, it doesn't provide any mappings between the GraphQL types and Haskell's type system and avoids@@ -13,12 +12,19 @@  ## State of the work -For now this only provides a parser and a printer for the GraphQL query language-and allows to execute queries and mutations using the given schema, but without-the validation step. But the idea is to be a Haskell port of+For now this library provides:++- Parser for the query and schema languages, as well as a printer for the query+  language (minimizer and pretty-printer).+- Data structures to define a type system.+- Executor (queries, mutations and subscriptions are supported).+- Validation is work in progress.+- Introspection isn't available yet.++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+For a more precise list of currently missing features see issues marked as "[not implemented](https://github.com/caraus-ecms/graphql/labels/not%20implemented)".  ## Documentation@@ -28,6 +34,100 @@  You'll also find a small tutorial with some examples under [docs/tutorial](https://github.com/caraus-ecms/graphql/tree/master/docs/tutorial).++### Getting started++We start with a simple GraphQL API that provides us with some famous and less+famous cites.++```graphql+"""+Root Query type.+"""+type Query {+  """+  Provides a cite.+  """+  cite: String!+}+```++This is called a GraphQL schema, it defines all queries supported by the API.+`Query` is the root query type. Every GraphQL API should define a query type.++`Query` has a single field `cite` that returns a `String`. The `!` after the+type denotes that the returned value cannot be `Null`. GraphQL fields are+nullable by default.++To be able to work with this schema, we are going to implement it in Haskell.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Control.Exception (SomeException)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy.Char8+import qualified Data.HashMap.Strict as HashMap+import Language.GraphQL+import Language.GraphQL.Type+import qualified Language.GraphQL.Type.Out as Out++-- GraphQL supports 3 kinds of operations: queries, mutations and subscriptions.+-- Our first schema supports only queries.+schema :: Schema IO+schema = Schema+    { query = queryType, mutation = Nothing, subscription = Nothing }++-- GraphQL distinguishes between input and output types. Input types are field+-- argument types and they are defined in Language.GraphQL.Type.In. Output types+-- are result types, they are defined in Language.GraphQL.Type.Out. Root types+-- are always object types.+--+-- Here we define a type "Query". The second argument is an optional+-- description, the third one is the list of interfaces implemented by the+-- object type. The last argument is a field map. Keys are field names, values+-- are field definitions and resolvers. Resolvers are the functions, where the+-- actual logic lives, they return values for the respective fields.+queryType :: Out.ObjectType IO+queryType = Out.ObjectType "Query" (Just "Root Query type.") []+    $ HashMap.singleton "cite" citeResolver+  where+    -- 'ValueResolver' is a 'Resolver' data constructor, it combines a field+    -- definition with its resolver function. This function resolves a value for+    -- a field (as opposed to the 'EventStreamResolver' used by subscriptions).+    -- Our resolver just returns a constant value.+    citeResolver = ValueResolver citeField+        $ pure "Piscis primum a capite foetat"+    -- The first argument is an optional field description. The second one is+    -- the field type and the third one is for arguments (we have none in this+    -- example).+    --+    -- GraphQL has named and wrapping types. String is a scalar, named type.+    -- Named types are nullable by default. To make our "cite" field+    -- non-nullable, we wrap it in the wrapping type, Non-Null.+    citeField = Out.Field+        (Just "Provides a cite.") (Out.NonNullScalarType string) HashMap.empty++-- Now we can execute a query. Since our schema defines only one field,+-- everything we can do is to ask to resolve it and give back the result.+-- Since subscriptions don't return plain values, the 'graphql' function returns+-- an 'Either'. 'Left' is for subscriptions, 'Right' is for queries and+-- mutations.+main :: IO ()+main = do+    Right result <- graphql schema "{ cite }"+    ByteString.Lazy.Char8.putStrLn $ Aeson.encode result+```++Executing this query produces the following JSON:++```json+{+  "data": {+    "cite": "Piscis primum a capite foetat"+  }+}+```  ## Further information 

@@ -1,32 +1,35 @@-cabal-version: 1.12-name: graphql-version: 0.9.0.0-license: BSD3-license-file: LICENSE-copyright: (c) 2019-2020 Eugen Wissner,-           (c) 2015-2017 J. Daniel Navarro-maintainer: belka@caraus.de-author: Danny Navarro <j@dannynavarro.net>,-        Matthías Páll Gissurarson <mpg@mpg.is>,-        Sólrún Halla Einarsdóttir <she@mpg.is>-homepage: https://github.com/caraus-ecms/graphql#readme-bug-reports: https://github.com/caraus-ecms/graphql/issues-synopsis: Haskell GraphQL implementation+cabal-version:      1.12+name:               graphql+version:            0.10.0.0+license:            BSD3+license-file:       LICENSE+copyright:+    (c) 2019-2020 Eugen Wissner,+    (c) 2015-2017 J. Daniel Navarro++maintainer:         belka@caraus.de+author:+    Danny Navarro <j@dannynavarro.net>,+    Matthías Páll Gissurarson <mpg@mpg.is>,+    Sólrún Halla Einarsdóttir <she@mpg.is>++homepage:           https://github.com/caraus-ecms/graphql#readme+bug-reports:        https://github.com/caraus-ecms/graphql/issues+synopsis:           Haskell GraphQL implementation description:     This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.-category: Language-build-type: Simple-data-files:-    tests/data/kitchen-sink.graphql-    tests/data/kitchen-sink.min.graphql++category:           Language+build-type:         Simple extra-source-files:     CHANGELOG.md-    README.md+    CONTRIBUTING.md     LICENSE+    README.md     docs/tutorial/tutorial.lhs  source-repository head-    type: git+    type:     git     location: https://github.com/caraus-ecms/graphql  library@@ -46,8 +49,10 @@         Language.GraphQL.Type.Out         Language.GraphQL.Type.Schema         Language.GraphQL.Validate+        Language.GraphQL.Validate.Validation         Test.Hspec.GraphQL-    hs-source-dirs: src++    hs-source-dirs:   src     other-modules:         Language.GraphQL.Execute.Execution         Language.GraphQL.Execute.Subscribe@@ -55,6 +60,7 @@         Language.GraphQL.Type.Definition         Language.GraphQL.Type.Internal         Language.GraphQL.Validate.Rules+     default-language: Haskell2010     build-depends:         aeson >=1.4.7.1 && <1.5,@@ -71,9 +77,9 @@         unordered-containers >=0.2.10.0 && <0.3  test-suite tasty-    type: exitcode-stdio-1.0-    main-is: Spec.hs-    hs-source-dirs: tests+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    hs-source-dirs:   tests     other-modules:         Language.GraphQL.AST.EncoderSpec         Language.GraphQL.AST.LexerSpec@@ -85,14 +91,14 @@         Language.GraphQL.ValidateSpec         Test.DirectiveSpec         Test.FragmentSpec-        Test.KitchenSinkSpec         Test.RootOperationSpec         Test.StarWars.Data         Test.StarWars.QuerySpec         Test.StarWars.Schema         Paths_graphql+     default-language: Haskell2010-    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    ghc-options:      -threaded -rtsopts -with-rtsopts=-N     build-depends:         QuickCheck >=2.13.2 && <2.14,         aeson >=1.4.7.1 && <1.5,@@ -101,7 +107,7 @@         containers >=0.6.2.1 && <0.7,         exceptions >=0.10.4 && <0.11,         graphql -any,-        hspec >=2.7.1 && <2.8,+        hspec >=2.7.2 && <2.8,         hspec-expectations >=0.8.2 && <0.9,         hspec-megaparsec >=2.1.0 && <2.2,         megaparsec >=8.0.0 && <8.1,

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ -- | Target AST for parser. module Language.GraphQL.AST     ( module Language.GraphQL.AST.Document

@@ -1,5 +1,9 @@+{- 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/. -}+ -- | Various parts of a GraphQL document can be annotated with directives. ---   This module describes locations in a document where directives can appear.+-- This module describes locations in a document where directives can appear. module Language.GraphQL.AST.DirectiveLocation     ( DirectiveLocation(..)     , ExecutableDirectiveLocation(..)@@ -7,8 +11,8 @@     ) where  -- | All directives can be splitted in two groups: directives used to annotate---   various parts of executable definitions and the ones used in the schema---   definition.+-- various parts of executable definitions and the ones used in the schema+-- definition. data DirectiveLocation     = ExecutableDirectiveLocation ExecutableDirectiveLocation     | TypeSystemDirectiveLocation TypeSystemDirectiveLocation

@@ -62,6 +62,12 @@     , column :: Word     } deriving (Eq, Show) +instance Ord Location where+    compare (Location thisLine thisColumn) (Location thatLine thatColumn)+        | thisLine < thatLine = LT+        | thisLine > thatLine = GT+        | otherwise = compare thisColumn thatColumn+ -- ** Document  -- | GraphQL document.@@ -69,7 +75,7 @@  -- | All kinds of definitions that can occur in a GraphQL document. data Definition-    = ExecutableDefinition ExecutableDefinition Location+    = ExecutableDefinition ExecutableDefinition     | TypeSystemDefinition TypeSystemDefinition Location     | TypeSystemExtension TypeSystemExtension Location     deriving (Eq, Show)@@ -84,13 +90,14 @@  -- | Operation definition. data OperationDefinition-    = SelectionSet SelectionSet+    = SelectionSet SelectionSet Location     | OperationDefinition         OperationType         (Maybe Name)         [VariableDefinition]         [Directive]         SelectionSet+        Location     deriving (Eq, Show)  -- | GraphQL has 3 operation types:@@ -195,7 +202,7 @@  -- | Fragment definition. data FragmentDefinition-    = FragmentDefinition Name TypeCondition [Directive] SelectionSet+    = FragmentDefinition Name TypeCondition [Directive] SelectionSet Location     deriving (Eq, Show)  -- | Type condition.

@@ -50,8 +50,8 @@     | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'   where     encodeDocument = foldr executableDefinition [] defs-    executableDefinition (ExecutableDefinition x _) acc =-        definition formatter x : acc+    executableDefinition (ExecutableDefinition executableDefinition') acc =+        definition formatter executableDefinition' : acc     executableDefinition _ acc = acc  -- | Converts a t'ExecutableDefinition' into a string.@@ -68,12 +68,12 @@ -- | Converts a 'OperationDefinition into a string. operationDefinition :: Formatter -> OperationDefinition -> Lazy.Text operationDefinition formatter = \case-    SelectionSet sels -> selectionSet formatter sels-    OperationDefinition Query name vars dirs sels ->+    SelectionSet sels _ -> selectionSet formatter sels+    OperationDefinition Query name vars dirs sels _ ->         "query " <> node formatter name vars dirs sels-    OperationDefinition Mutation name vars dirs sels ->+    OperationDefinition Mutation name vars dirs sels _ ->         "mutation " <> node formatter name vars dirs sels-    OperationDefinition Subscription name vars dirs sels ->+    OperationDefinition Subscription name vars dirs sels _ ->         "subscription " <> node formatter name vars dirs sels  -- | Converts a Query or Mutation into a string.@@ -190,7 +190,7 @@     <> selectionSet formatter sels  fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text-fragmentDefinition formatter (FragmentDefinition name tc dirs sels)+fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)     = "fragment " <> Lazy.Text.fromStrict name     <> " on " <> Lazy.Text.fromStrict tc     <> optempty (directives formatter) dirs

@@ -21,7 +21,8 @@ import Language.GraphQL.AST.Document import Language.GraphQL.AST.Lexer import Text.Megaparsec-    ( SourcePos(..)+    ( MonadParsec(..)+    , SourcePos(..)     , getSourcePos     , lookAhead     , option@@ -37,15 +38,11 @@     *> lexeme (NonEmpty.some definition)  definition :: Parser Definition-definition = executableDefinition'+definition = ExecutableDefinition <$> executableDefinition     <|> typeSystemDefinition'     <|> typeSystemExtension'     <?> "Definition"   where-    executableDefinition' = do-        location <- getLocation-        definition' <- executableDefinition-        pure $ ExecutableDefinition definition' location     typeSystemDefinition' = do         location <- getLocation         definition' <- typeSystemDefinition@@ -349,16 +346,22 @@     <?> "OperationTypeDefinition"  operationDefinition :: Parser OperationDefinition-operationDefinition = SelectionSet <$> selectionSet+operationDefinition = shorthand     <|> operationDefinition'     <?> "OperationDefinition"   where-    operationDefinition'-        = OperationDefinition <$> operationType-        <*> optional name-        <*> variableDefinitions-        <*> directives-        <*> selectionSet+    shorthand = do+        location <- getLocation+        selectionSet' <- selectionSet+        pure $ SelectionSet selectionSet' location+    operationDefinition' = do+        location <- getLocation+        operationType' <- operationType+        operationName <- optional name+        variableDefinitions' <- variableDefinitions+        directives' <- directives+        selectionSet' <- selectionSet+        pure $ OperationDefinition operationType' operationName variableDefinitions' directives' selectionSet' location  operationType :: Parser OperationType operationType = Query <$ symbol "query"@@ -412,13 +415,15 @@     <?> "InlineFragment"  fragmentDefinition :: Parser FragmentDefinition-fragmentDefinition = FragmentDefinition-    <$  symbol "fragment"-    <*> name-    <*> typeCondition-    <*> directives-    <*> selectionSet-    <?> "FragmentDefinition"+fragmentDefinition =  label "FragmentDefinition" $ do+    location <- getLocation+    _ <- symbol "fragment"+    fragmentName' <- name+    typeCondition' <- typeCondition+    directives' <- directives+    selectionSet' <- selectionSet+    pure $ FragmentDefinition+        fragmentName' typeCondition' directives' selectionSet' location  fragmentName :: Parser Name fragmentName = but (symbol "on") *> name <?> "FragmentName"

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-}

@@ -83,30 +83,6 @@             _ -> pure Nothing     | otherwise = pure Nothing -doesFragmentTypeApply :: forall m-    . CompositeType m-    -> Out.ObjectType m-    -> Bool-doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =-    fragmentType == objectType-doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =-    instanceOf objectType $ AbstractInterfaceType fragmentType-doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =-    instanceOf objectType $ AbstractUnionType fragmentType--instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool-instanceOf objectType (AbstractInterfaceType interfaceType) =-    let Out.ObjectType _ _ interfaces _ = objectType-     in foldr go False interfaces-  where-    go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =-        acc || foldr go (interfaceType == objectInterfaceType) interfaces-instanceOf objectType (AbstractUnionType unionType) =-    let Out.UnionType _ _ members = unionType-     in foldr go False members-  where-    go unionMemberType acc = acc || objectType == unionMemberType- executeField :: (MonadCatch m, Serialize a)     => Out.Resolver m     -> Type.Value

@@ -255,18 +255,18 @@      in (, fragmentTable) <$> maybe emptyDocument Right nonEmptyOperations   where     defragment' definition (operations, fragments')-        | (Full.ExecutableDefinition executable _) <- definition+        | (Full.ExecutableDefinition executable) <- definition         , (Full.DefinitionOperation operation') <- executable =             (transform operation' : operations, fragments')-        | (Full.ExecutableDefinition executable _) <- definition+        | (Full.ExecutableDefinition executable) <- definition         , (Full.DefinitionFragment fragment) <- executable-        , (Full.FragmentDefinition name _ _ _) <- fragment =+        , (Full.FragmentDefinition name _ _ _ _) <- fragment =             (operations, HashMap.insert name fragment fragments')     defragment' _ acc = acc     transform = \case-        Full.OperationDefinition type' name variables directives' selections ->+        Full.OperationDefinition type' name variables directives' selections _ ->             OperationDefinition type' name variables directives' selections-        Full.SelectionSet selectionSet ->+        Full.SelectionSet selectionSet _ ->             OperationDefinition Full.Query Nothing mempty mempty selectionSet  -- * Operation@@ -324,8 +324,8 @@             case type' of                 Nothing -> pure $ Left fragmentSelectionSet                 Just typeName -> do-                    typeCondition' <- lookupTypeCondition typeName-                    case typeCondition' of+                    types' <- gets types+                    case lookupTypeCondition typeName types' of                         Just typeCondition -> pure $                             selectionFragment typeCondition fragmentSelectionSet                         Nothing -> pure $ Left mempty@@ -364,29 +364,17 @@         _ <- fragmentDefinition nextValue         collectFragments -lookupTypeCondition :: Full.Name -> State (Replacement m) (Maybe (CompositeType m))-lookupTypeCondition type' = do-    types' <- gets types-    case HashMap.lookup type' types' of-        Just (ObjectType objectType) ->-            lift $ pure $ Just $ CompositeObjectType objectType-        Just (UnionType unionType) ->-            lift $ pure $ Just $ CompositeUnionType unionType-        Just (InterfaceType interfaceType) ->-            lift $ pure $ Just $ CompositeInterfaceType interfaceType-        _ -> lift $ pure Nothing- fragmentDefinition     :: Full.FragmentDefinition     ->  State (Replacement m) (Maybe (Fragment m))-fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do+fragmentDefinition (Full.FragmentDefinition name type' _ selections _) = do     modify deleteFragmentDefinition     fragmentSelection <- appendSelection selections-    compositeType <- lookupTypeCondition type'+    types' <- gets types -    case compositeType of-        Just compositeType' -> do-            let newValue = Fragment compositeType' fragmentSelection+    case lookupTypeCondition type' types' of+        Just compositeType -> do+            let newValue = Fragment compositeType fragmentSelection             modify $ insertFragment newValue             lift $ pure $ Just newValue         _ -> lift $ pure Nothing

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} 

@@ -8,6 +8,9 @@     ( AbstractType(..)     , CompositeType(..)     , collectReferencedTypes+    , doesFragmentTypeApply+    , instanceOf+    , lookupTypeCondition     ) where  import Data.HashMap.Strict (HashMap)@@ -89,3 +92,39 @@     polymorphicTraverser interfaces fields         = flip (foldr visitFields) fields         . flip (foldr traverseInterfaceType) interfaces++doesFragmentTypeApply :: forall m+    . CompositeType m+    -> Out.ObjectType m+    -> Bool+doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =+    fragmentType == objectType+doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =+    instanceOf objectType $ AbstractInterfaceType fragmentType+doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =+    instanceOf objectType $ AbstractUnionType fragmentType++instanceOf :: forall m. Out.ObjectType m -> AbstractType m -> Bool+instanceOf objectType (AbstractInterfaceType interfaceType) =+    let Out.ObjectType _ _ interfaces _ = objectType+     in foldr go False interfaces+  where+    go objectInterfaceType@(Out.InterfaceType _ _ interfaces _) acc =+        acc || foldr go (interfaceType == objectInterfaceType) interfaces+instanceOf objectType (AbstractUnionType unionType) =+    let Out.UnionType _ _ members = unionType+     in foldr go False members+  where+    go unionMemberType acc = acc || objectType == unionMemberType++lookupTypeCondition :: forall m+    . Name+    -> HashMap Name (Type m)+    -> Maybe (CompositeType m)+lookupTypeCondition type' types' =+    case HashMap.lookup type' types' of+        Just (ObjectType objectType) -> Just $ CompositeObjectType objectType+        Just (UnionType unionType) -> Just $ CompositeUnionType unionType+        Just (InterfaceType interfaceType) ->+            Just $ CompositeInterfaceType interfaceType+        _ -> Nothing

@@ -1,3 +1,7 @@+{- 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/. -}+ -- | This module provides a representation of a @GraphQL@ Schema in addition to -- functions for defining and manipulating schemas. module Language.GraphQL.Type.Schema

@@ -13,74 +13,51 @@     , module Language.GraphQL.Validate.Rules     ) where -import Control.Monad.Trans.Reader (Reader, asks, runReader)+import Control.Monad (foldM)+import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader) import Data.Foldable (foldrM) import Data.Sequence (Seq(..), (><), (|>)) import qualified Data.Sequence as Seq-import Data.Text (Text) import Language.GraphQL.AST.Document-import Language.GraphQL.Type.Schema+import Language.GraphQL.Type.Internal+import Language.GraphQL.Type.Schema (Schema(..)) import Language.GraphQL.Validate.Rules--data Context m = Context-    { ast :: Document-    , schema :: Schema m-    , rules :: [Rule]-    }--type ValidateT m = Reader (Context m) (Seq Error)---- | If an error can be associated to a particular field in the GraphQL result,--- it must contain an entry with the key path that details the path of the--- response field which experienced the error. This allows clients to identify--- whether a null result is intentional or caused by a runtime error.-data Path-    = Segment Text -- ^ Field name.-    | Index Int -- ^ List index if a field returned a list.-    deriving (Eq, Show)+import Language.GraphQL.Validate.Validation --- | Validation error.-data Error = Error-    { message :: String-    , locations :: [Location]-    , path :: [Path]-    } deriving (Eq, Show)+type ValidateT m = Reader (Validation m) (Seq Error)  -- | Validates a document and returns a list of found errors. If the returned -- list is empty, the document is valid.-document :: forall m. Schema m -> [Rule] -> Document -> Seq Error+document :: forall m. Schema m -> [Rule m] -> Document -> Seq Error document schema' rules' document' =     runReader (foldrM go Seq.empty document') context   where-    context = Context+    context = Validation         { ast = document'         , schema = schema'+        , types = collectReferencedTypes schema'         , rules = rules'         }     go definition' accumulator = (accumulator ><) <$> definition definition'  definition :: forall m. Definition -> ValidateT m definition = \case-    definition'@(ExecutableDefinition executableDefinition' _) -> do+    definition'@(ExecutableDefinition executableDefinition') -> do         applied <- applyRules definition'         children <- executableDefinition executableDefinition'         pure $ children >< applied     definition' -> applyRules definition'   where-    applyRules definition' = foldr (ruleFilter definition') Seq.empty-        <$> asks rules-    ruleFilter definition' (DefinitionRule rule) accumulator-        | Just message' <- rule definition' =-            accumulator |> Error-                { message = message'-                , locations = [definitionLocation definition']-                , path = []-                }-        | otherwise = accumulator-    definitionLocation (ExecutableDefinition _ location) = location-    definitionLocation (TypeSystemDefinition _ location) = location-    definitionLocation (TypeSystemExtension _ location) = location+    applyRules definition' =+        asks rules >>= foldM (ruleFilter definition') Seq.empty+    ruleFilter definition' accumulator (DefinitionRule rule) =+        mapReaderT (runRule accumulator) $ rule definition'+    ruleFilter _ accumulator _ = pure accumulator +runRule :: Applicative f => Seq Error -> Maybe Error -> f (Seq Error)+runRule accumulator (Just error') = pure $ accumulator |> error'+runRule accumulator Nothing = pure accumulator+ executableDefinition :: forall m. ExecutableDefinition -> ValidateT m executableDefinition (DefinitionOperation definition') =     operationDefinition definition'@@ -88,10 +65,17 @@     fragmentDefinition definition'  operationDefinition :: forall m. OperationDefinition -> ValidateT m-operationDefinition (SelectionSet _operation) =-    pure Seq.empty-operationDefinition (OperationDefinition _type _name _variables _directives _selection) =-    pure Seq.empty+operationDefinition operation =+    asks rules >>= foldM ruleFilter Seq.empty+  where+    ruleFilter accumulator (OperationDefinitionRule rule) =+        mapReaderT (runRule accumulator) $ rule operation+    ruleFilter accumulator _ = pure accumulator  fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m-fragmentDefinition _fragment = pure Seq.empty+fragmentDefinition fragment =+    asks rules >>= foldM ruleFilter Seq.empty+  where+    ruleFilter accumulator (FragmentDefinitionRule rule) =+        mapReaderT (runRule accumulator) $ rule fragment+    ruleFilter accumulator _ = pure accumulator

@@ -2,30 +2,214 @@    v. 2.0. If a copy of the MPL was not distributed with this file, You can    obtain one at https://mozilla.org/MPL/2.0/. -} +{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+ -- | This module contains default rules defined in the GraphQL specification. module Language.GraphQL.Validate.Rules-    ( Rule(..)-    , executableDefinitionsRule+    ( executableDefinitionsRule+    , loneAnonymousOperationRule+    , singleFieldSubscriptionsRule     , specifiedRules+    , uniqueFragmentNamesRule+    , uniqueOperationNamesRule     ) where +import Control.Monad (foldM)+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.Trans.Reader (asks)+import Control.Monad.Trans.State (evalStateT, gets, modify)+import qualified Data.HashSet as HashSet+import qualified Data.Text as Text import Language.GraphQL.AST.Document---- | 'Rule' assigns a function to each AST node that can be validated. If the--- validation fails, the function should return an error message, or 'Nothing'--- otherwise.-newtype Rule-    = DefinitionRule (Definition -> Maybe String)+import Language.GraphQL.Type.Internal+import qualified Language.GraphQL.Type.Schema as Schema+import Language.GraphQL.Validate.Validation --- | Default reules given in the specification.-specifiedRules :: [Rule]+-- | Default rules given in the specification.+specifiedRules :: forall m. [Rule m] specifiedRules =     [ executableDefinitionsRule+    , singleFieldSubscriptionsRule+    , loneAnonymousOperationRule+    , uniqueOperationNamesRule+    , uniqueFragmentNamesRule     ]  -- | Definition must be OperationDefinition or FragmentDefinition.-executableDefinitionsRule :: Rule-executableDefinitionsRule = DefinitionRule go+executableDefinitionsRule :: forall m. Rule m+executableDefinitionsRule = DefinitionRule $ \case+    ExecutableDefinition _ -> lift Nothing+    TypeSystemDefinition _ location -> pure $ error' location+    TypeSystemExtension _ location -> pure $ error' location   where-    go (ExecutableDefinition _definition _) = Nothing-    go _ = Just "Definition must be OperationDefinition or FragmentDefinition."+    error' location = Error+        { message =+            "Definition must be OperationDefinition or FragmentDefinition."+        , locations = [location]+        , path = []+        }++-- | Subscription operations must have exactly one root field.+singleFieldSubscriptionsRule :: forall m. Rule m+singleFieldSubscriptionsRule = OperationDefinitionRule $ \case+    OperationDefinition Subscription name' _ _ rootFields location -> do+        groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty+        case HashSet.size groupedFieldSet of+            1 -> lift Nothing+            _+                | Just name <- name' -> pure $ Error+                    { message = unwords+                        [ "Subscription"+                        , Text.unpack name+                        , "must select only one top level field."+                        ]+                    , locations = [location]+                    , path = []+                    }+                | otherwise -> pure $ Error+                    { message = errorMessage+                    , locations = [location]+                    , path = []+                    }+    _ -> lift Nothing+  where+    errorMessage =+        "Anonymous Subscription must select only one top level field."+    collectFields selectionSet = foldM forEach HashSet.empty selectionSet+    forEach accumulator (Field alias name _ directives _)+        | any skip directives = pure accumulator+        | Just aliasedName <- alias = pure+            $ HashSet.insert aliasedName accumulator+        | otherwise = pure $ HashSet.insert name accumulator+    forEach accumulator (FragmentSpread fragmentName directives)+        | any skip directives = pure accumulator+        | otherwise = do+            inVisitetFragments <- gets $ HashSet.member fragmentName+            if inVisitetFragments+               then pure accumulator+               else collectFromSpread fragmentName accumulator+    forEach accumulator (InlineFragment typeCondition' directives selectionSet)+        | any skip directives = pure accumulator+        | Just typeCondition <- typeCondition' =+            collectFromFragment typeCondition selectionSet accumulator+        | otherwise = HashSet.union accumulator+            <$> collectFields selectionSet+    skip (Directive "skip" [Argument "if" (Boolean True)]) = True+    skip (Directive "include" [Argument "if" (Boolean False)]) = True+    skip _ = False+    findFragmentDefinition (ExecutableDefinition executableDefinition) Nothing+        | DefinitionFragment fragmentDefinition <- executableDefinition =+            Just fragmentDefinition+    findFragmentDefinition _ accumulator = accumulator+    collectFromFragment typeCondition selectionSet accumulator = do+        types' <- lift $ asks types+        schema' <- lift $ asks schema+        case lookupTypeCondition typeCondition types' of+            Nothing -> pure accumulator+            Just compositeType+                | Just objectType <- Schema.subscription schema'+                , True <- doesFragmentTypeApply compositeType objectType ->+                    HashSet.union accumulator<$> collectFields selectionSet+                | otherwise -> pure accumulator+    collectFromSpread fragmentName accumulator = do+        modify $ HashSet.insert fragmentName+        ast' <- lift $ asks ast+        case foldr findFragmentDefinition Nothing ast' of+            Nothing -> pure accumulator+            Just (FragmentDefinition _ typeCondition _ selectionSet _) ->+                collectFromFragment typeCondition selectionSet accumulator++-- | GraphQL allows a short‐hand form for defining query operations when only+-- that one operation exists in the document.+loneAnonymousOperationRule :: forall m. Rule m+loneAnonymousOperationRule = OperationDefinitionRule $ \case+      SelectionSet _ thisLocation -> check thisLocation+      OperationDefinition _ Nothing _ _ _ thisLocation -> check thisLocation+      _ -> lift Nothing+    where+      check thisLocation = asks ast+          >>= lift . foldr (filterAnonymousOperations thisLocation) Nothing+      filterAnonymousOperations thisLocation definition Nothing+          | (viewOperation -> Just operationDefinition) <- definition =+              compareAnonymousOperations thisLocation operationDefinition+      filterAnonymousOperations _ _ accumulator = accumulator+      compareAnonymousOperations thisLocation = \case+          OperationDefinition _ _ _ _ _ thatLocation+              | thisLocation /= thatLocation -> pure $ error' thisLocation+          SelectionSet _ thatLocation+              | thisLocation /= thatLocation -> pure $ error' thisLocation+          _ -> Nothing+      error' location = Error+          { message =+              "This anonymous operation must be the only defined operation."+          , locations = [location]+          , path = []+          }++-- | Each named operation definition must be unique within a document when+-- referred to by its name.+uniqueOperationNamesRule :: forall m. Rule m+uniqueOperationNamesRule = OperationDefinitionRule $ \case+    OperationDefinition _ (Just thisName) _ _ _ thisLocation ->+        findDuplicates (filterByName thisName) thisLocation (error' thisName)+    _ -> lift Nothing+  where+    error' operationName = concat+        [ "There can be only one operation named \""+        , Text.unpack operationName+        , "\"."+        ]+    filterByName thisName definition' accumulator+        | (viewOperation -> Just operationDefinition) <- definition'+        , OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition+        , thisName == thatName = thatLocation : accumulator+        | otherwise = accumulator++findDuplicates :: (Definition -> [Location] -> [Location])+    -> Location+    -> String+    -> RuleT m+findDuplicates filterByName thisLocation errorMessage = do+    ast' <- asks ast+    let locations' = foldr filterByName [] ast'+    if length locations' > 1 && head locations' == thisLocation+        then pure $ error' locations'+        else lift Nothing+  where+    error' locations' = Error +        { message = errorMessage+        , locations = locations'+        , path = []+        }++viewOperation :: Definition -> Maybe OperationDefinition+viewOperation definition+    | ExecutableDefinition executableDefinition <- definition+    , DefinitionOperation operationDefinition <- executableDefinition =+        Just operationDefinition+viewOperation _ = Nothing++-- | Fragment definitions are referenced in fragment spreads by name. To avoid+-- ambiguity, each fragment’s name must be unique within a document.+--+-- Inline fragments are not considered fragment definitions, and are unaffected+-- by this validation rule.+uniqueFragmentNamesRule :: forall m. Rule m+uniqueFragmentNamesRule = FragmentDefinitionRule $ \case+    FragmentDefinition thisName _ _ _ thisLocation ->+        findDuplicates (filterByName thisName) thisLocation (error' thisName)+  where+    error' fragmentName = concat+        [ "There can be only one fragment named \""+        , Text.unpack fragmentName+        , "\"."+        ]+    filterByName thisName definition accumulator+        | ExecutableDefinition executableDefinition <- definition+        , DefinitionFragment fragmentDefinition <- executableDefinition+        , FragmentDefinition thatName _ _ _ thatLocation <- fragmentDefinition+        , thisName == thatName = thatLocation : accumulator+        | otherwise = accumulator

@@ -0,0 +1,54 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}++-- | Definitions used by the validation rules and the validator itself.+module Language.GraphQL.Validate.Validation+    ( Error(..)+    , Path(..)+    , Rule(..)+    , RuleT+    , Validation(..)+    ) where++import Control.Monad.Trans.Reader (ReaderT(..))+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import Language.GraphQL.AST.Document+import Language.GraphQL.Type.Schema (Schema)+import qualified Language.GraphQL.Type.Schema as Schema++-- | If an error can be associated to a particular field in the GraphQL result,+-- it must contain an entry with the key path that details the path of the+-- response field which experienced the error. This allows clients to identify+-- whether a null result is intentional or caused by a runtime error.+data Path+    = Segment Text -- ^ Field name.+    | Index Int -- ^ List index if a field returned a list.+    deriving (Eq, Show)++-- | Validation error.+data Error = Error+    { message :: String+    , locations :: [Location]+    , path :: [Path]+    } deriving (Eq, Show)++-- | Validation rule context.+data Validation m = Validation+    { ast :: Document+    , schema :: Schema m+    , types :: HashMap Name (Schema.Type m)+    , rules :: [Rule m]+    }++-- | 'Rule' assigns a function to each AST node that can be validated. If the+-- validation fails, the function should return an error message, or 'Nothing'+-- otherwise.+data Rule m+    = DefinitionRule (Definition -> RuleT m)+    | OperationDefinitionRule (OperationDefinition -> RuleT m)+    | FragmentDefinitionRule (FragmentDefinition -> RuleT m)++-- | Monad transformer used by the rules.+type RuleT m = ReaderT (Validation m) Maybe Error

@@ -11,6 +11,7 @@     , shouldResolveTo     ) where +import Control.Monad.Catch (MonadCatch) import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap import Data.Text (Text)@@ -18,8 +19,8 @@ import Test.Hspec.Expectations (Expectation, expectationFailure, shouldBe, shouldNotSatisfy)  -- | Asserts that a query resolves to some value.-shouldResolveTo-    :: Either (ResponseEventStream IO Aeson.Value) Aeson.Object+shouldResolveTo :: MonadCatch m+    => Either (ResponseEventStream m Aeson.Value) Aeson.Object     -> Aeson.Object     -> Expectation shouldResolveTo (Right actual) expected = actual `shouldBe` expected@@ -27,8 +28,8 @@     "the query is expected to resolve to a value, but it resolved to an event stream"  -- | Asserts that the response doesn't contain any errors.-shouldResolve-    :: (Text -> IO (Either (ResponseEventStream IO Aeson.Value) Aeson.Object))+shouldResolve :: MonadCatch m+    => (Text -> IO (Either (ResponseEventStream m Aeson.Value) Aeson.Object))     -> Text     -> Expectation shouldResolve executor query = do

@@ -123,7 +123,9 @@         it "indents block strings in arguments" $             let arguments = [Argument "message" (String "line1\nline2")]                 field = Field Nothing "field" arguments [] []-                operation = DefinitionOperation $ SelectionSet $ pure field+                operation = DefinitionOperation+                    $ SelectionSet (pure field)+                    $ Location 0 0              in definition pretty operation `shouldBe` [r|{   field(message: """     line1

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ {-# LANGUAGE OverloadedStrings #-} module Language.GraphQL.ErrorSpec     ( spec

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ {-# LANGUAGE OverloadedStrings #-} module Language.GraphQL.Execute.CoerceSpec     ( spec

@@ -1,3 +1,7 @@+{- This Source Code Form is subject to the terms of the Mozilla Public License,+   v. 2.0. If a copy of the MPL was not distributed with this file, You can+   obtain one at https://mozilla.org/MPL/2.0/. -}+ {-# LANGUAGE OverloadedStrings #-} module Language.GraphQL.Type.OutSpec     ( spec

@@ -148,7 +148,7 @@  spec :: Spec spec =-    describe "document" $+    describe "document" $ do         it "rejects type definitions" $             let queryString = [r|               query getDogName {@@ -166,6 +166,118 @@                     { message =                         "Definition must be OperationDefinition or FragmentDefinition."                     , locations = [AST.Location 9 15]+                    , path = []+                    }+             in validate queryString `shouldBe` Seq.singleton expected++        it "rejects multiple subscription root fields" $+            let queryString = [r|+              subscription sub {+                newMessage {+                  body+                  sender+                }+                disallowedSecondRootField+              }+            |]+                expected = Error+                    { message =+                        "Subscription sub must select only one top level field."+                    , locations = [AST.Location 2 15]+                    , path = []+                    }+             in validate queryString `shouldBe` Seq.singleton expected++        it "rejects multiple subscription root fields coming from a fragment" $+            let queryString = [r|+              subscription sub {+                ...multipleSubscriptions+              }++              fragment multipleSubscriptions on Subscription {+                newMessage {+                  body+                  sender+                }+                disallowedSecondRootField+              }+            |]+                expected = Error+                    { message =+                        "Subscription sub must select only one top level field."+                    , locations = [AST.Location 2 15]+                    , path = []+                    }+             in validate queryString `shouldBe` Seq.singleton expected++        it "rejects multiple anonymous operations" $+            let queryString = [r|+              {+                dog {+                  name+                }+              }++              query getName {+                dog {+                  owner {+                    name+                  }+                }+              }+            |]+                expected = Error+                    { message =+                        "This anonymous operation must be the only defined operation."+                    , locations = [AST.Location 2 15]+                    , path = []+                    }+             in validate queryString `shouldBe` Seq.singleton expected++        it "rejects operations with the same name" $+            let queryString = [r|+              query dogOperation {+                dog {+                  name+                }+              }++              mutation dogOperation {+                mutateDog {+                  id+                }+            }+            |]+                expected = Error+                    { message =+                        "There can be only one operation named \"dogOperation\"."+                    , locations = [AST.Location 2 15, AST.Location 8 15]+                    , path = []+                    }+             in validate queryString `shouldBe` Seq.singleton expected++        it "rejects fragments with the same name" $+            let queryString = [r|+              {+                dog {+                  ...fragmentOne+                }+              }++              fragment fragmentOne on Dog {+                name+              }++              fragment fragmentOne on Dog {+                owner {+                  name+                }+              }+            |]+                expected = Error+                    { message =+                        "There can be only one fragment named \"fragmentOne\"."+                    , locations = [AST.Location 8 15, AST.Location 12 15]                     , path = []                     }              in validate queryString `shouldBe` Seq.singleton expected

@@ -1,69 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-module Test.KitchenSinkSpec-    ( spec-    ) where--import qualified Data.Text.IO as Text.IO-import qualified Data.Text.Lazy.IO as Text.Lazy.IO-import qualified Data.Text.Lazy as Lazy (Text)-import qualified Language.GraphQL.AST.Encoder as Encoder-import qualified Language.GraphQL.AST.Parser as Parser-import Paths_graphql (getDataFileName)-import Test.Hspec (Spec, describe, it)-import Test.Hspec.Megaparsec (parseSatisfies)-import Text.Megaparsec (parse)-import Text.RawString.QQ (r)--spec :: Spec-spec = describe "Kitchen Sink" $ do-    it "minifies the query" $ do-        dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"-        minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql"-        expected <- Text.Lazy.IO.readFile minFileName--        shouldNormalize Encoder.minified dataFileName expected--    it "pretty prints the query" $ do-        dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql"-        let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) {-  whoever123is: node(id: [123, 456]) {-    id-    ... on User @defer {-      field2 {-        id-        alias: field1(first: 10, after: $foo) @include(if: $foo) {-          id-          ...frag-        }-      }-    }-  }-}--mutation likeStory {-  like(story: 123) @defer {-    story {-      id-    }-  }-}--fragment frag on Friend {-  foo(size: $size, bar: $b, obj: {key: "value"})-}--{-  unnamed(truthy: true, falsey: false)-  query-}-|]--        shouldNormalize Encoder.pretty dataFileName expected--shouldNormalize :: Encoder.Formatter -> FilePath -> Lazy.Text -> IO ()-shouldNormalize formatter dataFileName expected = do-    actual <- Text.IO.readFile dataFileName-    parse Parser.document dataFileName actual `parseSatisfies` condition-      where-        condition = (expected ==) . Encoder.document formatter

@@ -1,38 +0,0 @@-# Copyright (c) 2015, Facebook, Inc.-# All rights reserved.-#-# This source code is licensed under the BSD-style license found in the-# LICENSE file in the root directory of this source tree. An additional grant-# of patent rights can be found in the PATENTS file in the same directory.--query queryName($foo: ComplexType, $site: Site = MOBILE) {-  whoever123is: node(id: [123, 456]) {-    id, # Inline test comment-    ... on User @defer {-      field2 {-        id,-        alias: field1(first: 10, after: $foo) @include(if: $foo) {-          id,-          ...frag-        }-      }-    }-  }-}--mutation likeStory {-  like(story: 123) @defer {-    story {-      id-    }-  }-}--fragment frag on Friend {-  foo(size: $size, bar: $b, obj: {key: "value"})-}--{-  unnamed(truthy: true, falsey: false),-  query-}

@@ -1,1 +0,0 @@-query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}