Respect subscriptions in the executor

After the last commit there were a few places needed to be adjusted to
support subscriptions. This is done and a test case is added.

It is important to implement subscriptions now, because they require
changes to the library API, and they are a big missing part to finish
the executor. When the executor is finished, we can start to provide
more stable API without breaking everything every release. Validation
and introspection shouldn't require much changes to the API; AST would
require some changes to report good errors after the validation - this
is one thing I can think of.

Fixes #5.
This commit is contained in:
2020-07-15 19:15:31 +02:00
parent ae2210f659
commit e24386402b
9 changed files with 132 additions and 81 deletions

View File

@ -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.ExecuteSpec
( spec
@ -5,6 +9,7 @@ module Language.GraphQL.ExecuteSpec
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Conduit
import Data.Either (fromRight)
import Data.Functor.Identity (Identity(..))
import Data.HashMap.Strict (HashMap)
@ -15,11 +20,15 @@ import Language.GraphQL.Error
import Language.GraphQL.Execute
import Language.GraphQL.Type as Type
import Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
schema :: Schema Identity
schema = Schema {query = queryType, mutation = Nothing}
schema = Schema
{ query = queryType
, mutation = Nothing
, subscription = Just subscriptionType
}
queryType :: Out.ObjectType Identity
queryType = Out.ObjectType "Query" Nothing []
@ -45,33 +54,66 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
lastNameResolver = pure $ Type.String "Nietzsche"
subscriptionType :: Out.ObjectType Identity
subscriptionType = Out.ObjectType "Subscription" Nothing []
$ HashMap.singleton "newQuote"
$ EventStreamResolver quoteField (pure $ Type.Object mempty)
$ pure $ yield $ Type.Object mempty
where
quoteField =
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
quoteType :: Out.ObjectType Identity
quoteType = Out.ObjectType "Quote" Nothing []
$ HashMap.singleton "quote"
$ ValueResolver quoteField
$ pure "Naturam expelles furca, tamen usque recurret."
where
quoteField =
Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
spec :: Spec
spec =
describe "execute" $ do
it "skips unknown fields" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
context "Query" $ do
it "skips unknown fields" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
]
]
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
, "lastName" .= ("Nietzsche" :: String)
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
let data'' = Aeson.object
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
, "lastName" .= ("Nietzsche" :: String)
]
]
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
context "Subscription" $
it "subscribes" $
let data'' = Aeson.object
[ "newQuote" .= Aeson.object
[ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
]
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
Left stream = runIdentity
$ either (pure . parseError) execute'
$ parse document "" "subscription { newQuote { quote } }"
Just actual = runConduitPure $ stream .| await
in actual `shouldBe` expected