blob: cd2559927af15372f4f62845b61cf7dc9bbc38f0 (
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
56
57
58
59
60
61
62
63
64
65
66
|
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars.Schema
( character
, droid
, hero
, human
, schema
) where
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Data.Functor.Identity (Identity)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
import qualified Language.GraphQL.Type as Type
import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
schema = HashMap.singleton "Query" $ hero :| [human, droid]
hero :: Schema.Resolver Identity
hero = Schema.object "hero" $ do
episode <- argument "episode"
character $ case episode of
Schema.Enum "NEWHOPE" -> getHero 4
Schema.Enum "EMPIRE" -> getHero 5
Schema.Enum "JEDI" -> getHero 6
_ -> artoo
human :: Schema.Resolver Identity
human = Schema.wrappedObject "human" $ do
id' <- argument "id"
case id' of
Schema.String i -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
Nothing -> return Type.Null
Just e -> Type.Named <$> character e
_ -> ActionT $ throwE "Invalid arguments."
droid :: Schema.Resolver Identity
droid = Schema.object "droid" $ do
id' <- argument "id"
case id' of
Schema.String i -> character =<< getDroid i
_ -> ActionT $ throwE "Invalid arguments."
character :: Character -> ActionT Identity [Schema.Resolver Identity]
character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char
, Schema.wrappedObject "friends"
$ traverse character $ Type.List $ Type.Named <$> getFriends char
, Schema.wrappedScalar "appearsIn" $ return . Type.List
$ catMaybes (getEpisode <$> appearsIn char)
, Schema.scalar "secretBackstory" $ secretBackstory char
, Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
, Schema.scalar "__typename" $ return $ typeName char
]
|
