forked from OSS/graphql
Remove StarWars tests
Our own test suite is slowly getting sufficient.
This commit is contained in:
parent
afcf9aaa14
commit
7f0fb18716
@ -4,7 +4,7 @@ cabal-version: 2.2
|
|||||||
--
|
--
|
||||||
-- see: https://github.com/sol/hpack
|
-- see: https://github.com/sol/hpack
|
||||||
--
|
--
|
||||||
-- hash: ddb79ddbd13b917f320fff372b4a29b63b6eb0ed113ca732c1d779b4e6a296d8
|
-- hash: c943c792ef9717e8305e22059e7244a0a471b6d26a53e6e4dc162e4f4a6110b4
|
||||||
|
|
||||||
name: graphql
|
name: graphql
|
||||||
version: 0.10.0.0
|
version: 0.10.0.0
|
||||||
@ -74,7 +74,7 @@ library
|
|||||||
, unordered-containers
|
, unordered-containers
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite tasty
|
test-suite graphql-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
@ -89,9 +89,6 @@ test-suite tasty
|
|||||||
Test.DirectiveSpec
|
Test.DirectiveSpec
|
||||||
Test.FragmentSpec
|
Test.FragmentSpec
|
||||||
Test.RootOperationSpec
|
Test.RootOperationSpec
|
||||||
Test.StarWars.Data
|
|
||||||
Test.StarWars.QuerySpec
|
|
||||||
Test.StarWars.Schema
|
|
||||||
Paths_graphql
|
Paths_graphql
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
tests
|
tests
|
||||||
|
|||||||
@ -50,7 +50,7 @@ library:
|
|||||||
- Language.GraphQL.Validate.Rules
|
- Language.GraphQL.Validate.Rules
|
||||||
|
|
||||||
tests:
|
tests:
|
||||||
tasty:
|
graphql-test:
|
||||||
main: Spec.hs
|
main: Spec.hs
|
||||||
source-dirs: tests
|
source-dirs: tests
|
||||||
ghc-options:
|
ghc-options:
|
||||||
|
|||||||
@ -1,204 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
module Test.StarWars.Data
|
|
||||||
( Character
|
|
||||||
, StarWarsException(..)
|
|
||||||
, appearsIn
|
|
||||||
, artoo
|
|
||||||
, getDroid
|
|
||||||
, getDroid'
|
|
||||||
, getEpisode
|
|
||||||
, getFriends
|
|
||||||
, getHero
|
|
||||||
, getHuman
|
|
||||||
, id_
|
|
||||||
, homePlanet
|
|
||||||
, name_
|
|
||||||
, secretBackstory
|
|
||||||
, typeName
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException)
|
|
||||||
import Control.Applicative (Alternative(..), liftA2)
|
|
||||||
import Data.Maybe (catMaybes)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Data.Typeable (cast)
|
|
||||||
import Language.GraphQL.Error
|
|
||||||
import Language.GraphQL.Type
|
|
||||||
|
|
||||||
-- * Data
|
|
||||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
|
|
||||||
|
|
||||||
-- ** Characters
|
|
||||||
|
|
||||||
type ID = Text
|
|
||||||
|
|
||||||
data CharCommon = CharCommon
|
|
||||||
{ _id_ :: ID
|
|
||||||
, _name :: Text
|
|
||||||
, _friends :: [ID]
|
|
||||||
, _appearsIn :: [Int]
|
|
||||||
} deriving (Show)
|
|
||||||
|
|
||||||
|
|
||||||
data Human = Human
|
|
||||||
{ _humanChar :: CharCommon
|
|
||||||
, homePlanet :: Text
|
|
||||||
}
|
|
||||||
|
|
||||||
data Droid = Droid
|
|
||||||
{ _droidChar :: CharCommon
|
|
||||||
, primaryFunction :: Text
|
|
||||||
}
|
|
||||||
|
|
||||||
type Character = Either Droid Human
|
|
||||||
|
|
||||||
id_ :: Character -> ID
|
|
||||||
id_ (Left x) = _id_ . _droidChar $ x
|
|
||||||
id_ (Right x) = _id_ . _humanChar $ x
|
|
||||||
|
|
||||||
name_ :: Character -> Text
|
|
||||||
name_ (Left x) = _name . _droidChar $ x
|
|
||||||
name_ (Right x) = _name . _humanChar $ x
|
|
||||||
|
|
||||||
friends :: Character -> [ID]
|
|
||||||
friends (Left x) = _friends . _droidChar $ x
|
|
||||||
friends (Right x) = _friends . _humanChar $ x
|
|
||||||
|
|
||||||
appearsIn :: Character -> [Int]
|
|
||||||
appearsIn (Left x) = _appearsIn . _droidChar $ x
|
|
||||||
appearsIn (Right x) = _appearsIn . _humanChar $ x
|
|
||||||
|
|
||||||
data StarWarsException = SecretBackstory | InvalidArguments
|
|
||||||
|
|
||||||
instance Show StarWarsException where
|
|
||||||
show SecretBackstory = "secretBackstory is secret."
|
|
||||||
show InvalidArguments = "Invalid arguments."
|
|
||||||
|
|
||||||
instance Exception StarWarsException where
|
|
||||||
toException = toException . ResolverException
|
|
||||||
fromException e = do
|
|
||||||
ResolverException resolverException <- fromException e
|
|
||||||
cast resolverException
|
|
||||||
|
|
||||||
secretBackstory :: Resolve (Either SomeException)
|
|
||||||
secretBackstory = throwM SecretBackstory
|
|
||||||
|
|
||||||
typeName :: Character -> Text
|
|
||||||
typeName = either (const "Droid") (const "Human")
|
|
||||||
|
|
||||||
luke :: Character
|
|
||||||
luke = Right luke'
|
|
||||||
|
|
||||||
luke' :: Human
|
|
||||||
luke' = Human
|
|
||||||
{ _humanChar = CharCommon
|
|
||||||
{ _id_ = "1000"
|
|
||||||
, _name = "Luke Skywalker"
|
|
||||||
, _friends = ["1002","1003","2000","2001"]
|
|
||||||
, _appearsIn = [4,5,6]
|
|
||||||
}
|
|
||||||
, homePlanet = "Tatooine"
|
|
||||||
}
|
|
||||||
|
|
||||||
vader :: Human
|
|
||||||
vader = Human
|
|
||||||
{ _humanChar = CharCommon
|
|
||||||
{ _id_ = "1001"
|
|
||||||
, _name = "Darth Vader"
|
|
||||||
, _friends = ["1004"]
|
|
||||||
, _appearsIn = [4,5,6]
|
|
||||||
}
|
|
||||||
, homePlanet = "Tatooine"
|
|
||||||
}
|
|
||||||
|
|
||||||
han :: Human
|
|
||||||
han = Human
|
|
||||||
{ _humanChar = CharCommon
|
|
||||||
{ _id_ = "1002"
|
|
||||||
, _name = "Han Solo"
|
|
||||||
, _friends = ["1000","1003","2001" ]
|
|
||||||
, _appearsIn = [4,5,6]
|
|
||||||
}
|
|
||||||
, homePlanet = mempty
|
|
||||||
}
|
|
||||||
|
|
||||||
leia :: Human
|
|
||||||
leia = Human
|
|
||||||
{ _humanChar = CharCommon
|
|
||||||
{ _id_ = "1003"
|
|
||||||
, _name = "Leia Organa"
|
|
||||||
, _friends = ["1000","1002","2000","2001"]
|
|
||||||
, _appearsIn = [4,5,6]
|
|
||||||
}
|
|
||||||
, homePlanet = "Alderaan"
|
|
||||||
}
|
|
||||||
|
|
||||||
tarkin :: Human
|
|
||||||
tarkin = Human
|
|
||||||
{ _humanChar = CharCommon
|
|
||||||
{ _id_ = "1004"
|
|
||||||
, _name = "Wilhuff Tarkin"
|
|
||||||
, _friends = ["1001"]
|
|
||||||
, _appearsIn = [4]
|
|
||||||
}
|
|
||||||
, homePlanet = mempty
|
|
||||||
}
|
|
||||||
|
|
||||||
threepio :: Droid
|
|
||||||
threepio = Droid
|
|
||||||
{ _droidChar = CharCommon
|
|
||||||
{ _id_ = "2000"
|
|
||||||
, _name = "C-3PO"
|
|
||||||
, _friends = ["1000","1002","1003","2001" ]
|
|
||||||
, _appearsIn = [ 4, 5, 6 ]
|
|
||||||
}
|
|
||||||
, primaryFunction = "Protocol"
|
|
||||||
}
|
|
||||||
|
|
||||||
artoo :: Character
|
|
||||||
artoo = Left artoo'
|
|
||||||
|
|
||||||
artoo' :: Droid
|
|
||||||
artoo' = Droid
|
|
||||||
{ _droidChar = CharCommon
|
|
||||||
{ _id_ = "2001"
|
|
||||||
, _name = "R2-D2"
|
|
||||||
, _friends = ["1000","1002","1003"]
|
|
||||||
, _appearsIn = [4,5,6]
|
|
||||||
}
|
|
||||||
, primaryFunction = "Astrometch"
|
|
||||||
}
|
|
||||||
|
|
||||||
-- ** Helper functions
|
|
||||||
|
|
||||||
getHero :: Int -> Character
|
|
||||||
getHero 5 = luke
|
|
||||||
getHero _ = artoo
|
|
||||||
|
|
||||||
getHuman :: ID -> Maybe Character
|
|
||||||
getHuman = fmap Right . getHuman'
|
|
||||||
|
|
||||||
getHuman' :: ID -> Maybe Human
|
|
||||||
getHuman' "1000" = pure luke'
|
|
||||||
getHuman' "1001" = pure vader
|
|
||||||
getHuman' "1002" = pure han
|
|
||||||
getHuman' "1003" = pure leia
|
|
||||||
getHuman' "1004" = pure tarkin
|
|
||||||
getHuman' _ = empty
|
|
||||||
|
|
||||||
getDroid :: ID -> Maybe Character
|
|
||||||
getDroid = fmap Left . getDroid'
|
|
||||||
|
|
||||||
getDroid' :: ID -> Maybe Droid
|
|
||||||
getDroid' "2000" = pure threepio
|
|
||||||
getDroid' "2001" = pure artoo'
|
|
||||||
getDroid' _ = empty
|
|
||||||
|
|
||||||
getFriends :: Character -> [Character]
|
|
||||||
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
|
||||||
|
|
||||||
getEpisode :: Int -> Maybe Text
|
|
||||||
getEpisode 4 = pure "NEW_HOPE"
|
|
||||||
getEpisode 5 = pure "EMPIRE"
|
|
||||||
getEpisode 6 = pure "JEDI"
|
|
||||||
getEpisode _ = empty
|
|
||||||
@ -1,366 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
module Test.StarWars.QuerySpec
|
|
||||||
( spec
|
|
||||||
) where
|
|
||||||
|
|
||||||
import qualified Data.Aeson as Aeson
|
|
||||||
import Data.Aeson ((.=))
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Language.GraphQL
|
|
||||||
import Text.RawString.QQ (r)
|
|
||||||
import Test.Hspec.Expectations (Expectation, shouldBe)
|
|
||||||
import Test.Hspec (Spec, describe, it)
|
|
||||||
import Test.StarWars.Schema
|
|
||||||
|
|
||||||
-- * Test
|
|
||||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = describe "Star Wars Query Tests" $ do
|
|
||||||
describe "Basic Queries" $ do
|
|
||||||
it "R2-D2 hero" $ testQuery
|
|
||||||
[r| query HeroNameQuery {
|
|
||||||
hero {
|
|
||||||
id
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object
|
|
||||||
[ "data" .= Aeson.object
|
|
||||||
[ "hero" .= Aeson.object ["id" .= ("2001" :: Text)]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
it "R2-D2 ID and friends" $ testQuery
|
|
||||||
[r| query HeroNameAndFriendsQuery {
|
|
||||||
hero {
|
|
||||||
id
|
|
||||||
name
|
|
||||||
friends {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"hero" .= Aeson.object
|
|
||||||
[ "id" .= ("2001" :: Text)
|
|
||||||
, r2d2Name
|
|
||||||
, "friends" .=
|
|
||||||
[ Aeson.object [lukeName]
|
|
||||||
, Aeson.object [hanName]
|
|
||||||
, Aeson.object [leiaName]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
|
|
||||||
describe "Nested Queries" $ do
|
|
||||||
it "R2-D2 friends" $ testQuery
|
|
||||||
[r| query NestedQuery {
|
|
||||||
hero {
|
|
||||||
name
|
|
||||||
friends {
|
|
||||||
name
|
|
||||||
appearsIn
|
|
||||||
friends {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"hero" .= Aeson.object [
|
|
||||||
"name" .= ("R2-D2" :: Text)
|
|
||||||
, "friends" .= [
|
|
||||||
Aeson.object [
|
|
||||||
"name" .= ("Luke Skywalker" :: Text)
|
|
||||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
|
||||||
, "friends" .= [
|
|
||||||
Aeson.object [hanName]
|
|
||||||
, Aeson.object [leiaName]
|
|
||||||
, Aeson.object [c3poName]
|
|
||||||
, Aeson.object [r2d2Name]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, Aeson.object [
|
|
||||||
hanName
|
|
||||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
|
||||||
, "friends" .=
|
|
||||||
[ Aeson.object [lukeName]
|
|
||||||
, Aeson.object [leiaName]
|
|
||||||
, Aeson.object [r2d2Name]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, Aeson.object [
|
|
||||||
leiaName
|
|
||||||
, "appearsIn" .= ["NEW_HOPE", "EMPIRE", "JEDI" :: Text]
|
|
||||||
, "friends" .=
|
|
||||||
[ Aeson.object [lukeName]
|
|
||||||
, Aeson.object [hanName]
|
|
||||||
, Aeson.object [c3poName]
|
|
||||||
, Aeson.object [r2d2Name]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
it "Luke ID" $ testQuery
|
|
||||||
[r| query FetchLukeQuery {
|
|
||||||
human(id: "1000") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object
|
|
||||||
[ "human" .= Aeson.object [lukeName]
|
|
||||||
]]
|
|
||||||
|
|
||||||
it "Luke ID with variable" $ testQueryParams
|
|
||||||
(HashMap.singleton "someId" "1000")
|
|
||||||
[r| query FetchSomeIDQuery($someId: String!) {
|
|
||||||
human(id: $someId) {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"human" .= Aeson.object [lukeName]
|
|
||||||
]]
|
|
||||||
it "Han ID with variable" $ testQueryParams
|
|
||||||
(HashMap.singleton "someId" "1002")
|
|
||||||
[r| query FetchSomeIDQuery($someId: String!) {
|
|
||||||
human(id: $someId) {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"human" .= Aeson.object [hanName]
|
|
||||||
]]
|
|
||||||
it "Invalid ID" $ testQueryParams
|
|
||||||
(HashMap.singleton "id" "Not a valid ID")
|
|
||||||
[r| query humanQuery($id: String!) {
|
|
||||||
human(id: $id) {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|] $ Aeson.object ["data" .= Aeson.object ["human" .= Aeson.Null]]
|
|
||||||
it "Luke aliased" $ testQuery
|
|
||||||
[r| query FetchLukeAliased {
|
|
||||||
luke: human(id: "1000") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"luke" .= Aeson.object [lukeName]
|
|
||||||
]]
|
|
||||||
it "R2-D2 ID and friends aliased" $ testQuery
|
|
||||||
[r| query HeroNameAndFriendsQuery {
|
|
||||||
hero {
|
|
||||||
id
|
|
||||||
name
|
|
||||||
friends {
|
|
||||||
friendName: name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"hero" .= Aeson.object [
|
|
||||||
"id" .= ("2001" :: Text)
|
|
||||||
, r2d2Name
|
|
||||||
, "friends" .=
|
|
||||||
[ Aeson.object ["friendName" .= ("Luke Skywalker" :: Text)]
|
|
||||||
, Aeson.object ["friendName" .= ("Han Solo" :: Text)]
|
|
||||||
, Aeson.object ["friendName" .= ("Leia Organa" :: Text)]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
it "Luke and Leia aliased" $ testQuery
|
|
||||||
[r| query FetchLukeAndLeiaAliased {
|
|
||||||
luke: human(id: "1000") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
leia: human(id: "1003") {
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object
|
|
||||||
[ "luke" .= Aeson.object [lukeName]
|
|
||||||
, "leia" .= Aeson.object [leiaName]
|
|
||||||
]]
|
|
||||||
|
|
||||||
describe "Fragments for complex queries" $ do
|
|
||||||
it "Aliases to query for duplicate content" $ testQuery
|
|
||||||
[r| query DuplicateFields {
|
|
||||||
luke: human(id: "1000") {
|
|
||||||
name
|
|
||||||
homePlanet
|
|
||||||
}
|
|
||||||
leia: human(id: "1003") {
|
|
||||||
name
|
|
||||||
homePlanet
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"luke" .= Aeson.object [lukeName, tatooine]
|
|
||||||
, "leia" .= Aeson.object [leiaName, alderaan]
|
|
||||||
]]
|
|
||||||
it "Fragment for duplicate content" $ testQuery
|
|
||||||
[r| query UseFragment {
|
|
||||||
luke: human(id: "1000") {
|
|
||||||
...HumanFragment
|
|
||||||
}
|
|
||||||
leia: human(id: "1003") {
|
|
||||||
...HumanFragment
|
|
||||||
}
|
|
||||||
}
|
|
||||||
fragment HumanFragment on Human {
|
|
||||||
name
|
|
||||||
homePlanet
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object [ "data" .= Aeson.object [
|
|
||||||
"luke" .= Aeson.object [lukeName, tatooine]
|
|
||||||
, "leia" .= Aeson.object [leiaName, alderaan]
|
|
||||||
]]
|
|
||||||
|
|
||||||
describe "__typename" $ do
|
|
||||||
it "R2D2 is a Droid" $ testQuery
|
|
||||||
[r| query CheckTypeOfR2 {
|
|
||||||
hero {
|
|
||||||
__typename
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object ["data" .= Aeson.object [
|
|
||||||
"hero" .= Aeson.object
|
|
||||||
[ "__typename" .= ("Droid" :: Text)
|
|
||||||
, r2d2Name
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
it "Luke is a human" $ testQuery
|
|
||||||
[r| query CheckTypeOfLuke {
|
|
||||||
hero(episode: EMPIRE) {
|
|
||||||
__typename
|
|
||||||
name
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object ["data" .= Aeson.object [
|
|
||||||
"hero" .= Aeson.object
|
|
||||||
[ "__typename" .= ("Human" :: Text)
|
|
||||||
, lukeName
|
|
||||||
]
|
|
||||||
]]
|
|
||||||
|
|
||||||
describe "Errors in resolvers" $ do
|
|
||||||
it "error on secretBackstory" $ testQuery
|
|
||||||
[r|
|
|
||||||
query HeroNameQuery {
|
|
||||||
hero {
|
|
||||||
name
|
|
||||||
secretBackstory
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object
|
|
||||||
[ "data" .= Aeson.object
|
|
||||||
[ "hero" .= Aeson.object
|
|
||||||
[ "name" .= ("R2-D2" :: Text)
|
|
||||||
, "secretBackstory" .= Aeson.Null
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, "errors" .=
|
|
||||||
[ Aeson.object
|
|
||||||
["message" .= ("secretBackstory is secret." :: Text)]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
it "Error in a list" $ testQuery
|
|
||||||
[r| query HeroNameQuery {
|
|
||||||
hero {
|
|
||||||
name
|
|
||||||
friends {
|
|
||||||
name
|
|
||||||
secretBackstory
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object ["data" .= Aeson.object
|
|
||||||
[ "hero" .= Aeson.object
|
|
||||||
[ "name" .= ("R2-D2" :: Text)
|
|
||||||
, "friends" .=
|
|
||||||
[ Aeson.object
|
|
||||||
[ "name" .= ("Luke Skywalker" :: Text)
|
|
||||||
, "secretBackstory" .= Aeson.Null
|
|
||||||
]
|
|
||||||
, Aeson.object
|
|
||||||
[ "name" .= ("Han Solo" :: Text)
|
|
||||||
, "secretBackstory" .= Aeson.Null
|
|
||||||
]
|
|
||||||
, Aeson.object
|
|
||||||
[ "name" .= ("Leia Organa" :: Text)
|
|
||||||
, "secretBackstory" .= Aeson.Null
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, "errors" .=
|
|
||||||
[ Aeson.object
|
|
||||||
[ "message" .= ("secretBackstory is secret." :: Text)
|
|
||||||
]
|
|
||||||
, Aeson.object
|
|
||||||
[ "message" .= ("secretBackstory is secret." :: Text)
|
|
||||||
]
|
|
||||||
, Aeson.object
|
|
||||||
[ "message" .= ("secretBackstory is secret." :: Text)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
it "error on secretBackstory with alias" $ testQuery
|
|
||||||
[r| query HeroNameQuery {
|
|
||||||
mainHero: hero {
|
|
||||||
name
|
|
||||||
story: secretBackstory
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|]
|
|
||||||
$ Aeson.object
|
|
||||||
[ "data" .= Aeson.object
|
|
||||||
[ "mainHero" .= Aeson.object
|
|
||||||
[ "name" .= ("R2-D2" :: Text)
|
|
||||||
, "story" .= Aeson.Null
|
|
||||||
]
|
|
||||||
]
|
|
||||||
, "errors" .=
|
|
||||||
[ Aeson.object
|
|
||||||
[ "message" .= ("secretBackstory is secret." :: Text)
|
|
||||||
]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
where
|
|
||||||
lukeName = "name" .= ("Luke Skywalker" :: Text)
|
|
||||||
leiaName = "name" .= ("Leia Organa" :: Text)
|
|
||||||
hanName = "name" .= ("Han Solo" :: Text)
|
|
||||||
r2d2Name = "name" .= ("R2-D2" :: Text)
|
|
||||||
c3poName = "name" .= ("C-3PO" :: Text)
|
|
||||||
tatooine = "homePlanet" .= ("Tatooine" :: Text)
|
|
||||||
alderaan = "homePlanet" .= ("Alderaan" :: Text)
|
|
||||||
|
|
||||||
testQuery :: Text -> Aeson.Value -> Expectation
|
|
||||||
testQuery q expected =
|
|
||||||
let Right (Right actual) = graphql starWarsSchema q
|
|
||||||
in Aeson.Object actual `shouldBe` expected
|
|
||||||
|
|
||||||
testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
|
|
||||||
testQueryParams f q expected =
|
|
||||||
let Right (Right actual) = graphqlSubs starWarsSchema Nothing f q
|
|
||||||
in Aeson.Object actual `shouldBe` expected
|
|
||||||
@ -1,166 +0,0 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
module Test.StarWars.Schema
|
|
||||||
( starWarsSchema
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Monad.Catch (MonadThrow(..), SomeException)
|
|
||||||
import Control.Monad.Trans.Reader (asks)
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
|
||||||
import Data.Maybe (catMaybes)
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Language.GraphQL.Type
|
|
||||||
import qualified Language.GraphQL.Type.In as In
|
|
||||||
import qualified Language.GraphQL.Type.Out as Out
|
|
||||||
import Test.StarWars.Data
|
|
||||||
import Prelude hiding (id)
|
|
||||||
|
|
||||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
|
|
||||||
|
|
||||||
starWarsSchema :: Schema (Either SomeException)
|
|
||||||
starWarsSchema = schema queryType Nothing Nothing mempty
|
|
||||||
where
|
|
||||||
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
|
|
||||||
[ ("hero", heroFieldResolver)
|
|
||||||
, ("human", humanFieldResolver)
|
|
||||||
, ("droid", droidFieldResolver)
|
|
||||||
]
|
|
||||||
heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
|
|
||||||
$ HashMap.singleton "episode"
|
|
||||||
$ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
|
|
||||||
heroFieldResolver = ValueResolver heroField hero
|
|
||||||
humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
|
|
||||||
$ HashMap.singleton "id"
|
|
||||||
$ In.Argument Nothing (In.NonNullScalarType string) Nothing
|
|
||||||
humanFieldResolver = ValueResolver humanField human
|
|
||||||
droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
|
|
||||||
droidFieldResolver = ValueResolver droidField droid
|
|
||||||
|
|
||||||
heroObject :: Out.ObjectType (Either SomeException)
|
|
||||||
heroObject = Out.ObjectType "Human" Nothing [characterType] $ HashMap.fromList
|
|
||||||
[ ("id", idFieldType)
|
|
||||||
, ("name", nameFieldType)
|
|
||||||
, ("friends", friendsFieldResolver)
|
|
||||||
, ("appearsIn", appearsInFieldResolver)
|
|
||||||
, ("homePlanet", homePlanetFieldType)
|
|
||||||
, ("secretBackstory", secretBackstoryFieldResolver)
|
|
||||||
, ("__typename", typenameFieldResolver)
|
|
||||||
]
|
|
||||||
where
|
|
||||||
homePlanetFieldType
|
|
||||||
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
|
|
||||||
$ defaultResolver "homePlanet"
|
|
||||||
|
|
||||||
droidObject :: Out.ObjectType (Either SomeException)
|
|
||||||
droidObject = Out.ObjectType "Droid" Nothing [characterType] $ HashMap.fromList
|
|
||||||
[ ("id", idFieldType)
|
|
||||||
, ("name", nameFieldType)
|
|
||||||
, ("friends", friendsFieldResolver)
|
|
||||||
, ("appearsIn", appearsInFieldResolver)
|
|
||||||
, ("primaryFunction", primaryFunctionFieldType)
|
|
||||||
, ("secretBackstory", secretBackstoryFieldResolver)
|
|
||||||
, ("__typename", typenameFieldResolver)
|
|
||||||
]
|
|
||||||
where
|
|
||||||
primaryFunctionFieldType
|
|
||||||
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
|
|
||||||
$ defaultResolver "primaryFunction"
|
|
||||||
|
|
||||||
typenameFieldResolver :: Resolver (Either SomeException)
|
|
||||||
typenameFieldResolver
|
|
||||||
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
|
|
||||||
$ defaultResolver "__typename"
|
|
||||||
|
|
||||||
idFieldType :: Resolver (Either SomeException)
|
|
||||||
idFieldType = ValueResolver idField $ defaultResolver "id"
|
|
||||||
|
|
||||||
nameFieldType :: Resolver (Either SomeException)
|
|
||||||
nameFieldType = ValueResolver nameField $ defaultResolver "name"
|
|
||||||
|
|
||||||
friendsFieldResolver :: Resolver (Either SomeException)
|
|
||||||
friendsFieldResolver = ValueResolver friendsField $ defaultResolver "friends"
|
|
||||||
|
|
||||||
characterType :: InterfaceType (Either SomeException)
|
|
||||||
characterType = InterfaceType "Character" Nothing [] $ HashMap.fromList
|
|
||||||
[ ("id", idField)
|
|
||||||
, ("name", nameField)
|
|
||||||
, ("friends", friendsField)
|
|
||||||
, ("appearsIn", appearsInField)
|
|
||||||
, ("secretBackstory", secretBackstoryField)
|
|
||||||
]
|
|
||||||
|
|
||||||
idField :: Field (Either SomeException)
|
|
||||||
idField = Field Nothing (Out.NonNullScalarType id) mempty
|
|
||||||
|
|
||||||
nameField :: Field (Either SomeException)
|
|
||||||
nameField = Field Nothing (Out.NamedScalarType string) mempty
|
|
||||||
|
|
||||||
friendsField :: Field (Either SomeException)
|
|
||||||
friendsField = Field Nothing friendsFieldType mempty
|
|
||||||
where
|
|
||||||
friendsFieldType = Out.ListType (Out.NamedInterfaceType characterType)
|
|
||||||
|
|
||||||
appearsInField :: Field (Either SomeException)
|
|
||||||
appearsInField = Field appearsInDescription appearsInFieldType mempty
|
|
||||||
where
|
|
||||||
appearsInDescription = Just "Which movies they appear in."
|
|
||||||
appearsInFieldType = Out.ListType $ Out.NamedEnumType episodeEnum
|
|
||||||
|
|
||||||
secretBackstoryField :: Field (Either SomeException)
|
|
||||||
secretBackstoryField =
|
|
||||||
Out.Field Nothing (Out.NamedScalarType string) mempty
|
|
||||||
|
|
||||||
appearsInFieldResolver :: Resolver (Either SomeException)
|
|
||||||
appearsInFieldResolver = ValueResolver appearsInField
|
|
||||||
$ defaultResolver "appearsIn"
|
|
||||||
|
|
||||||
secretBackstoryFieldResolver :: Resolver (Either SomeException)
|
|
||||||
secretBackstoryFieldResolver = ValueResolver secretBackstoryField secretBackstory
|
|
||||||
|
|
||||||
defaultResolver :: Text -> Resolve (Either SomeException)
|
|
||||||
defaultResolver f = do
|
|
||||||
v <- asks values
|
|
||||||
let (Object v') = v
|
|
||||||
pure $ v' HashMap.! f
|
|
||||||
|
|
||||||
episodeEnum :: EnumType
|
|
||||||
episodeEnum = EnumType "Episode" (Just description)
|
|
||||||
$ HashMap.fromList [newHope, empire, jedi]
|
|
||||||
where
|
|
||||||
description = "One of the films in the Star Wars Trilogy"
|
|
||||||
newHope = ("NEW_HOPE", EnumValue $ Just "Released in 1977.")
|
|
||||||
empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
|
|
||||||
jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
|
|
||||||
|
|
||||||
hero :: Resolve (Either SomeException)
|
|
||||||
hero = do
|
|
||||||
episode <- argument "episode"
|
|
||||||
pure $ character $ case episode of
|
|
||||||
Enum "NEW_HOPE" -> getHero 4
|
|
||||||
Enum "EMPIRE" -> getHero 5
|
|
||||||
Enum "JEDI" -> getHero 6
|
|
||||||
_ -> artoo
|
|
||||||
|
|
||||||
human :: Resolve (Either SomeException)
|
|
||||||
human = do
|
|
||||||
id' <- argument "id"
|
|
||||||
case id' of
|
|
||||||
String i -> pure $ maybe Null character $ getHuman i >>= Just
|
|
||||||
_ -> throwM InvalidArguments
|
|
||||||
|
|
||||||
droid :: Resolve (Either SomeException)
|
|
||||||
droid = do
|
|
||||||
id' <- argument "id"
|
|
||||||
case id' of
|
|
||||||
String i -> pure $ maybe Null character $ getDroid i >>= Just
|
|
||||||
_ -> throwM InvalidArguments
|
|
||||||
|
|
||||||
character :: Character -> Value
|
|
||||||
character char = Object $ HashMap.fromList
|
|
||||||
[ ("id", String $ id_ char)
|
|
||||||
, ("name", String $ name_ char)
|
|
||||||
, ("friends", List $ character <$> getFriends char)
|
|
||||||
, ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
|
|
||||||
, ("homePlanet", String $ either mempty homePlanet char)
|
|
||||||
, ("__typename", String $ typeName char)
|
|
||||||
]
|
|
||||||
Loading…
Reference in New Issue
Block a user