forked from OSS/graphql
Eugen Wissner
09135c581a
Let's try MonadThrow/MonadCatch. It looks nice at a first glance. The monad transformer stack contains only the ReaderT, less lifts are required. Exception subtyping is easier, the user can (and should) define custom error types and throw them. And it is still possible to use pure error handling, if someone doesn't like runtime exceptions or need to run a query in a pure environment. Fixes #42.
114 lines
4.6 KiB
Haskell
114 lines
4.6 KiB
Haskell
{- 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.Conduit
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Language.GraphQL.AST (Name)
|
|
import Language.GraphQL.AST.Parser (document)
|
|
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, context, describe, it, shouldBe)
|
|
import Text.Megaparsec (parse)
|
|
|
|
schema :: Schema (Either SomeException)
|
|
schema = Schema
|
|
{ query = queryType
|
|
, mutation = Nothing
|
|
, subscription = Just subscriptionType
|
|
}
|
|
|
|
queryType :: Out.ObjectType (Either SomeException)
|
|
queryType = Out.ObjectType "Query" Nothing []
|
|
$ HashMap.singleton "philosopher"
|
|
$ ValueResolver philosopherField
|
|
$ pure $ Type.Object mempty
|
|
where
|
|
philosopherField =
|
|
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
|
|
|
|
philosopherType :: Out.ObjectType (Either SomeException)
|
|
philosopherType = Out.ObjectType "Philosopher" Nothing []
|
|
$ HashMap.fromList resolvers
|
|
where
|
|
resolvers =
|
|
[ ("firstName", ValueResolver firstNameField firstNameResolver)
|
|
, ("lastName", ValueResolver lastNameField lastNameResolver)
|
|
]
|
|
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
|
|
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)
|
|
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)
|
|
]
|
|
]
|
|
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
|