1 files changed, 39 insertions, 53 deletions
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 57c1b24..1cd8f42 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,17 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Test.StarWars.Schema where
 
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative (pure)
-import Data.Traversable (traverse)
-#endif
-import Control.Applicative (Alternative, empty)
-import Data.Foldable (fold)
-
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Text (Text)
+import Control.Applicative ((<|>), Alternative, empty)
 
 import Data.GraphQL.Schema
 
@@ -23,47 +13,43 @@ import Test.StarWars.Data
 schema :: (Alternative m, Monad m) => Schema m
 schema = Schema query
 
-query :: (Alternative m, Monad m) => QueryRoot m
-query (InputField "hero"  args ins) = hero  args ins
-query (InputField "human" args ins) = human args ins
-query (InputField "droid" args ins) = droid args ins
-query _ = empty
+query :: (Alternative m, Monad m) => ResolverM m
+query fld =
+      withField "hero"  hero  fld
+  <|> withField "human" human fld
+  <|> withField "droid" droid fld
 
-hero :: Alternative f => [Argument] -> [Input] -> f Output
+hero :: Alternative f => [Argument] -> ResolverO f
 hero [] = characterFields artoo
-hero [("episode", ScalarInt n)] = characterFields $ getHero n
-hero _ = const empty
-
-human :: (Alternative m, Monad m) => [Argument] -> [Input] -> m Output
-human [("id", ScalarString i)] ins = flip characterFields ins =<< getHuman i
-human _ _ = empty
-
-droid :: (Alternative m, Monad m) => [Argument] -> [Input] -> m Output
-droid [("id", ScalarString i)] ins = flip characterFields ins =<< getDroid i
-droid _ _ = empty
-
-episode :: Alternative f => Int -> f Output
-episode 4 = pure $ OutputEnum "NEWHOPE"
-episode 5 = pure $ OutputEnum "EMPIRE"
-episode 6 = pure $ OutputEnum "JEDI"
-episode _ = empty
-
-characterField :: Alternative f => Character -> Input -> f (HashMap Text Output)
-characterField char (InputField "id" [] [])  =
-   pure . HashMap.singleton "id" . OutputScalar . ScalarString . id_ $ char
-characterField char (InputField "name" [] []) =
-   pure . HashMap.singleton "name" . OutputScalar . ScalarString . name $ char
-characterField char (InputField "friends" [] ins) =
-     fmap (HashMap.singleton "friends" . OutputList)
-   . traverse (`characterFields` ins)
-   . getFriends
-   $ char
-characterField char (InputField "appearsIn" [] []) =
-     fmap (HashMap.singleton "appearsIn" . OutputList)
-   . traverse episode
-   . appearsIn
-   $ char
-characterField _ _ = empty
-
-characterFields :: Alternative f => Character -> [Input] -> f Output
-characterFields char = fmap (OutputObject . fold) . traverse (characterField char)
+hero args =
+  case withArgument "episode" args of
+       Just (ScalarInt n) -> characterFields $ getHero n
+       _ -> const empty
+
+human :: (Alternative m, Monad m) => [Argument] -> ResolverO m
+human args flds =
+  case withArgument "id" args of
+       Just (ScalarString i) -> flip characterFields flds =<< getHuman i
+       _ -> empty
+
+droid :: (Alternative m, Monad m) => [Argument] -> ResolverO m
+droid args flds =
+   case withArgument "id" args of
+        Just (ScalarString i) -> flip characterFields flds =<< getDroid i
+        _ -> empty
+
+characterField :: Alternative f => Character -> ResolverM f
+characterField char fld =
+      withFieldFinal "id"        (OutputScalar . ScalarString . id_ $ char) fld
+  <|> withFieldFinal "name"      (OutputScalar . ScalarString . name $ char) fld
+  <|> withField      "friends"   friends' fld
+  <|> withField      "appearsIn" appears' fld
+  where
+    friends' [] flds = outputTraverse (`characterFields` flds) $ getFriends char
+    friends' _ _ = empty
+
+    appears' [] [] = outputTraverse (fmap OutputEnum . getEpisode) $ appearsIn char
+    appears' _ _ = empty
+
+characterFields :: Alternative f => Character -> ResolverO f
+characterFields = withFields . characterField