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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
module Test.StarWars where
import Control.Applicative ((<|>), liftA2)
import Data.Maybe (catMaybes)
-- import Data.Functor.Identity (Identity(..))
import Data.Text (Text)
-- import Data.Aeson (ToJSON(toJSON), genericToJSON, defaultOptions)
import qualified Data.Aeson as Aeson
import Data.Attoparsec.Text (parseOnly)
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
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsQueryTests.js
test :: TestTree
test = testCase "R2-D2" $ execute schema heroQuery @?= expected
where
heroQuery :: Document
heroQuery = either (error "Parsing error") id $ parseOnly Parser.document
"query HeroNameQuery{hero{name}}"
expected :: Maybe Response
expected = Just $ Aeson.Object [("hero", Aeson.Object [("name", "R2-D2")])]
-- * Schema
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
type ID = Text
schema :: Schema
schema = Schema query
query :: QueryRoot
query (InputField "hero") = OutputResolver hero
query (InputField "human") = OutputResolver human
query (InputField "droid") = OutputResolver droid
query _ = OutputError
hero :: Resolver
hero (InputList (InputScalar (ScalarInt ep) : inputFields)) =
maybe OutputError (\char -> OutputList $ (`characterOutput` char) <$> fields inputFields) $ getHero ep
hero (InputField fld) = characterOutput fld artoo
hero _ = OutputError
human :: Resolver
human (InputList (InputScalar (ScalarID i) : inputFields)) =
maybe OutputError (\char -> OutputList $ (`characterOutput` char) <$> fields inputFields) $ getHuman i
human _ = OutputError
droid :: Resolver
droid (InputList (InputScalar (ScalarID i) : inputFields)) =
maybe OutputError (\char -> OutputList $ (`characterOutput` char) <$> fields inputFields) $ getDroid i
droid _ = OutputError
characterOutput :: Text -> Character -> Output
characterOutput "id" char = OutputScalar . ScalarString $ id_ char
characterOutput "name" char = OutputScalar . ScalarString $ name char
characterOutput "friends" char = OutputList $ OutputResolver . (\c (InputField f) -> characterOutput f c) <$> getFriends char
characterOutput _ _ = OutputError
-- * 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 :: Int -> Maybe Character
getHero 5 = Just luke
getHero _ = Just artoo
getHuman :: ID -> Maybe Character
getHuman "1000" = Just luke
-- getHuman "1001" = "vader"
-- getHuman "1002" = "han"
-- getHuman "1003" = "leia"
-- getHuman "1004" = "tarkin"
getHuman _ = Nothing
getDroid :: ID -> Maybe Character
-- getDroid "2000" = "threepio"
getDroid "2001" = Just artoo
getDroid _ = Nothing
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
