Skip to content

Commit bed8382

Browse files
jmljml
committed
Move InputObject doctests into EndToEndTests
1 parent 5357f3b commit bed8382

File tree

1 file changed

+60
-21
lines changed

1 file changed

+60
-21
lines changed

‎tests/EndToEndTests.hs

Lines changed: 60 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DeriveGeneric #-}
23
{-# LANGUAGE QuasiQuotes #-}
4+
{-# LANGUAGE TypeOperators #-}
35
-- | Tests that span the entire system.
46
--
57
-- These tests function both as examples of how to use the API, as well as
@@ -11,10 +13,10 @@ import Protolude
1113
import Data.Aeson (Value(Null), toJSON, object, (.=))
1214
import qualified Data.Map as Map
1315
import GraphQL (makeSchema, compileQuery, executeQuery, interpretAnonymousQuery, interpretQuery)
14-
import GraphQL.API (Object, Field)
16+
import GraphQL.API (Object, Field, Argument, (:>), Defaultable(..), HasAnnotatedInputType(..))
1517
import GraphQL.Internal.Syntax.AST (Variable(..))
1618
import GraphQL.Resolver ((:<>)(..), Handler)
17-
import GraphQL.Value (ToValue(..), makeName)
19+
import GraphQL.Value (ToValue(..), FromValue(..), makeName)
1820
import Test.Tasty (TestTree)
1921
import Test.Tasty.Hspec (testSpec, describe, it, shouldBe)
2022
import Text.RawString.QQ (r)
@@ -26,14 +28,27 @@ import ExampleSchema
2628
-- @
2729
-- type QueryRoot {
2830
-- dog: Dog
31+
-- describeDog(dog: DEFAULT): String
2932
-- }
3033
-- @
3134
--
3235
-- Drawn from <https://facebook.github.io/graphql/#sec-Validation>.
3336
type QueryRoot = Object "QueryRoot" '[]
3437
'[ Field "dog" Dog
38+
, Argument "dog" DogStuff :> Field "describeDog" Text
3539
]
3640

41+
-- | An object that is passed as an argument. i.e. an input object.
42+
--
43+
-- TODO: Ideally this would be Dog itself, or ServerDog at worst.
44+
-- Unfortunately, jml cannot figure out how to do that.
45+
data DogStuff = DogStuff { toy :: Text, likesTreats :: Bool } deriving (Show, Generic)
46+
instance FromValue DogStuff
47+
instance HasAnnotatedInputType DogStuff
48+
instance Defaultable DogStuff where
49+
defaultFor "dog" = pure DogStuff { toy = "shoe", likesTreats = False }
50+
defaultFor _ = empty
51+
3752
-- | Our server's internal representation of a 'Dog'.
3853
data ServerDog
3954
= ServerDog
@@ -66,6 +81,14 @@ viewServerDog dog@ServerDog{..} = pure $
6681
pure . isHouseTrained dog :<>
6782
viewServerHuman owner
6883

84+
describeDog :: DogStuff -> Handler IO Text
85+
describeDog (DogStuff toy likesTreats)
86+
| likesTreats = pure $ "likes treats and their favorite toy is a " <> toy
87+
| otherwise = pure $ "their favorite toy is a " <> toy
88+
89+
rootHandler :: ServerDog -> Handler IO QueryRoot
90+
rootHandler dog = pure $ viewServerDog dog :<> describeDog
91+
6992
-- | jml has a stuffed black dog called "Mortgage".
7093
mortgage :: ServerDog
7194
mortgage = ServerDog
@@ -90,18 +113,18 @@ viewServerHuman (ServerHuman name) = pure (pure name)
90113
jml :: ServerHuman
91114
jml = ServerHuman "jml"
92115

116+
93117
tests :: IO TestTree
94118
tests = testSpec "End-to-end tests" $ do
95119
describe "interpretAnonymousQuery" $ do
96120
it "Handles the simplest possible valid query" $ do
97-
let root = pure (viewServerDog mortgage)
98121
let query = [r|{
99122
dog {
100123
name
101124
}
102125
}
103126
|]
104-
response <- interpretAnonymousQuery @QueryRoot root query
127+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
105128
let expected =
106129
object
107130
[ "data" .= object
@@ -112,15 +135,14 @@ tests = testSpec "End-to-end tests" $ do
112135
]
113136
toJSON (toValue response) `shouldBe` expected
114137
it "Handles more than one field" $ do
115-
let root = pure (viewServerDog mortgage)
116138
let query = [r|{
117139
dog {
118140
name
119141
barkVolume
120142
}
121143
}
122144
|]
123-
response <- interpretAnonymousQuery @QueryRoot root query
145+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
124146
let expected =
125147
object
126148
[ "data" .= object
@@ -132,7 +154,6 @@ tests = testSpec "End-to-end tests" $ do
132154
]
133155
toJSON (toValue response) `shouldBe` expected
134156
it "Handles nested queries" $ do
135-
let root = pure (viewServerDog mortgage)
136157
let query = [r|{
137158
dog {
138159
name
@@ -142,7 +163,7 @@ tests = testSpec "End-to-end tests" $ do
142163
}
143164
}
144165
|]
145-
response <- interpretAnonymousQuery @QueryRoot root query
166+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
146167
let expected =
147168
object
148169
[ "data" .= object
@@ -156,7 +177,6 @@ tests = testSpec "End-to-end tests" $ do
156177
]
157178
toJSON (toValue response) `shouldBe` expected
158179
it "It aliases fields" $ do
159-
let root = pure (viewServerDog mortgage)
160180
let query = [r|{
161181
dog {
162182
name
@@ -166,7 +186,7 @@ tests = testSpec "End-to-end tests" $ do
166186
}
167187
}
168188
|]
169-
response <- interpretAnonymousQuery @QueryRoot root query
189+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
170190
let expected =
171191
object
172192
[ "data" .= object
@@ -180,15 +200,14 @@ tests = testSpec "End-to-end tests" $ do
180200
]
181201
toJSON (toValue response) `shouldBe` expected
182202
it "Passes arguments to functions" $ do
183-
let root = pure (viewServerDog mortgage)
184203
let query = [r|{
185204
dog {
186205
name
187206
doesKnowCommand(dogCommand: Sit)
188207
}
189208
}
190209
|]
191-
response <- interpretAnonymousQuery @QueryRoot root query
210+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
192211
let expected =
193212
object
194213
[ "data" .= object
@@ -199,8 +218,31 @@ tests = testSpec "End-to-end tests" $ do
199218
]
200219
]
201220
toJSON (toValue response) `shouldBe` expected
221+
it "Passes arguments that are objects to functions" $ do
222+
let query = [r|{
223+
describeDog(dog: {toy: "bone", likesTreats: true})
224+
}
225+
|]
226+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
227+
let expected =
228+
object
229+
[ "data" .= object
230+
[ "describeDog" .= ("likes treats and their favorite toy is a bone" :: Text) ]
231+
]
232+
toJSON (toValue response) `shouldBe` expected
233+
it "Passes default arguments that are objects to functions" $ do
234+
let query = [r|{
235+
describeDog
236+
}
237+
|]
238+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
239+
let expected =
240+
object
241+
[ "data" .= object
242+
[ "describeDog" .= ("their favorite toy is a shoe" :: Text) ]
243+
]
244+
toJSON (toValue response) `shouldBe` expected
202245
it "Handles fairly complex queries" $ do
203-
let root = pure (viewServerDog mortgage)
204246
-- TODO: jml would like to put some union checks in here, but we don't
205247
-- have any unions reachable from Dog!
206248
let query = [r|{
@@ -221,7 +263,7 @@ tests = testSpec "End-to-end tests" $ do
221263
}
222264
}
223265
|]
224-
response <- interpretAnonymousQuery @QueryRoot root query
266+
response <- interpretAnonymousQuery @QueryRoot (rootHandler mortgage) query
225267
let expected =
226268
object
227269
[ "data" .= object
@@ -236,14 +278,13 @@ tests = testSpec "End-to-end tests" $ do
236278
toJSON (toValue response) `shouldBe` expected
237279
describe "interpretQuery" $ do
238280
it "Handles the simplest named query" $ do
239-
let root = pure (viewServerDog mortgage)
240281
let query = [r|query myQuery {
241282
dog {
242283
name
243284
}
244285
}
245286
|]
246-
response <- interpretQuery @QueryRoot root query Nothing mempty
287+
response <- interpretQuery @QueryRoot (rootHandler mortgage) query Nothing mempty
247288
let expected =
248289
object
249290
[ "data" .= object
@@ -254,15 +295,14 @@ tests = testSpec "End-to-end tests" $ do
254295
]
255296
toJSON (toValue response) `shouldBe` expected
256297
it "Allows calling query by name" $ do
257-
let root = pure (viewServerDog mortgage)
258298
let query = [r|query myQuery {
259299
dog {
260300
name
261301
}
262302
}
263303
|]
264304
let Right name = makeName "myQuery"
265-
response <- interpretQuery @QueryRoot root query (Just name) mempty
305+
response <- interpretQuery @QueryRoot (rootHandler mortgage) query (Just name) mempty
266306
let expected =
267307
object
268308
[ "data" .= object
@@ -273,7 +313,6 @@ tests = testSpec "End-to-end tests" $ do
273313
]
274314
toJSON (toValue response) `shouldBe` expected
275315
describe "Handles variables" $ do
276-
let root = pure (viewServerDog mortgage)
277316
let Right schema = makeSchema @Dog
278317
let Right query =
279318
compileQuery schema
@@ -285,7 +324,7 @@ tests = testSpec "End-to-end tests" $ do
285324
}
286325
|]
287326
it "Errors when no variables provided" $ do
288-
response <- executeQuery @QueryRoot root query Nothing mempty
327+
response <- executeQuery @QueryRoot (rootHandler mortgage) query Nothing mempty
289328
let expected =
290329
object
291330
[ "data" .= object
@@ -315,7 +354,7 @@ tests = testSpec "End-to-end tests" $ do
315354
-- <https://github.com/jml/graphql-api/issues/96>
316355
let Right varName = makeName "whichCommand"
317356
let vars = Map.singleton (Variable varName) (toValue Sit)
318-
response <- executeQuery @QueryRoot root query Nothing vars
357+
response <- executeQuery @QueryRoot (rootHandler mortgage) query Nothing vars
319358
let expected =
320359
object
321360
[ "data" .= object

0 commit comments

Comments
 (0)