165 lines
4.3 KiB
Haskell
165 lines
4.3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
module Test.FragmentSpec
|
|
( spec
|
|
) where
|
|
|
|
import Data.Aeson (Value(..), object, (.=))
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
|
import Data.Text (Text)
|
|
import Language.GraphQL
|
|
import qualified Language.GraphQL.Schema as Schema
|
|
import Test.Hspec ( Spec
|
|
, describe
|
|
, it
|
|
, shouldBe
|
|
, shouldSatisfy
|
|
, shouldNotSatisfy
|
|
)
|
|
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
|
|
}
|
|
}
|
|
}|]
|
|
|
|
hasErrors :: Value -> Bool
|
|
hasErrors (Object object') = HashMap.member "errors" object'
|
|
hasErrors _ = True
|
|
|
|
spec :: Spec
|
|
spec = describe "Inline fragment executor" $ do
|
|
it "chooses the first selection if the type matches" $ do
|
|
actual <- graphql (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 (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 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
|
|
|
|
it "evaluates fragments on Query" $ do
|
|
let query = [r|{
|
|
... {
|
|
size
|
|
}
|
|
}|]
|
|
|
|
actual <- graphql (size :| []) query
|
|
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
|
|
|
|
it "rejects recursive" $ do
|
|
let query = [r|
|
|
{
|
|
...circumferenceFragment
|
|
}
|
|
|
|
fragment circumferenceFragment on Hat {
|
|
...circumferenceFragment
|
|
}
|
|
|]
|
|
|
|
actual <- graphql (circumference :| []) query
|
|
actual `shouldSatisfy` hasErrors
|