graphql/tests/Test/FragmentSpec.hs

165 lines
4.3 KiB
Haskell
Raw Permalink 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.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
2019-11-13 20:40:09 +01:00
import Test.Hspec ( Spec
, describe
, it
, shouldBe
, shouldSatisfy
, shouldNotSatisfy
)
2019-09-13 20:33:39 +02:00
import Text.RawString.QQ (r)
size :: Schema.Resolver IO
size = Schema.scalar "size" $ return ("L" :: Text)
circumference :: Schema.Resolver IO
circumference = Schema.scalar "circumference" $ return (60 :: Int)
garment :: Text -> Schema.Resolver IO
garment typeName = Schema.object "garment" $ return
[ if typeName == "Hat" then circumference else size
, Schema.scalar "__typename" $ return typeName
]
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
2019-09-13 20:33:39 +02:00
spec :: Spec
2019-10-07 21:03:07 +02:00
spec = describe "Inline fragment executor" $ do
2019-09-13 20:33:39 +02:00
it "chooses the first selection if the type matches" $ do
actual <- graphql (garment "Hat" :| []) inlineQuery
let expected = object
2019-10-07 21:03:07 +02:00
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
]
2019-09-13 20:33:39 +02:00
]
]
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
actual <- graphql (garment "Shirt" :| []) inlineQuery
let expected = object
2019-10-07 21:03:07 +02:00
[ "data" .= object
[ "garment" .= object
[ "size" .= ("L" :: Text)
]
2019-09-13 20:33:39 +02:00
]
]
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
let query = [r|{
garment {
circumference
... {
size
}
}
}|]
resolvers = Schema.object "garment" $ return [circumference, size]
actual <- graphql (resolvers :| []) query
let expected = object
[ "data" .= object
[ "garment" .= object
[ "circumference" .= (60 :: Int)
, "size" .= ("L" :: Text)
]
]
]
in actual `shouldBe` expected
2019-10-19 10:00:25 +02:00
it "evaluates fragments on Query" $ do
let query = [r|{
... {
size
}
}|]
actual <- graphql (size :| []) query
2019-11-13 20:40:09 +01:00
actual `shouldNotSatisfy` hasErrors
it "evaluates nested fragments" $ do
let query = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
circumference
}
fragment hatFragment on Hat {
...circumferenceFragment
}
|]
actual <- graphql (circumference :| []) query
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
]
]
in actual `shouldBe` expected
it "evaluates fragments defined in any order" $ do
let query = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
...hatFragment
}
fragment hatFragment on Hat {
circumference
}
|]
actual <- graphql (circumference :| []) query
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
]
]
in actual `shouldBe` expected
2019-11-13 20:40:09 +01:00
it "rejects recursive" $ do
let query = [r|
{
...circumferenceFragment
}
fragment circumferenceFragment on Hat {
...circumferenceFragment
}
|]
actual <- graphql (circumference :| []) query
actual `shouldSatisfy` hasErrors