Remove StarWars tests

Our own test suite is slowly getting sufficient.
This commit is contained in:
Eugen Wissner 2020-11-05 07:55:22 +01:00
parent afcf9aaa14
commit 7f0fb18716
5 changed files with 3 additions and 742 deletions

View File

@ -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

View File

@ -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:

View File

@ -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

View File

@ -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

View File

@ -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)
]