Define resolvers on type fields

Returning resolvers from other resolvers isn't supported anymore. Since
we have a type system now, we define the resolvers in the object type
fields and pass an object with the previous result to them.

1 files changed, 53 insertions, 33 deletions

diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index e58d33b..0ab10ec 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,24 +1,22 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Test.StarWars.Schema
-    ( character
-    , droid
-    , hero
-    , human
-    , schema
+    ( schema
     ) where
 
+import Control.Monad.Trans.Reader (asks)
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Data.Functor.Identity (Identity)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
-import qualified Language.GraphQL.Schema as Schema
+import Data.Text (Text)
 import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
-import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
 import Test.StarWars.Data
+import Prelude hiding (id)
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
@@ -26,50 +24,72 @@ schema :: Schema Identity
 schema = Schema { query = queryType, mutation = Nothing }
   where
     queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
-        [ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
-        , ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
-        , ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
+        [ ("hero", Out.Field Nothing (Out.NamedObjectType heroObject) mempty hero)
+        , ("human", Out.Field Nothing (Out.NamedObjectType heroObject) mempty human)
+        , ("droid", Out.Field Nothing (Out.NamedObjectType droidObject) mempty droid)
         ]
 
-hero :: ActionT Identity (Out.Value Identity)
+heroObject :: Out.ObjectType Identity
+heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
+    [ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
+    , ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
+    , ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType heroObject) mempty (idField "friends"))
+    , ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
+    , ("homePlanet", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "homePlanet"))
+    , ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
+    , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
+    ]
+
+droidObject :: Out.ObjectType Identity
+droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
+    [ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
+    , ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
+    , ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty (idField "friends"))
+    , ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
+    , ("primaryFunction", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "primaryFunction"))
+    , ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
+    , ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
+    ]
+
+idField :: Text -> ActionT Identity Value
+idField f = do
+    v <- ActionT $ lift $ asks values
+    let (Object v') = v
+    pure $ v' HashMap.! f
+
+hero :: ActionT Identity Value
 hero = do
   episode <- argument "episode"
   pure $ character $ case episode of
-      In.Enum "NEWHOPE" -> getHero 4
-      In.Enum "EMPIRE" -> getHero 5
-      In.Enum "JEDI" -> getHero 6
+      Enum "NEWHOPE" -> getHero 4
+      Enum "EMPIRE" -> getHero 5
+      Enum "JEDI" -> getHero 6
       _ -> artoo
 
-human :: ActionT Identity (Out.Value Identity)
+human :: ActionT Identity Value
 human = do
     id' <- argument "id"
     case id' of
-        In.String i -> do
+        String i -> do
             humanCharacter <- lift $ return $ getHuman i >>= Just
             case humanCharacter of
-                Nothing -> pure Out.Null
+                Nothing -> pure Null
                 Just e -> pure $ character e
         _ -> ActionT $ throwE "Invalid arguments."
 
-droid :: ActionT Identity (Out.Value Identity)
+droid :: ActionT Identity Value
 droid = do
     id' <- argument "id"
     case id' of
-        In.String i -> character <$> getDroid i
+        String i -> character <$> getDroid i
         _ -> ActionT $ throwE "Invalid arguments."
 
-character :: Character -> Out.Value Identity
-character char = Schema.object
-    [ Schema.Resolver "id" $ pure $ Out.String $ id_ char
-    , Schema.Resolver "name" $ pure $ Out.String $ name_ char
-    , Schema.Resolver "friends"
-        $ pure $ Out.List $ character <$> getFriends char
-    , Schema.Resolver "appearsIn" $ pure
-        $ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
-    , Schema.Resolver "secretBackstory" $ Out.String
-        <$> secretBackstory char
-    , Schema.Resolver "homePlanet" $ pure $ Out.String
-        $ either mempty homePlanet char
-    , Schema.Resolver "__typename" $ pure $ Out.String
-        $ typeName char
+character :: Character -> Value
+character char = Object $ HashMap.fromList
+    [ ("id", String $ id_ char)
+    , ("name", String $ name_ char)
+    , ("friends", List $ character <$> getFriends char)
+    , ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
+    , ("homePlanet", String $ either mempty homePlanet char)
+    , ("__typename", String $ typeName char)
     ]