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
|
||||
--
|
||||
-- hash: ddb79ddbd13b917f320fff372b4a29b63b6eb0ed113ca732c1d779b4e6a296d8
|
||||
-- hash: c943c792ef9717e8305e22059e7244a0a471b6d26a53e6e4dc162e4f4a6110b4
|
||||
|
||||
name: graphql
|
||||
version: 0.10.0.0
|
||||
|
|
@ -74,7 +74,7 @@ library
|
|||
, unordered-containers
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite tasty
|
||||
test-suite graphql-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
|
|
@ -89,9 +89,6 @@ test-suite tasty
|
|||
Test.DirectiveSpec
|
||||
Test.FragmentSpec
|
||||
Test.RootOperationSpec
|
||||
Test.StarWars.Data
|
||||
Test.StarWars.QuerySpec
|
||||
Test.StarWars.Schema
|
||||
Paths_graphql
|
||||
hs-source-dirs:
|
||||
tests
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ library:
|
|||
- Language.GraphQL.Validate.Rules
|
||||
|
||||
tests:
|
||||
tasty:
|
||||
graphql-test:
|
||||
main: Spec.hs
|
||||
source-dirs: tests
|
||||
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