graphql/tests/Test/FragmentSpec.hs
Eugen Wissner e24386402b 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.
2020-07-15 19:15:31 +02:00

243 lines
7.3 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 #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.FragmentSpec
( spec
) where
import Data.Aeson (object, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.Out as Out
import Test.Hspec
( Spec
, describe
, it
, shouldBe
, shouldNotSatisfy
)
import Text.RawString.QQ (r)
size :: (Text, Value)
size = ("size", String "L")
circumference :: (Text, Value)
circumference = ("circumference", Int 60)
garment :: Text -> (Text, Value)
garment typeName =
("garment", Object $ HashMap.fromList
[ if typeName == "Hat" then circumference else size
, ("__typename", String typeName)
]
)
inlineQuery :: Text
inlineQuery = [r|{
garment {
... on Hat {
circumference
}
... on Shirt {
size
}
}
}|]
hasErrors :: Aeson.Value -> Bool
hasErrors (Aeson.Object object') = HashMap.member "errors" object'
hasErrors _ = True
shirtType :: Out.ObjectType IO
shirtType = Out.ObjectType "Shirt" Nothing []
$ HashMap.fromList
[ ("size", sizeFieldType)
, ("circumference", circumferenceFieldType)
]
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing []
$ HashMap.fromList
[ ("size", sizeFieldType)
, ("circumference", circumferenceFieldType)
]
circumferenceFieldType :: Out.Resolver IO
circumferenceFieldType
= Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ snd circumference
sizeFieldType :: Out.Resolver IO
sizeFieldType
= Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ pure $ snd size
toSchema :: Text -> (Text, Value) -> Schema IO
toSchema t (_, resolve) = Schema
{ query = queryType, mutation = Nothing, subscription = Nothing }
where
unionMember = if t == "Hat" then hatType else shirtType
typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
queryType =
case t of
"circumference" -> hatType
"size" -> shirtType
_ -> Out.ObjectType "Query" Nothing []
$ HashMap.fromList
[ ("garment", ValueResolver garmentField (pure resolve))
, ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
]
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "size" .= ("L" :: Text)
]
]
]
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
let sourceQuery = [r|{
garment {
circumference
... {
size
}
}
}|]
resolvers = ("garment", Object $ HashMap.fromList [circumference, size])
actual <- graphql (toSchema "garment" resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
, "size" .= ("L" :: Text)
]
]
]
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do
let sourceQuery = [r|{
... {
size
}
}|]
actual <- graphql (toSchema "size" size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
let sourceQuery = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
circumference
}
|]
actual <- graphql (toSchema "circumference" circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
]
]
in actual `shouldBe` expected
it "evaluates nested fragments" $ do
let sourceQuery = [r|
{
garment {
...circumferenceFragment
}
}
fragment circumferenceFragment on Hat {
...hatFragment
}
fragment hatFragment on Hat {
circumference
}
|]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
in actual `shouldBe` expected
it "rejects recursive fragments" $ do
let expected = object
[ "data" .= object []
]
sourceQuery = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
...circumferenceFragment
}
|]
actual <- graphql (toSchema "circumference" circumference) sourceQuery
actual `shouldBe` expected
it "considers type condition" $ do
let sourceQuery = [r|
{
garment {
...circumferenceFragment
...sizeFragment
}
}
fragment circumferenceFragment on Hat {
circumference
}
fragment sizeFragment on Shirt {
size
}
|]
expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
]
]
actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
actual `shouldBe` expected