graphql/tests/Test/FragmentSpec.hs

222 lines
6.6 KiB
Haskell
Raw Normal View History

2019-09-13 20:33:39 +02:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.FragmentSpec
( spec
) where
2019-10-19 10:00:25 +02:00
import Data.Aeson (Value(..), object, (.=))
import qualified Data.HashMap.Strict as HashMap
2019-09-13 20:33:39 +02:00
import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
2020-05-24 13:51:00 +02:00
import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
2020-05-14 09:17:14 +02:00
import Test.Hspec
( Spec
, describe
, it
, shouldBe
, shouldNotSatisfy
)
2019-09-13 20:33:39 +02:00
import Text.RawString.QQ (r)
size :: Schema.Resolver IO
2020-05-24 13:51:00 +02:00
size = Schema.Resolver "size" $ pure $ Out.String "L"
2019-09-13 20:33:39 +02:00
circumference :: Schema.Resolver IO
2020-05-24 13:51:00 +02:00
circumference = Schema.Resolver "circumference" $ pure $ Out.Int 60
2019-09-13 20:33:39 +02:00
garment :: Text -> Schema.Resolver IO
2020-05-24 13:51:00 +02:00
garment typeName = Schema.Resolver "garment"
$ pure $ Schema.object
2019-09-13 20:33:39 +02:00
[ if typeName == "Hat" then circumference else size
2020-05-24 13:51:00 +02:00
, Schema.Resolver "__typename" $ pure $ Out.String typeName
2019-09-13 20:33:39 +02:00
]
inlineQuery :: Text
inlineQuery = [r|{
garment {
... on Hat {
circumference
}
... on Shirt {
size
}
}
}|]
2019-11-13 20:40:09 +01:00
hasErrors :: Value -> Bool
hasErrors (Object object') = HashMap.member "errors" object'
hasErrors _ = True
shirtType :: Out.ObjectType IO
shirtType = Out.ObjectType "Shirt" Nothing
2020-05-21 10:20:59 +02:00
$ HashMap.singleton resolverName
$ Out.Field Nothing (Out.NamedScalarType string) mempty resolve
2020-05-21 10:20:59 +02:00
where
(Schema.Resolver resolverName resolve) = size
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing
2020-05-21 10:20:59 +02:00
$ HashMap.singleton resolverName
$ Out.Field Nothing (Out.NamedScalarType int) mempty resolve
2020-05-21 10:20:59 +02:00
where
(Schema.Resolver resolverName resolve) = circumference
2020-05-14 09:17:14 +02:00
toSchema :: Schema.Resolver IO -> Schema IO
2020-05-21 10:20:59 +02:00
toSchema (Schema.Resolver resolverName resolve) = Schema
{ query = queryType, mutation = Nothing }
2020-05-14 09:17:14 +02:00
where
2020-05-21 10:20:59 +02:00
unionMember = if resolverName == "Hat" then hatType else shirtType
queryType = Out.ObjectType "Query" Nothing
2020-05-21 10:20:59 +02:00
$ HashMap.singleton resolverName
$ Out.Field Nothing (Out.NamedObjectType unionMember) mempty resolve
2020-05-14 09:17:14 +02:00
2019-09-13 20:33:39 +02:00
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema $ 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
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "size" .= ("L" :: Text)
]
2019-10-07 21:03:07 +02:00
]
2019-09-13 20:33:39 +02:00
]
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
2020-05-14 09:17:14 +02:00
let sourceQuery = [r|{
garment {
circumference
... {
size
}
}
}|]
2020-05-24 13:51:00 +02:00
resolvers = Schema.Resolver "garment"
$ pure $ Schema.object [circumference, size]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
, "size" .= ("L" :: Text)
]
2019-10-07 21:03:07 +02:00
]
2019-09-13 20:33:39 +02:00
]
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do
2020-05-14 09:17:14 +02:00
let sourceQuery = [r|{
... {
size
}
}|]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
2020-05-14 09:17:14 +02:00
let sourceQuery = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
circumference
}
|]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
]
]
in actual `shouldBe` expected
it "evaluates nested fragments" $ do
2020-05-14 09:17:14 +02:00
let sourceQuery = [r|
{
garment {
...circumferenceFragment
}
}
fragment circumferenceFragment on Hat {
...hatFragment
}
fragment hatFragment on Hat {
circumference
}
|]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema $ 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
}
|]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema circumference) sourceQuery
actual `shouldBe` expected
it "considers type condition" $ do
2020-05-14 09:17:14 +02:00
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)
]
]
]
2020-05-14 09:17:14 +02:00
actual <- graphql (toSchema $ garment "Hat") sourceQuery
actual `shouldBe` expected