graphql/tests/Test/FragmentSpec.hs
Eugen Wissner d12577ae71 Define resolvers on type fields
Returning resolvers from other resolvers isn't supported anymore. Since
we have a type system now, we define the resolvers in the object type
fields and pass an object with the previous result to them.
2020-05-29 13:53:51 +02:00

230 lines
7.1 KiB
Haskell

{-# 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.Definition
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
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", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ snd size)
, ("circumference", Out.Field Nothing (Out.NamedScalarType int) mempty $ pure $ snd circumference)
, ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ String "Shirt")
]
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing []
$ HashMap.fromList
[ ("size", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ snd size)
, ("circumference", Out.Field Nothing (Out.NamedScalarType int) mempty $ pure $ snd circumference)
, ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ pure $ String "Hat")
]
toSchema :: Text -> (Text, Value) -> Schema IO
toSchema t (_, resolve) = Schema
{ query = queryType, mutation = Nothing }
where
unionMember = if t == "Hat" then hatType else shirtType
queryType =
case t of
"circumference" -> hatType
"size" -> shirtType
_ -> Out.ObjectType "Query" Nothing []
$ HashMap.fromList
[ ("garment", Out.Field Nothing (Out.NamedObjectType unionMember) mempty $ pure resolve)
, ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty $ 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