Implement type instrospection tests

The main intention with this commit is to show a poor's man way to support type
instrospection.

tests/Test/StarWars/Data.hs

@@ -1,11 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Data where
 
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>), pure)
 import Data.Monoid (mempty)
-#endif
 import Control.Applicative (Alternative, (<|>), empty, liftA2)
 import Data.Maybe (catMaybes)
 
@@ -38,8 +34,6 @@ data Droid = Droid
 
 type Character = Either Droid Human
 
--- I still don't think this is cumbersome enough to bring lens
-
 id_ :: Character -> ID
 id_ (Left  x) = _id_ . _droidChar $ x
 id_ (Right x) = _id_ . _humanChar $ x
@@ -59,6 +53,9 @@ appearsIn (Right x) = _appearsIn . _humanChar $ x
 secretBackstory :: Character -> Text
 secretBackstory = error "secretBackstory is secret."
 
+typeName :: Character -> Text
+typeName = either (const "Droid") (const "Human")
+
 luke :: Character
 luke = Right luke'
 

tests/Test/StarWars/QueryTests.hs

@@ -250,7 +250,7 @@ test = testGroup "Star Wars Query Tests"
             }
           |]
     $ object ["data" .= object [
-        "hero" .= ["__typename" .= ("Droid" :: Text), r2d2Name]
+        "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
       ]]
     , testCase "Luke is a human" . testQuery
         [r| query CheckTypeOfLuke {
@@ -261,7 +261,7 @@ test = testGroup "Star Wars Query Tests"
             }
           |]
     $ object ["data" .= object [
-        "hero" .= ["__typename" .= ("Human" :: Text), lukeName]
+        "hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
       ]]
     ]
     , testGroup "Errors in resolvers"
@@ -293,7 +293,7 @@ test = testGroup "Star Wars Query Tests"
             |]
       $ object ["data" .= object [
           "hero" .= [r2d2Name, "friends" .= [
-              object [lukeName, secretBackstory]
+            object [lukeName, secretBackstory]
           , object [hanName, secretBackstory]
           , object [leiaName, secretBackstory]
           ]]

tests/Test/StarWars/Schema.hs

@@ -19,7 +19,10 @@ schema = hero :| [human, droid]
 hero :: Alternative f => Resolver f
 hero = Schema.objectA "hero" $ \case
   [] -> character artoo
-  [Argument "episode" (ValueInt n)] -> character . getHero $ fromIntegral n
+  [Argument "episode" (ValueInt n)]   -> character . getHero $ fromIntegral n
+  [Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4
+  [Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5
+  [Argument "episode" (ValueEnum "JEDI"   )] -> character $ getHero 6
   _ -> empty
 
 human :: Alternative f => Resolver f
@@ -40,4 +43,5 @@ character char =
   , Schema.enum   "appearsIn"       . traverse getEpisode $ appearsIn char
   , Schema.scalar "secretBackstory" $ secretBackstory char
   , Schema.scalar "homePlanet"      $ either mempty homePlanet char
+  , Schema.scalar "__typename"      $ typeName char
   ]