graphql/tests/Language/GraphQL/ExecuteSpec.hs

76 lines
2.8 KiB
Haskell
Raw Normal View History

2020-06-10 11:42:00 +02:00
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.ExecuteSpec
( spec
) where
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Functor.Identity (Identity(..))
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
2020-06-13 07:20:19 +02:00
import Language.GraphQL.Type as Type
2020-06-10 11:42:00 +02:00
import Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.Megaparsec (parse)
schema :: Schema Identity
schema = Schema {query = queryType, mutation = Nothing}
queryType :: Out.ObjectType Identity
queryType = Out.ObjectType "Query" Nothing []
2020-06-12 07:58:08 +02:00
$ HashMap.singleton "philosopher"
$ Out.Resolver philosopherField
2020-06-10 11:42:00 +02:00
$ pure
2020-06-13 07:20:19 +02:00
$ Type.Object mempty
2020-06-10 11:42:00 +02:00
where
2020-06-12 07:58:08 +02:00
philosopherField =
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
philosopherType :: Out.ObjectType Identity
philosopherType = Out.ObjectType "Philosopher" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
[ ("firstName", firstNameResolver)
, ("lastName", lastNameResolver)
]
2020-06-13 07:20:19 +02:00
firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich"
lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche"
2020-06-12 07:58:08 +02:00
firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
2020-06-10 11:42:00 +02:00
spec :: Spec
spec =
2020-06-12 07:58:08 +02:00
describe "execute" $ do
2020-06-10 11:42:00 +02:00
it "skips unknown fields" $
let expected = Aeson.object
2020-06-12 07:58:08 +02:00
[ "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
[ "philosopher" .= Aeson.object
[ "firstName" .= ("Friedrich" :: String)
, "lastName" .= ("Nietzsche" :: String)
]
]
]
2020-06-10 11:42:00 +02:00
execute' = execute schema (mempty :: HashMap Name Aeson.Value)
actual = runIdentity
$ either parseError execute'
2020-06-12 07:58:08 +02:00
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
2020-06-10 11:42:00 +02:00
in actual `shouldBe` expected