graphql 1.0.3.0 → 1.1.0.0

raw patch · 12 files changed

+194/−146 lines, 12 filesdep ~hspec-expectationsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hspec-expectations

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−2
• graphql.cabal +5/−4
• src/Language/GraphQL.hs +24/−0
• src/Language/GraphQL/AST/Encoder.hs +9/−2
• src/Language/GraphQL/AST/Lexer.hs +4/−3
• src/Language/GraphQL/Error.hs +4/−36
• src/Language/GraphQL/Execute/Coerce.hs +5/−0
• src/Language/GraphQL/Validate/Rules.hs +3/−3
• src/Test/Hspec/GraphQL.hs +2/−2
• tests/Language/GraphQL/AST/EncoderSpec.hs +5/−0
• tests/Language/GraphQL/ExecuteSpec.hs +113/−90
• tests/Schemas/HeroSchema.hs +4/−4

@@ -6,6 +6,19 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.1.0.0] - 2022-12-24+### Changed+- Removed deprecated `Language.GraphQL.Error` functions: `addErr`, `addErrMsg`,+  `singleError`.+- Deprecate `Resolution`, `CollectErrsT` and `runCollectErrs` in the `Error`+  module. It was already noted in the documentation that these symbols are+  deprecated, now a pragma is added.+- `Language.GraphQL`: Added information about the *json* flag and switching to+  *graphql-spice* for JSON support.++### Added+- Partial schema printing: operation type encoder.+ ## [1.0.3.0] - 2022-03-27 ### Fixed - Index position in error path. (Index and Segment paths of a field have been@@ -477,8 +490,9 @@ ### Added - Data types for the GraphQL language. -[1.0.3.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.3.0&rev_to=v1.0.2.0-[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=1.0.2.0&rev_to=v1.0.1.0+[1.1.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.1.0.0&rev_to=v1.0.3.0+[1.0.3.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.3.0&rev_to=v1.0.2.0+[1.0.2.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.2.0&rev_to=v1.0.1.0 [1.0.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.1.0&rev_to=v1.0.0.0 [1.0.0.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v1.0.0.0&rev_to=v0.11.1.0 [0.11.1.0]: https://www.caraus.tech/projects/pub-graphql/repository/23/diff?rev=v0.11.1.0&rev_to=v0.11.0.0

@@ -1,7 +1,7 @@ cabal-version: 2.4  name:           graphql-version:        1.0.3.0+version:        1.1.0.0 synopsis:       Haskell GraphQL implementation description:    Haskell <https://spec.graphql.org/June2018/ GraphQL> implementation. category:       Language@@ -11,7 +11,7 @@                 Matthías Páll Gissurarson <mpg@mpg.is>,                 Sólrún Halla Einarsdóttir <she@mpg.is> maintainer:     belka@caraus.de-copyright:      (c) 2019-2021 Eugen Wissner,+copyright:      (c) 2019-2022 Eugen Wissner,                 (c) 2015-2017 J. Daniel Navarro license:        MPL-2.0 AND BSD-3-Clause license-files:  LICENSE,@@ -22,7 +22,7 @@   README.md tested-with:   GHC == 8.10.7,-  GHC == 9.2.2+  GHC == 9.2.4  source-repository head   type: git@@ -30,7 +30,7 @@  flag Json   description: Whether to build against @aeson 1.x@-  default: True+  default: False   manual: True  library@@ -111,6 +111,7 @@     exceptions,     graphql,     hspec ^>= 2.9.1,+    hspec-expectations ^>= 0.8.2,     hspec-megaparsec ^>= 2.2.0,     megaparsec,     text,

