1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, (<$>), pure)
import Data.Traversable (traverse)
#endif
import Control.Applicative (Alternative, (<|>), empty, liftA2)
import Data.Maybe (catMaybes)
import Data.Aeson (object, (.=))
import Data.Text (Text)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=))
import Data.GraphQL
import Data.GraphQL.Schema
-- * Test
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
test :: TestTree
test = testGroup "Basic Queries"
[testCase "R2-D2"
$ graphql schema "query HeroNameQuery{hero{name}}"
@?= Just (object ["hero" .= object ["name" .= ("R2-D2" :: Text)]])
]
-- * Schema
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
type ID = Text
schema :: Alternative f => Schema f
schema = Schema query
query :: Alternative f => QueryRoot f
query (InputField "hero") = pure $ OutputResolver hero
query (InputField "human") = pure $ OutputResolver human
query (InputField "droid") = pure $ OutputResolver droid
query _ = empty
hero :: Alternative f => Resolver f
hero (InputList (InputScalar (ScalarInt ep) : inputFields)) =
withFields inputFields <$> getHero ep
hero (InputField fld) = characterOutput fld artoo
hero _ = empty
human :: Alternative f => Resolver f
human (InputList (InputScalar (ScalarID i) : inputFields)) =
withFields inputFields <$> getHuman i
human _ = empty
droid :: Alternative f => Resolver f
droid (InputList (InputScalar (ScalarID i) : inputFields)) =
withFields inputFields <$> getDroid i
droid _ = empty
characterOutput :: Alternative f => Text -> Character -> f (Output f)
characterOutput "id" char =
pure $ OutputScalar . pure . ScalarString $ id_ char
characterOutput "name" char =
pure $ OutputScalar . pure . ScalarString $ name char
characterOutput "friends" char =
-- TODO: Cleanup
pure . OutputList . pure $ OutputResolver . (\c (InputField f) ->
characterOutput f c) <$> getFriends char
characterOutput _ _ = empty
withFields :: Alternative f => [Input] -> Character -> Output f
withFields inputFields char =
OutputList . traverse (`characterOutput` char) $ fields inputFields
-- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
-- ** Characters
data Character = Character
{ id_ :: ID
, name :: Text
, friends :: [ID]
, appearsIn :: [Int]
, homePlanet :: Text
} deriving (Show)
luke :: Character
luke = Character
{ id_ = "1000"
, name = "Luke Skywalker"
, friends = ["1002","1003","2000","2001"]
, appearsIn = [4,5,6]
, homePlanet = "Tatoonie"
}
artoo :: Character
artoo = Character
{ id_ = "2001"
, name = "R2-D2"
, friends = ["1000","1002","1003"]
, appearsIn = [4,5,6]
, homePlanet = "Astrometch"
}
-- ** Helper functions
getHero :: Applicative f => Int -> f Character
getHero 5 = pure luke
getHero _ = pure artoo
getHeroIO :: Int -> IO Character
getHeroIO = getHero
getHuman :: Alternative f => ID -> f Character
getHuman "1000" = pure luke
-- getHuman "1001" = "vader"
-- getHuman "1002" = "han"
-- getHuman "1003" = "leia"
-- getHuman "1004" = "tarkin"
getHuman _ = empty
getDroid :: Alternative f => ID -> f Character
-- getDroid "2000" = "threepio"
getDroid "2001" = pure artoo
getDroid _ = empty
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
