Implement first StarWars end-to-end test

`execute` still needs to be implemented.
This commit is contained in:
Danny Navarro 2015-10-19 12:19:39 +02:00
parent 3f30a44d1d
commit 4e5dc3433a
5 changed files with 71 additions and 42 deletions

View File

@ -10,5 +10,7 @@ import qualified Data.Aeson as Aeson (Value)
import Data.GraphQL.AST
import Data.GraphQL.Schema
execute :: Applicative f => Schema -> Document -> f Aeson.Value
execute = undefined
type Response = Aeson.Value
execute :: Applicative f => Schema f -> Document -> f Response
execute _schema _doc = undefined

View File

@ -5,26 +5,25 @@ import Data.HashMap.Lazy (HashMap)
data Schema f = Schema (QueryRoot f) (Maybe (MutationRoot f))
type QueryRoot f = Object f
type QueryRoot f = Map f
type MutationRoot f = Object f
type MutationRoot f = Map f
type Object f = HashMap Text (Input -> f Output)
type Map f = HashMap Text (Resolver f)
type ObjectInput = HashMap Text Input
type Resolver f = Input -> Output f
data Output = OutputScalar Scalar
| OutputObject (HashMap Text Output)
| OutputUnion [Output]
| OutputEnum Scalar
| OutputList [Output]
| OutputNonNull Output
data Output f = OutputScalar (f Scalar)
| OutputMap (Map f)
| OutputUnion [Map f]
| OutputEnum (f Scalar)
| OutputList [Output f]
| OutputNonNull (Output f)
| InputError
data Input = InputScalar Scalar
| InputObject ObjectInput
| InputEnum Scalar
| InputList [Output]
| InputList [Input]
| InputNonNull Input
data Scalar = ScalarInt Int
@ -32,5 +31,3 @@ data Scalar = ScalarInt Int
| ScalarString Text
| ScalarBool Bool
| ScalarID Text
newtype Interface f = Interface (Object f)

View File

@ -42,6 +42,7 @@ test-suite tasty
other-modules: Paths_graphql
Test.StarWars
build-depends: base >=4.6 && <5,
aeson >=0.7.0.3,
text >=0.11.3.1,
attoparsec >=0.10.4.0,
tasty >=0.10,

View File

@ -3,10 +3,35 @@
{-# LANGUAGE RecordWildCards #-}
module Test.StarWars where
import Data.Functor.Identity (Identity(..))
import Data.Text (Text)
import Data.HashMap.Lazy (HashMap)
import Data.Attoparsec.Text (parseOnly)
import qualified Data.Aeson as Aeson
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
test :: TestTree
test = testCase "R2-D2" $ execute schema heroQuery @=? Identity expected
where
heroQuery :: Document
heroQuery = either (error "Parsing error") id $ parseOnly Parser.document
"{ query HeroNameQuery { hero { name } } }"
expected :: Response
expected = Aeson.Object
[ ( "hero" , Aeson.Object [ ("name", "R2-D2") ] ) ]
-- * Schema
type ID = Text
schema :: Applicative f => Schema f
@ -18,23 +43,22 @@ query = [ ("hero", hero)
, ("droid", droid)
]
hero :: Applicative f => Input -> f Output
hero (InputScalar (ScalarInt ep)) = OutputObject <$> getHeroF ep
hero _ = pure InputError
hero :: Applicative f => Resolver f
hero (InputScalar (ScalarInt ep)) = OutputMap $ getHeroF ep
hero _ = InputError
human :: Applicative f => Input -> f Output
human (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getHumanF id_
human _ = pure InputError
human :: Applicative f => Resolver f
human (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getHumanF id_
human _ = InputError
droid :: Applicative f => Input -> f Output
droid (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getDroidF id_
droid _ = pure InputError
droid :: Applicative f => Resolver f
droid (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getDroidF id_
droid _ = InputError
-- * Data
-- ** Characters
data Character = Character
{ id_ :: ID
, name :: Text
@ -61,25 +85,25 @@ artoo = Character
, homePlanet = "Astrometch"
}
type CharacterObject = HashMap Text Output
type CharacterMap f = Map f
character :: Character -> CharacterObject
character :: Applicative f => Character -> CharacterMap f
character (Character{..}) =
[ ("id_", OutputScalar $ ScalarID id_)
, ("name", OutputScalar $ ScalarString name)
, ("friends", OutputList $ OutputScalar . ScalarID <$> friends)
, ("appearsIn", OutputList $ OutputScalar . ScalarInt <$> appearsIn)
, ("homePlanet", OutputScalar $ ScalarString homePlanet)
[ ("id_", const . OutputScalar . pure $ ScalarID id_)
, ("name", const . OutputScalar . pure $ ScalarString name)
, ("friends", const . OutputList $ OutputScalar . pure . ScalarID <$> friends)
, ("appearsIn", const . OutputList $ OutputScalar . pure . ScalarInt <$> appearsIn)
, ("homePlanet", const . OutputScalar . pure $ ScalarString homePlanet)
]
-- ** Hero
getHero :: Int -> CharacterObject
getHero 5 = character luke
getHero _ = character artoo
getHero :: Int -> Character
getHero 5 = luke
getHero _ = artoo
getHeroF :: Applicative f => Int -> f CharacterObject
getHeroF = pure . getHero
getHeroF :: Applicative f => Int -> CharacterMap f
getHeroF = character . getHero
-- ** Human

View File

@ -8,16 +8,20 @@ import Control.Applicative ((<$>), (<*>))
import Data.Attoparsec.Text (parseOnly)
import qualified Data.Text.IO as Text
import Test.Tasty (defaultMain)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit
import qualified Data.GraphQL.Parser as Parser
import qualified Data.GraphQL.Encoder as Encoder
import qualified Test.StarWars as SW
import Paths_graphql (getDataFileName)
main :: IO ()
main = defaultMain =<< testCase "Kitchen Sink"
main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< ksTest
ksTest :: IO TestTree
ksTest = testCase "Kitchen Sink"
<$> (assertEqual "Encode" <$> expected <*> actual)
where
expected = Text.readFile
@ -26,3 +30,4 @@ main = defaultMain =<< testCase "Kitchen Sink"
actual = either (error "Parsing error!") Encoder.document
<$> parseOnly Parser.document
<$> expected