@@ -4,6 +4,28 @@  #ifdef WITH_JSON -- | This module provides the functions to parse and execute @GraphQL@ queries.+--+-- The content of this module depends on the value of the __json__ flag, which+-- is currently on by default. This behavior will change in the future, the flag+-- will be switched off by default and then removed.+--+-- This documentation is generated with the enabled __json__ flag and functions+-- described here support JSON and are deprecated. JSON instances are provided+-- now by an additional package, __graphql-spice__. To start using the new+-- package create __cabal.project__ in the root directory of your project with+-- the following contents:+--+-- @+-- packages: .+-- constraints: graphql -json+-- @+--+-- Then add __graphql-spice__ as dependency.+--+-- The new version of this module defines only one function, @graphql@, which+-- works with the internal GraphQL value representation used by this lbirary.+-- Refer to @Language.GraphQL.JSON.graphql@ in __graphql-spice__ for the+-- function that accepts and returns JSON. module Language.GraphQL     ( graphql     , graphqlSubs@@ -23,6 +45,7 @@ import Language.GraphQL.Type.Schema (Schema) import Text.Megaparsec (parse) +{-# DEPRECATED graphql "Use graphql-spice package instead" #-} -- | If the text parses correctly as a @GraphQL@ query the query is -- executed using the given 'Schema'. graphql :: MonadCatch m@@ -31,6 +54,7 @@     -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response. graphql schema = graphqlSubs schema mempty mempty +{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-} -- | If the text parses correctly as a @GraphQL@ query the substitution is -- applied to the query and the query is then executed using to the given -- 'Schema'.

@@ -11,6 +11,7 @@     , directive     , document     , minified+    , operationType     , pretty     , type'     , value@@ -34,7 +35,7 @@ --   Use 'pretty' or 'minified' to construct the formatter. data Formatter     = Minified-    | Pretty Word+    | Pretty !Word  -- | Constructs a formatter for pretty printing. pretty :: Formatter@@ -101,7 +102,7 @@      in variable variableName     <> eitherFormat formatter ": " ":"     <> type' variableType-    <> maybe mempty (defaultValue formatter) (Full.node <$> defaultValue')+    <> maybe mempty (defaultValue formatter . Full.node) defaultValue'  defaultValue :: Formatter -> Full.ConstValue -> Lazy.Text defaultValue formatter val@@ -293,6 +294,12 @@ nonNullType :: Full.NonNullType -> Lazy.Text nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!" nonNullType (Full.NonNullTypeList x) = listType x <> "!"++-- | Produces lowercase operation type: query, mutation or subscription.+operationType :: Formatter -> Full.OperationType -> Lazy.Text+operationType _formatter Full.Query = "query"+operationType _formatter Full.Mutation = "mutation"+operationType _formatter Full.Subscription = "subscription"  -- * Internal 

@@ -58,6 +58,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import Control.Monad (void)  -- | Standard parser. -- Accepts the type of the parsed token.@@ -93,7 +94,7 @@  -- | Parser for "@". at :: Parser ()-at = symbol "@" >> pure ()+at = void $ symbol "@"  -- | Parser for "&". amp :: Parser T.Text@@ -101,7 +102,7 @@  -- | Parser for ":". colon :: Parser ()-colon = symbol ":" >> pure ()+colon = void $ symbol ":"  -- | Parser for "=". equals :: Parser T.Text@@ -220,7 +221,7 @@  -- | Parser for the "Byte Order Mark". unicodeBOM :: Parser ()-unicodeBOM = optional (char '\xfeff') >> pure ()+unicodeBOM = void $ optional $ char '\xfeff'  -- | Parses "extend" followed by a 'symbol'. It is used by schema extensions. extend :: forall a. Text -> String -> NonEmpty (Parser a) -> Parser a

@@ -15,16 +15,13 @@     , ResolverException(..)     , Response(..)     , ResponseEventStream-    , addErr-    , addErrMsg     , parseError     , runCollectErrs-    , singleError     ) where  import Conduit import Control.Exception (Exception(..))-import Control.Monad.Trans.State (StateT, modify, runStateT)+import Control.Monad.Trans.State (StateT, runStateT) import Data.HashMap.Strict (HashMap) import Data.Sequence (Seq(..), (|>)) import qualified Data.Sequence as Seq@@ -103,11 +100,9 @@  -- * 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 was part of the old executor and isn't used anymore, it will--- be deprecated in the future and removed./ runCollectErrs :: (Monad m, Serialize a)     => HashMap Name (Schema.Type m)     -> CollectErrsT m a@@ -117,40 +112,13 @@         $ 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.------ /Resolution was part of the old executor and isn't used anymore, it will be--- deprecated in the future and removed./ 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.------ /CollectErrsT was part of the old executor and isn't used anymore, it will be--- deprecated in the future and removed./ type CollectErrsT m = StateT (Resolution m) m---- | Adds an error to the list of errors.-{-# DEPRECATED #-}-addErr :: Monad m => Error -> CollectErrsT m ()-addErr v = modify appender-  where-    appender :: Monad m => Resolution m -> Resolution m-    appender resolution@Resolution{..} = resolution{ errors = errors |> v }--{-# DEPRECATED #-}-makeErrorMessage :: Text -> Error-makeErrorMessage s = Error s [] []---- | Constructs a response object containing only the error with the given--- message.-{-# DEPRECATED #-}-singleError :: Serialize a => Text -> Response a-singleError message = Response null $ Seq.singleton $ Error message [] []---- | Convenience function for just wrapping an error message.-{-# DEPRECATED #-}-addErrMsg :: (Monad m, Serialize a) => Text -> CollectErrsT m a-addErrMsg errorMessage = (addErr . makeErrorMessage) errorMessage >> pure null

