blob: 1cd8f426018ac8bbeb04816fea944566d3ecec4c (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars.Schema where
import Control.Applicative ((<|>), Alternative, empty)
import Data.GraphQL.Schema
import Test.StarWars.Data
-- * Schema
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
schema :: (Alternative m, Monad m) => Schema m
schema = Schema query
query :: (Alternative m, Monad m) => ResolverM m
query fld =
withField "hero" hero fld
<|> withField "human" human fld
<|> withField "droid" droid fld
hero :: Alternative f => [Argument] -> ResolverO f
hero [] = characterFields artoo
hero args =
case withArgument "episode" args of
Just (ScalarInt n) -> characterFields $ getHero n
_ -> const empty
human :: (Alternative m, Monad m) => [Argument] -> ResolverO m
human args flds =
case withArgument "id" args of
Just (ScalarString i) -> flip characterFields flds =<< getHuman i
_ -> empty
droid :: (Alternative m, Monad m) => [Argument] -> ResolverO m
droid args flds =
case withArgument "id" args of
Just (ScalarString i) -> flip characterFields flds =<< getDroid i
_ -> empty
characterField :: Alternative f => Character -> ResolverM f
characterField char fld =
withFieldFinal "id" (OutputScalar . ScalarString . id_ $ char) fld
<|> withFieldFinal "name" (OutputScalar . ScalarString . name $ char) fld
<|> withField "friends" friends' fld
<|> withField "appearsIn" appears' fld
where
friends' [] flds = outputTraverse (`characterFields` flds) $ getFriends char
friends' _ _ = empty
appears' [] [] = outputTraverse (fmap OutputEnum . getEpisode) $ appearsIn char
appears' _ _ = empty
characterFields :: Alternative f => Character -> ResolverO f
characterFields = withFields . characterField
|
