diff options
Diffstat (limited to 'tests/Language/GraphQL/ExecuteSpec.hs')
| -rw-r--r-- | tests/Language/GraphQL/ExecuteSpec.hs | 106 |
1 files changed, 72 insertions, 34 deletions
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs index 30568be..8fbb55b 100644 --- a/tests/Language/GraphQL/ExecuteSpec.hs +++ b/tests/Language/GraphQL/ExecuteSpec.hs @@ -1,11 +1,16 @@ +{- 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 ) where +import Control.Exception (SomeException) import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson -import Data.Functor.Identity (Identity(..)) +import Data.Conduit import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Language.GraphQL.AST (Name) @@ -14,62 +19,95 @@ 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 (Either SomeException) +schema = Schema + { query = queryType + , mutation = Nothing + , subscription = Just subscriptionType + } -queryType :: Out.ObjectType Identity +queryType :: Out.ObjectType (Either SomeException) queryType = Out.ObjectType "Query" Nothing [] - $ HashMap.singleton "philosopher" - $ Out.Resolver philosopherField - $ pure - $ Type.Object mempty + $ HashMap.singleton "philosopher" + $ ValueResolver philosopherField + $ pure $ Type.Object mempty where philosopherField = Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty -philosopherType :: Out.ObjectType Identity +philosopherType :: Out.ObjectType (Either SomeException) philosopherType = Out.ObjectType "Philosopher" Nothing [] $ HashMap.fromList resolvers where resolvers = - [ ("firstName", firstNameResolver) - , ("lastName", lastNameResolver) + [ ("firstName", ValueResolver firstNameField firstNameResolver) + , ("lastName", ValueResolver lastNameField lastNameResolver) ] - firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich" - lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche" - firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty - lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty + firstNameField = + Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty + firstNameResolver = pure $ Type.String "Friedrich" + lastNameField + = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty + lastNameResolver = pure $ Type.String "Nietzsche" + +subscriptionType :: Out.ObjectType (Either SomeException) +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 (Either SomeException) +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 expected = Aeson.object - [ "data" .= Aeson.object + context "Query" $ do + it "skips unknown fields" $ + let data'' = Aeson.object [ "philosopher" .= Aeson.object [ "firstName" .= ("Friedrich" :: String) ] ] - ] - execute' = execute schema (mempty :: HashMap Name Aeson.Value) - actual = runIdentity - $ either parseError execute' - $ parse document "" "{ philosopher { firstName surname } }" - in actual `shouldBe` expected - it "merges selections" $ - let expected = Aeson.object - [ "data" .= Aeson.object + expected = Response data'' mempty + execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value) + Right (Right actual) = 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) ] ] - ] - execute' = execute schema (mempty :: HashMap Name Aeson.Value) - actual = runIdentity - $ either 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) + Right (Right actual) = 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) + Right (Left stream) = either (pure . parseError) execute' + $ parse document "" "subscription { newQuote { quote } }" + Right (Just actual) = runConduit $ stream .| await + in actual `shouldBe` expected |