@@ -8,6 +8,11 @@ {-# LANGUAGE CPP #-}  -- | Types and functions used for input and result coercion.+--+-- JSON instances in this module are only available with the __json__+-- flag that is currently on by default, but will be disabled in the future.+-- Refer to the documentation in the 'Language.GraphQL' module and to+-- the __graphql-spice__ package. module Language.GraphQL.Execute.Coerce     ( Output(..)     , Serialize(..)

@@ -54,7 +54,7 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.List (groupBy, sortBy, sortOn)-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord (comparing) import Data.Sequence (Seq(..), (|>))@@ -1551,9 +1551,9 @@     toConst Full.Null = Just Full.ConstNull     toConst (Full.Enum enum) = Just $ Full.ConstEnum enum     toConst (Full.List values) =-        Just $ Full.ConstList $ catMaybes $ toConstNode <$> values+        Just $ Full.ConstList $ mapMaybe toConstNode values     toConst (Full.Object fields) = Just $ Full.ConstObject-        $ catMaybes $ constObjectField <$> fields+        $ mapMaybe constObjectField fields     constObjectField Full.ObjectField{..}         | Just constValue <- toConstNode value =             Just $ Full.ObjectField name constValue location

@@ -9,7 +9,7 @@ {-# LANGUAGE OverloadedStrings #-}  -- | Test helpers.-module Test.Hspec.GraphQL+module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}     ( shouldResolve     , shouldResolveTo     ) where@@ -43,7 +43,7 @@         _ -> expectationFailure             "the query is expected to resolve to a value, but it resolved to an event stream" #else-module Test.Hspec.GraphQL+module Test.Hspec.GraphQL {-# DEPRECATED "Use graphql-spice package instead" #-}     (     ) where #endif

@@ -173,3 +173,8 @@                 |] '\n'                 actual = definition pretty operation              in actual `shouldBe` expected++    describe "operationType" $+        it "produces lowercase mutation operation type" $+            let actual = operationType pretty Full.Mutation+             in actual `shouldBe` "mutation"

@@ -2,6 +2,10 @@    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 DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -9,7 +13,7 @@     ( spec     ) where -import Control.Exception (Exception(..), SomeException)+import Control.Exception (Exception(..)) import Control.Monad.Catch (throwM) import Data.Conduit import Data.HashMap.Strict (HashMap)@@ -27,11 +31,17 @@ import qualified Language.GraphQL.Type.Out as Out import Prelude hiding (id) import Test.Hspec (Spec, context, describe, it, shouldBe)-import Text.Megaparsec (parse)+import Text.Megaparsec (parse, errorBundlePretty) import Schemas.HeroSchema (heroSchema) import Data.Maybe (fromJust) import qualified Data.Sequence as Seq+import Data.Text (Text) import qualified Data.Text as Text+import Test.Hspec.Expectations+    ( Expectation+    , expectationFailure+    )+import Data.Either (fromRight)  data PhilosopherException = PhilosopherException     deriving Show@@ -42,7 +52,7 @@         ResolverException resolverException <- fromException e         cast resolverException -philosopherSchema :: Schema (Either SomeException)+philosopherSchema :: Schema IO philosopherSchema =     schemaWithTypes Nothing queryType Nothing subscriptionRoot extraTypes mempty   where@@ -52,7 +62,7 @@         , Schema.ObjectType bookCollectionType         ] -queryType :: Out.ObjectType (Either SomeException)+queryType :: Out.ObjectType IO queryType = Out.ObjectType "Query" Nothing []     $ HashMap.fromList     [ ("philosopher", ValueResolver philosopherField philosopherResolver)@@ -68,14 +78,14 @@     genresField =         let fieldType = Out.ListType $ Out.NonNullScalarType string          in Out.Field Nothing fieldType HashMap.empty-    genresResolver :: Resolve (Either SomeException)+    genresResolver :: Resolve IO     genresResolver = throwM PhilosopherException     countField =         let fieldType = Out.NonNullScalarType int          in Out.Field Nothing fieldType HashMap.empty     countResolver = pure "" -musicType :: Out.ObjectType (Either SomeException)+musicType :: Out.ObjectType IO musicType = Out.ObjectType "Music" Nothing []     $ HashMap.fromList resolvers   where@@ -85,7 +95,7 @@     instrumentResolver = pure $ String "piano"     instrumentField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty -poetryType :: Out.ObjectType (Either SomeException)+poetryType :: Out.ObjectType IO poetryType = Out.ObjectType "Poetry" Nothing []     $ HashMap.fromList resolvers   where@@ -95,10 +105,10 @@     genreResolver = pure $ String "Futurism"     genreField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty -interestType :: Out.UnionType (Either SomeException)+interestType :: Out.UnionType IO interestType = Out.UnionType "Interest" Nothing [musicType, poetryType] -philosopherType :: Out.ObjectType (Either SomeException)+philosopherType :: Out.ObjectType IO philosopherType = Out.ObjectType "Philosopher" Nothing []     $ HashMap.fromList resolvers   where@@ -139,14 +149,14 @@         = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty     firstLanguageResolver = pure Null -workType :: Out.InterfaceType (Either SomeException)+workType :: Out.InterfaceType IO workType = Out.InterfaceType "Work" Nothing []     $ HashMap.fromList fields   where     fields = [("title", titleField)]     titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty -bookType :: Out.ObjectType (Either SomeException)+bookType :: Out.ObjectType IO bookType = Out.ObjectType "Book" Nothing [workType]     $ HashMap.fromList resolvers   where@@ -156,7 +166,7 @@     titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty     titleResolver = pure "Also sprach Zarathustra: Ein Buch für Alle und Keinen" -bookCollectionType :: Out.ObjectType (Either SomeException)+bookCollectionType :: Out.ObjectType IO bookCollectionType = Out.ObjectType "Book" Nothing [workType]     $ HashMap.fromList resolvers   where@@ -166,7 +176,7 @@     titleField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty     titleResolver = pure "The Three Critiques" -subscriptionType :: Out.ObjectType (Either SomeException)+subscriptionType :: Out.ObjectType IO subscriptionType = Out.ObjectType "Subscription" Nothing []     $ HashMap.singleton "newQuote"     $ EventStreamResolver quoteField (pure $ Object mempty)@@ -175,7 +185,7 @@     quoteField =         Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty -quoteType :: Out.ObjectType (Either SomeException)+quoteType :: Out.ObjectType IO quoteType = Out.ObjectType "Quote" Nothing []     $ HashMap.singleton "quote"     $ ValueResolver quoteField@@ -192,13 +202,49 @@     ]  type EitherStreamOrValue = Either-    (ResponseEventStream (Either SomeException) Type.Value)+    (ResponseEventStream IO Type.Value)     (Response Type.Value) -execute' :: Document -> Either SomeException EitherStreamOrValue-execute' =-    execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)+-- Asserts that a query resolves to a value.+shouldResolveTo :: Text.Text -> Response Type.Value -> Expectation+shouldResolveTo querySource expected =+    case parse document "" querySource of+        (Right parsedDocument) ->+            execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value) parsedDocument >>= go+        (Left errorBundle) -> expectationFailure $ errorBundlePretty errorBundle+  where+    go = \case+        Right result -> shouldBe result expected+        Left _ -> expectationFailure+            "the query is expected to resolve to a value, but it resolved to an event stream" +-- Asserts that the executor produces an error that starts with a string.+shouldContainError :: Either (ResponseEventStream IO Type.Value) (Response Type.Value)+    -> Text+    -> Expectation+shouldContainError streamOrValue expected =+    case streamOrValue of+        Right response -> respond response+        Left _ -> expectationFailure+            "the query is expected to resolve to a value, but it resolved to an event stream"+  where+    startsWith :: Text.Text -> Text.Text -> Bool+    startsWith xs ys = Text.take (Text.length ys) xs == ys+    respond :: Response Type.Value -> Expectation+    respond Response{ errors }+        | any ((`startsWith` expected) . message) errors = pure ()+        | otherwise = expectationFailure+            "the query is expected to execute with errors, but the response doesn't contain any errors"++parseAndExecute :: Schema IO+    -> Maybe Text+    -> HashMap Name Type.Value+    -> Text+    -> IO (Either (ResponseEventStream IO Type.Value) (Response Type.Value))+parseAndExecute schema' operation variables+    = either (pure . parseError) (execute schema' operation variables)+    . parse document ""+ spec :: Spec spec =     describe "execute" $ do@@ -213,9 +259,7 @@               }             |]                 expected = Response (Object mempty) mempty-                Right (Right actual) = either (pure . parseError) execute'-                    $ parse document "" sourceQuery-             in actual `shouldBe` expected+             in sourceQuery `shouldResolveTo` expected          context "Query" $ do             it "skips unknown fields" $@@ -225,9 +269,8 @@                         $ HashMap.singleton "firstName"                         $ String "Friedrich"                     expected = Response data'' mempty-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher { firstName surname } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher { firstName surname } }"+                in sourceQuery `shouldResolveTo` expected             it "merges selections" $                 let data'' = Object                         $ HashMap.singleton "philosopher"@@ -237,9 +280,8 @@                             , ("lastName", String "Nietzsche")                             ]                     expected = Response data'' mempty-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher { firstName } philosopher { lastName } }"+                in sourceQuery `shouldResolveTo` expected              it "errors on invalid output enum values" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -250,9 +292,8 @@                         , path = [Segment "philosopher", Segment "school"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher { school } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher { school } }"+                 in sourceQuery `shouldResolveTo` expected              it "gives location information for non-null unions" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -263,9 +304,8 @@                         , path = [Segment "philosopher", Segment "interest"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher { interest } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher { interest } }"+                 in sourceQuery `shouldResolveTo` expected              it "gives location information for invalid interfaces" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -277,9 +317,8 @@                         , path = [Segment "philosopher", Segment "majorWork"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher { majorWork { title } } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher { majorWork { title } } }"+                 in sourceQuery `shouldResolveTo` expected              it "gives location information for invalid scalar arguments" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -290,9 +329,8 @@                         , path = [Segment "philosopher"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher(id: true) { lastName } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher(id: true) { lastName } }"+                 in sourceQuery `shouldResolveTo` expected              it "gives location information for failed result coercion" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -302,9 +340,8 @@                         , path = [Segment "philosopher", Segment "century"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher(id: \"1\") { century } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher(id: \"1\") { century } }"+                in sourceQuery `shouldResolveTo` expected              it "gives location information for failed result coercion" $                 let data'' = Object $ HashMap.singleton "genres" Null@@ -314,9 +351,8 @@                         , path = [Segment "genres"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ genres }"-                in actual `shouldBe` expected+                    sourceQuery = "{ genres }"+                in sourceQuery `shouldResolveTo` expected              it "sets data to null if a root field isn't nullable" $                 let executionErrors = pure $ Error@@ -325,9 +361,8 @@                         , path = [Segment "count"]                         }                     expected = Response Null executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ count }"-                in actual `shouldBe` expected+                    sourceQuery = "{ count }"+                in sourceQuery `shouldResolveTo` expected              it "detects nullability errors" $                 let data'' = Object $ HashMap.singleton "philosopher" Null@@ -337,35 +372,24 @@                         , path = [Segment "philosopher", Segment "firstLanguage"]                         }                     expected = Response data'' executionErrors-                    Right (Right actual) = either (pure . parseError) execute'-                        $ parse document "" "{ philosopher(id: \"1\") { firstLanguage } }"-                in actual `shouldBe` expected+                    sourceQuery = "{ philosopher(id: \"1\") { firstLanguage } }"+                in sourceQuery `shouldResolveTo` expected              context "queryError" $ do-                let-                  namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"-                  twoQueries = namedQuery "A" <> " " <> namedQuery "B"-                  startsWith :: Text.Text -> Text.Text -> Bool-                  startsWith xs ys = Text.take (Text.length ys) xs == ys+                let namedQuery name = "query " <> name <> " { philosopher(id: \"1\") { interest } }"+                    twoQueries = namedQuery "A" <> " " <> namedQuery "B" -                it "throws operation name is required error" $-                    let expectedErrorMessage :: Text.Text-                        expectedErrorMessage = "Operation name is required"-                        Right (Right (Response _ executionErrors)) = either (pure . parseError) execute' $ parse document "" twoQueries-                        Error msg _ _ = Seq.index executionErrors 0-                     in msg `startsWith` expectedErrorMessage `shouldBe` True+                it "throws operation name is required error" $ do+                    let expectedErrorMessage = "Operation name is required"+                    actual <- parseAndExecute philosopherSchema Nothing mempty twoQueries+                    actual `shouldContainError` expectedErrorMessage -                it "throws operation not found error" $-                    let expectedErrorMessage :: Text.Text-                        expectedErrorMessage = "Operation \"C\" is not found"-                        execute'' :: Document -> Either SomeException EitherStreamOrValue-                        execute'' = execute philosopherSchema (Just "C") (mempty :: HashMap Name Type.Value)-                        Right (Right (Response _ executionErrors)) = either (pure . parseError) execute''-                            $ parse document "" twoQueries-                        Error msg _ _ = Seq.index executionErrors 0-                     in msg `startsWith` expectedErrorMessage `shouldBe` True+                it "throws operation not found error" $ do+                    let expectedErrorMessage = "Operation \"C\" is not found"+                    actual <- parseAndExecute philosopherSchema (Just "C") mempty twoQueries+                    actual `shouldContainError` expectedErrorMessage -                it "throws variable coercion error" $+                it "throws variable coercion error" $ do                     let data'' = Null                         executionErrors = pure $ Error                             { message = "Failed to coerce the variable $id: String."@@ -373,11 +397,10 @@                             , path = []                             }                         expected = Response data'' executionErrors-                        executeWithVars :: Document -> Either SomeException EitherStreamOrValue                         executeWithVars = execute philosopherSchema Nothing (HashMap.singleton "id" (Type.Int 1))-                        Right (Right actual) = either (pure . parseError) executeWithVars-                            $ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }"-                    in actual `shouldBe` expected+                    Right actual <- either (pure . parseError) executeWithVars+                        $ parse document "" "query($id: String) { philosopher(id: \"1\") { firstLanguage } }"+                    actual `shouldBe` expected                  it "throws variable unkown input type error" $                     let data'' = Null@@ -387,31 +410,31 @@                             , path = []                             }                         expected = Response data'' executionErrors-                        Right (Right actual) = either (pure . parseError) execute'-                            $ parse document "" "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"-                    in actual `shouldBe` expected+                        sourceQuery = "query($id: Cat) { philosopher(id: \"1\") { firstLanguage } }"+                     in sourceQuery `shouldResolveTo` expected              context "Error path" $ do-                let executeHero :: Document -> Either SomeException EitherStreamOrValue+                let executeHero :: Document -> IO EitherStreamOrValue                     executeHero = execute heroSchema Nothing (HashMap.empty :: HashMap Name Type.Value) -                it "at the beggining of the list" $-                    let Right (Right actual) = either (pure . parseError) executeHero-                            $ parse document "" "{ hero(id: \"1\") { friends { name } } }"-                        Response _ errors' = actual+                it "at the beggining of the list" $ do+                    Right actual <- either (pure . parseError) executeHero+                        $ parse document "" "{ hero(id: \"1\") { friends { name } } }"+                    let Response _ errors' = actual                         Error _ _ path' = fromJust $ Seq.lookup 0 errors'                         expected = [Segment "hero", Segment "friends", Index 0, Segment "name"]-                    in path' `shouldBe` expected+                     in path' `shouldBe` expected          context "Subscription" $-            it "subscribes" $+            it "subscribes" $ do                 let data'' = Object                         $ HashMap.singleton "newQuote"                         $ Object                         $ HashMap.singleton "quote"                         $ String "Naturam expelles furca, tamen usque recurret."                     expected = Response data'' mempty-                    Right (Left stream) = either (pure . parseError) execute'-                        $ parse document "" "subscription { newQuote { quote } }"-                    Right (Just actual) = runConduit $ stream .| await-                in actual `shouldBe` expected+                Left stream <- execute philosopherSchema Nothing (mempty :: HashMap Name Type.Value)+                    $ fromRight (error "Parse error")+                    $ parse document "" "subscription { newQuote { quote } }"+                Just actual <- runConduit $ stream .| await+                actual `shouldBe` expected

@@ -6,7 +6,7 @@  module Schemas.HeroSchema (heroSchema) where -import Control.Exception (Exception(..), SomeException)+import Control.Exception (Exception(..)) import Control.Monad.Catch (throwM) import Language.GraphQL.Error (ResolverException (..)) import qualified Language.GraphQL.Type.In as In@@ -25,11 +25,11 @@         ResolverException resolverException <- fromException e         cast resolverException -heroSchema :: Type.Schema (Either SomeException)+heroSchema :: Type.Schema IO heroSchema =     schemaWithTypes Nothing queryType Nothing Nothing [] mempty -type ObjectType = Out.ObjectType (Either SomeException)+type ObjectType = Out.ObjectType IO  queryType :: ObjectType queryType = Out.ObjectType "Query" Nothing []@@ -42,7 +42,7 @@         $ In.Argument Nothing (In.NamedScalarType Type.id) Nothing     heroResolver = pure $ Type.Object mempty -stringField :: Out.Field (Either SomeException)+stringField :: Out.Field IO stringField = Out.Field Nothing (Out.NonNullScalarType Type.string) HashMap.empty  heroType :: ObjectType