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
132
133
134
135
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
module Test.StarWars where
import Data.Functor.Identity (Identity(..))
import Data.Text (Text)
import Data.Attoparsec.Text (parseOnly)
import qualified Data.Aeson as Aeson
import Test.Tasty (TestTree)
import Test.Tasty.HUnit
import Data.GraphQL.AST
import Data.GraphQL.Execute
import qualified Data.GraphQL.Parser as Parser
import Data.GraphQL.Schema
-- * Test
test :: TestTree
test = testCase "R2-D2" $ execute schema heroQuery @=? Identity expected
where
heroQuery :: Document
heroQuery = either (error "Parsing error") id $ parseOnly Parser.document
"{ query HeroNameQuery { hero { name } } }"
expected :: Response
expected = Aeson.Object
[ ( "hero" , Aeson.Object [ ("name", "R2-D2") ] ) ]
-- * Schema
type ID = Text
schema :: Applicative f => Schema f
schema = Schema query Nothing
query :: Applicative f => QueryRoot f
query = [ ("hero", hero)
, ("human", human)
, ("droid", droid)
]
hero :: Applicative f => Resolver f
hero (InputScalar (ScalarInt ep)) = OutputMap $ getHeroF ep
hero _ = InputError
human :: Applicative f => Resolver f
human (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getHumanF id_
human _ = InputError
droid :: Applicative f => Resolver f
droid (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getDroidF id_
droid _ = InputError
-- * Data
-- ** Characters
data Character = Character
{ id_ :: ID
, name :: Text
, friends :: [ID]
, appearsIn :: [Int]
, homePlanet :: Text
}
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"
}
type CharacterMap f = Map f
character :: Applicative f => Character -> CharacterMap f
character (Character{..}) =
[ ("id_", const . OutputScalar . pure $ ScalarID id_)
, ("name", const . OutputScalar . pure $ ScalarString name)
, ("friends", const . OutputList $ OutputScalar . pure . ScalarID <$> friends)
, ("appearsIn", const . OutputList $ OutputScalar . pure . ScalarInt <$> appearsIn)
, ("homePlanet", const . OutputScalar . pure $ ScalarString homePlanet)
]
-- ** Hero
getHero :: Int -> Character
getHero 5 = luke
getHero _ = artoo
getHeroF :: Applicative f => Int -> CharacterMap f
getHeroF = character . getHero
-- ** Human
getHuman :: ID -> Text
getHuman "1000" = "luke"
getHuman "1001" = "vader"
getHuman "1002" = "han"
getHuman "1003" = "leia"
getHuman "1004" = "tarkin"
getHuman _ = ""
getHumanF :: Applicative f => ID -> f Text
getHumanF = pure . getHuman
getHumanIO :: ID -> IO Text
getHumanIO = getHumanF
-- ** Droid
getDroid :: ID -> Text
getDroid "2000" = "threepio"
getDroid "2001" = "artoo"
getDroid _ = ""
getDroidF :: Applicative f => ID -> f Text
getDroidF = pure . getDroid
getDroidIO :: ID -> IO Text
getDroidIO = getDroidF
|
