Test fixtures for Schema toplevel
This includes simplications to the Schema data types.
This commit is contained in:
111
tests/Test/StarWars.hs
Normal file
111
tests/Test/StarWars.hs
Normal file
@ -0,0 +1,111 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Test.StarWars where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Data.HashMap.Lazy (HashMap)
|
||||
import Data.GraphQL.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 => Input -> f Output
|
||||
hero (InputScalar (ScalarInt ep)) = OutputObject <$> getHeroF ep
|
||||
hero _ = pure InputError
|
||||
|
||||
human :: Applicative f => Input -> f Output
|
||||
human (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getHumanF id_
|
||||
human _ = pure InputError
|
||||
|
||||
droid :: Applicative f => Input -> f Output
|
||||
droid (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getDroidF id_
|
||||
droid _ = pure 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 CharacterObject = HashMap Text Output
|
||||
|
||||
character :: Character -> CharacterObject
|
||||
character (Character{..}) =
|
||||
[ ("id_", OutputScalar $ ScalarID id_)
|
||||
, ("name", OutputScalar $ ScalarString name)
|
||||
, ("friends", OutputList $ OutputScalar . ScalarID <$> friends)
|
||||
, ("appearsIn", OutputList $ OutputScalar . ScalarInt <$> appearsIn)
|
||||
, ("homePlanet", OutputScalar $ ScalarString homePlanet)
|
||||
]
|
||||
|
||||
-- ** Hero
|
||||
|
||||
getHero :: Int -> CharacterObject
|
||||
getHero 5 = character luke
|
||||
getHero _ = character artoo
|
||||
|
||||
getHeroF :: Applicative f => Int -> f CharacterObject
|
||||
getHeroF = pure . 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
|
Reference in New Issue
Block a user