Extend `execute` for deeper queries

The second graphql-js end-to-end test was ported and passed
successfully.

1 files changed, 89 insertions, 13 deletions

diff --git a/tests/Test/StarWars.hs b/tests/Test/StarWars.hs
index a6fa9ee..b3ab99e 100644
--- a/tests/Test/StarWars.hs
+++ b/tests/Test/StarWars.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
 module Test.StarWars where
 
 #if !MIN_VERSION_base(4,8,0)
 import Control.Applicative (Applicative, (<$>), pure)
+import Data.Monoid (mempty)
 import Data.Traversable (traverse)
 #endif
 import Control.Applicative (Alternative, (<|>), empty, liftA2)
@@ -12,6 +13,7 @@ import Data.Maybe (catMaybes)
 
 import Data.Aeson (object, (.=))
 import Data.Text (Text)
+import Text.RawString.QQ (r)
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
@@ -24,10 +26,40 @@ import Data.GraphQL.Schema
 
 test :: TestTree
 test = testGroup "Basic Queries"
-     [testCase "R2-D2"
-         $  graphql schema "query HeroNameQuery{hero{name}}"
-        @?= Just (object ["hero" .= object ["name" .= ("R2-D2" :: Text)]])
-     ]
+  [ testCase "R2-D2 hero" $ (@?=) (graphql schema [r|
+query HeroNameQuery {
+  hero {
+    id
+  }
+}|]) . Just
+     $ object [
+         "hero" .= object [
+              "id"   .= ("2001" :: Text)
+            ]
+         ]
+
+  , testCase "R2-D2 ID and friends" $ (@?=) (graphql schema [r|
+query HeroNameAndFriendsQuery {
+  hero {
+    id
+    name
+    friends {
+      name
+    }
+  }
+}|]) . Just
+     $ object [
+          "hero" .= object [
+               "id" .= ("2001" :: Text)
+             , "name" .= ("R2-D2" :: Text)
+             , "friends" .= [
+                    object ["name" .= ("Luke Skywalker" :: Text)]
+                  , object ["name" .= ("Han Solo" :: Text)]
+                  , object ["name" .= ("Leia Organa" :: Text)]
+                  ]
+             ]
+           ]
+  ]
 
 -- * Schema
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
@@ -45,7 +77,7 @@ query _ = empty
 
 hero :: Alternative f => Resolver f
 hero (InputList (InputScalar (ScalarInt ep) : inputFields)) =
-    withFields inputFields  <$> getHero ep
+    withFields inputFields <$> getHero ep
 hero (InputField fld) = characterOutput fld artoo
 hero _ = empty
 
@@ -65,7 +97,6 @@ characterOutput "id" char =
 characterOutput "name" char =
     pure $ OutputScalar . pure . ScalarString $ name char
 characterOutput "friends" char =
-    -- TODO: Cleanup
     pure . OutputList . pure $ OutputResolver . (\c (InputField f) ->
       characterOutput f c) <$> getFriends char
 characterOutput _ _ = empty
@@ -96,6 +127,51 @@ luke = Character
   , homePlanet = "Tatoonie"
   }
 
+vader :: Character
+vader = Character
+  { id_        = "1001"
+  , name       = "Darth Vader"
+  , friends    = ["1004"]
+  , appearsIn  = [4,5,6]
+  , homePlanet = "Tatooine"
+  }
+
+han :: Character
+han = Character
+  { id_        = "1002"
+  , name       = "Han Solo"
+  , friends    = ["1000","1003","2001" ]
+  , appearsIn  = [4,5,6]
+  , homePlanet = mempty
+  }
+
+leia :: Character
+leia = Character
+  { id_        = "1003"
+  , name       = "Leia Organa"
+  , friends    = ["1000","1002","2000","2001"]
+  , appearsIn  = [4,5,6]
+  , homePlanet = "Alderaan"
+  }
+
+tarkin :: Character
+tarkin = Character
+  { id_        = "1004"
+  , name       = "Wilhuff Tarkin"
+  , friends    = ["1001"]
+  , appearsIn  = [4]
+  , homePlanet = mempty
+  }
+
+threepio :: Character
+threepio = Character
+  { id_ = "2000"
+  , name = "C-3PO"
+  , friends = ["1000","1002","1003","2001" ]
+  , appearsIn = [ 4, 5, 6 ]
+  , homePlanet = "Protocol"
+  }
+
 artoo :: Character
 artoo = Character
   { id_        = "2001"
@@ -116,16 +192,16 @@ getHeroIO = getHero
 
 getHuman :: Alternative f => ID -> f Character
 getHuman "1000" = pure luke
--- getHuman "1001" = "vader"
--- getHuman "1002" = "han"
--- getHuman "1003" = "leia"
--- getHuman "1004" = "tarkin"
+getHuman "1001" = pure vader
+getHuman "1002" = pure han
+getHuman "1003" = pure leia
+getHuman "1004" = pure tarkin
 getHuman _      = empty
 
 getDroid :: Alternative f => ID -> f Character
--- getDroid "2000" = "threepio"
+getDroid "2000" = pure threepio
 getDroid "2001" = pure artoo
-getDroid _ = empty
+getDroid _      = empty
 
 getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char