From 4e5dc3433a53c2e0404fd2adb9fb33c898d1afa6 Mon Sep 17 00:00:00 2001
From: Danny Navarro <j@dannynavarro.net>
Date: Mon, 19 Oct 2015 12:19:39 +0200
Subject: [PATCH] Implement first StarWars end-to-end test

`execute` still needs to be implemented.
---
 Data/GraphQL/Execute.hs |  6 ++--
 Data/GraphQL/Schema.hs  | 27 +++++++---------
 graphql.cabal           |  1 +
 tests/Test/StarWars.hs  | 70 +++++++++++++++++++++++++++--------------
 tests/tasty.hs          |  9 ++++--
 5 files changed, 71 insertions(+), 42 deletions(-)

diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs
index 9951144..06dc9a6 100644
--- a/Data/GraphQL/Execute.hs
+++ b/Data/GraphQL/Execute.hs
@@ -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
diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs
index 8d4e1d6..37938ee 100644
--- a/Data/GraphQL/Schema.hs
+++ b/Data/GraphQL/Schema.hs
@@ -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
-            | InputError
+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)
diff --git a/graphql.cabal b/graphql.cabal
index 752d2ae..e32b593 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -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,
diff --git a/tests/Test/StarWars.hs b/tests/Test/StarWars.hs
index 829411c..ffafd66 100644
--- a/tests/Test/StarWars.hs
+++ b/tests/Test/StarWars.hs
@@ -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
 
diff --git a/tests/tasty.hs b/tests/tasty.hs
index a034a79..1dd9466 100644
--- a/tests/tasty.hs
+++ b/tests/tasty.hs
@@ -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
+