2016-02-12 13:27:46 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE QuasiQuotes #-}
|
2016-02-15 11:19:05 +01:00
|
|
|
module Test.StarWars.QueryTests (test) where
|
2016-02-12 13:27:46 +01:00
|
|
|
|
2016-03-12 00:59:51 +01:00
|
|
|
import qualified Data.Aeson as Aeson (Value(Null), toJSON)
|
2016-02-17 12:35:54 +01:00
|
|
|
import Data.Aeson (object, (.=))
|
2016-02-12 13:27:46 +01:00
|
|
|
import Data.Text (Text)
|
|
|
|
import Text.RawString.QQ (r)
|
|
|
|
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
2016-02-15 11:19:05 +01:00
|
|
|
import Test.Tasty.HUnit (Assertion, testCase, (@?=))
|
2016-02-12 13:27:46 +01:00
|
|
|
|
|
|
|
import Data.GraphQL
|
2016-02-15 14:25:15 +01:00
|
|
|
import Data.GraphQL.Schema (Subs)
|
2016-02-12 13:27:46 +01:00
|
|
|
|
|
|
|
import Test.StarWars.Schema
|
|
|
|
|
|
|
|
-- * Test
|
|
|
|
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
|
|
|
|
|
|
|
|
test :: TestTree
|
|
|
|
test = testGroup "Star Wars Query Tests"
|
|
|
|
[ testGroup "Basic Queries"
|
2016-02-15 11:19:05 +01:00
|
|
|
[ testCase "R2-D2 hero" . testQuery
|
|
|
|
[r| query HeroNameQuery {
|
|
|
|
hero {
|
|
|
|
id
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
|
2016-02-15 11:19:05 +01:00
|
|
|
, testCase "R2-D2 ID and friends" . testQuery
|
|
|
|
[r| query HeroNameAndFriendsQuery {
|
|
|
|
hero {
|
|
|
|
id
|
|
|
|
name
|
|
|
|
friends {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-12 13:27:46 +01:00
|
|
|
"hero" .= object [
|
2016-02-15 11:19:05 +01:00
|
|
|
"id" .= ("2001" :: Text)
|
|
|
|
, "name" .= ("R2-D2" :: Text)
|
|
|
|
, "friends" .= [
|
|
|
|
object ["name" .= ("Luke Skywalker" :: Text)]
|
|
|
|
, object ["name" .= ("Han Solo" :: Text)]
|
|
|
|
, object ["name" .= ("Leia Organa" :: Text)]
|
|
|
|
]
|
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-12 13:27:46 +01:00
|
|
|
]
|
|
|
|
, testGroup "Nested Queries"
|
2016-02-15 11:19:05 +01:00
|
|
|
[ testCase "R2-D2 friends" . testQuery
|
|
|
|
[r| query NestedQuery {
|
|
|
|
hero {
|
|
|
|
name
|
|
|
|
friends {
|
|
|
|
name
|
|
|
|
appearsIn
|
|
|
|
friends {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-15 11:19:05 +01:00
|
|
|
"hero" .= object [
|
|
|
|
"name" .= ("R2-D2" :: Text)
|
|
|
|
, "friends" .= [
|
|
|
|
object [
|
|
|
|
"name" .= ("Luke Skywalker" :: Text)
|
|
|
|
, "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
|
|
|
|
, "friends" .= [
|
|
|
|
object ["name" .= ("Han Solo" :: Text)]
|
|
|
|
, object ["name" .= ("Leia Organa" :: Text)]
|
|
|
|
, object ["name" .= ("C-3PO" :: Text)]
|
|
|
|
, object ["name" .= ("R2-D2" :: Text)]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
, object [
|
|
|
|
"name" .= ("Han Solo" :: Text)
|
|
|
|
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
|
|
|
|
, "friends" .= [
|
|
|
|
object ["name" .= ("Luke Skywalker" :: Text)]
|
|
|
|
, object ["name" .= ("Leia Organa" :: Text)]
|
|
|
|
, object ["name" .= ("R2-D2" :: Text)]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
, object [
|
|
|
|
"name" .= ("Leia Organa" :: Text)
|
|
|
|
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
|
|
|
|
, "friends" .= [
|
|
|
|
object ["name" .= ("Luke Skywalker" :: Text)]
|
|
|
|
, object ["name" .= ("Han Solo" :: Text)]
|
|
|
|
, object ["name" .= ("C-3PO" :: Text)]
|
|
|
|
, object ["name" .= ("R2-D2" :: Text)]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-15 11:19:05 +01:00
|
|
|
, testCase "Luke ID" . testQuery
|
|
|
|
[r| query FetchLukeQuery {
|
|
|
|
human(id: "1000") {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-15 11:19:05 +01:00
|
|
|
"human" .= object [
|
|
|
|
"name" .= ("Luke Skywalker" :: Text)
|
|
|
|
]
|
2016-02-12 13:27:46 +01:00
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-15 14:25:15 +01:00
|
|
|
, testCase "Luke ID with variable" . testQueryParams
|
|
|
|
(\v -> if v == "someId"
|
|
|
|
then Just "1000"
|
|
|
|
else Nothing)
|
|
|
|
[r| query FetchSomeIDQuery($someId: String!) {
|
|
|
|
human(id: $someId) {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-15 14:25:15 +01:00
|
|
|
"human" .= object ["name" .= ("Luke Skywalker" :: Text)]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-17 12:35:54 +01:00
|
|
|
, testCase "Han ID with variable" . testQueryParams
|
|
|
|
(\v -> if v == "someId"
|
|
|
|
then Just "1002"
|
|
|
|
else Nothing)
|
|
|
|
[r| query FetchSomeIDQuery($someId: String!) {
|
|
|
|
human(id: $someId) {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-17 12:35:54 +01:00
|
|
|
"human" .= object ["name" .= ("Han Solo" :: Text)]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
|
|
|
, testCase "Invalid ID" . testQueryParams
|
2016-02-17 18:13:10 +01:00
|
|
|
(\v -> if v == "id"
|
|
|
|
then Just "Not a valid ID"
|
|
|
|
else Nothing)
|
|
|
|
[r| query humanQuery($id: String!) {
|
|
|
|
human(id: $id) {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
2016-03-12 00:59:51 +01:00
|
|
|
|] $ object ["data" .= object ["human" .= object ["name" .= Aeson.Null]],
|
|
|
|
"errors" .= (Aeson.toJSON [object ["message" .= ("field name not resolved." :: Text)]])]
|
2016-02-17 18:13:10 +01:00
|
|
|
-- TODO: This test is directly ported from `graphql-js`, however do we want
|
|
|
|
-- to mimic the same behavior? Is this part of the spec? Once proper
|
|
|
|
-- exceptions are implemented this test might no longer be meaningful.
|
|
|
|
-- If the same behavior needs to be replicated, should it be implemented
|
|
|
|
-- when defining the `Schema` or when executing?
|
2016-03-12 00:59:51 +01:00
|
|
|
-- $ object [ "data" .= object ["human" .= Aeson.Null] ]
|
2016-02-17 18:13:10 +01:00
|
|
|
, testCase "Luke aliased" . testQuery
|
2016-02-17 12:59:35 +01:00
|
|
|
[r| query FetchLukeAliased {
|
|
|
|
luke: human(id: "1000") {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-17 12:59:35 +01:00
|
|
|
"luke" .= object [
|
|
|
|
"name" .= ("Luke Skywalker" :: Text)
|
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-17 18:13:10 +01:00
|
|
|
, testCase "R2-D2 ID and friends aliased" . testQuery
|
|
|
|
[r| query HeroNameAndFriendsQuery {
|
|
|
|
hero {
|
|
|
|
id
|
|
|
|
name
|
|
|
|
friends {
|
|
|
|
friendName: name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-17 18:13:10 +01:00
|
|
|
"hero" .= object [
|
|
|
|
"id" .= ("2001" :: Text)
|
|
|
|
, "name" .= ("R2-D2" :: Text)
|
|
|
|
, "friends" .= [
|
|
|
|
object ["friendName" .= ("Luke Skywalker" :: Text)]
|
|
|
|
, object ["friendName" .= ("Han Solo" :: Text)]
|
|
|
|
, object ["friendName" .= ("Leia Organa" :: Text)]
|
|
|
|
]
|
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-17 12:59:35 +01:00
|
|
|
, testCase "Luke and Leia aliased" . testQuery
|
|
|
|
[r| query FetchLukeAndLeiaAliased {
|
|
|
|
luke: human(id: "1000") {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
leia: human(id: "1003") {
|
|
|
|
name
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|]
|
2016-03-12 00:59:51 +01:00
|
|
|
$ object [ "data" .= object [
|
2016-02-17 12:59:35 +01:00
|
|
|
"luke" .= object [
|
|
|
|
"name" .= ("Luke Skywalker" :: Text)
|
|
|
|
]
|
|
|
|
, "leia" .= object [
|
|
|
|
"name" .= ("Leia Organa" :: Text)
|
|
|
|
]
|
2016-03-12 00:59:51 +01:00
|
|
|
]]
|
2016-02-12 13:27:46 +01:00
|
|
|
]
|
2016-02-17 18:13:10 +01:00
|
|
|
|
|
|
|
testQuery :: Text -> Aeson.Value -> Assertion
|
|
|
|
testQuery q expected = graphql schema q @?= Just expected
|
|
|
|
|
|
|
|
-- testFail :: Text -> Assertion
|
|
|
|
-- testFail q = graphql schema q @?= Nothing
|
|
|
|
|
|
|
|
testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion
|
|
|
|
testQueryParams f q expected = graphqlSubs schema f q @?= Just expected
|
|
|
|
|
2016-03-12 00:59:51 +01:00
|
|
|
-- testFailParams :: Subs -> Text -> Assertion
|
|
|
|
-- testFailParams f q = graphqlSubs schema f q @?= Nothing
|