1 files changed, 75 insertions, 54 deletions
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 5fcdf3e..cecd8eb 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -4,14 +4,11 @@ module Test.StarWars.Schema
     ( schema
     ) where
 
+import Control.Monad.Catch (MonadThrow(..), SomeException)
 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 Data.Text (Text)
-import Language.GraphQL.Trans
 import Language.GraphQL.Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
@@ -20,69 +17,97 @@ import Prelude hiding (id)
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
-schema :: Schema Identity
-schema = Schema { query = queryType, mutation = Nothing }
+schema :: Schema (Either SomeException)
+schema = Schema
+    { query = queryType
+    , mutation = Nothing
+    , subscription = Nothing
+    }
   where
     queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
-        [ ("hero", Out.Resolver heroField hero)
-        , ("human", Out.Resolver humanField human)
-        , ("droid", Out.Resolver droidField droid)
+        [ ("hero", heroFieldResolver)
+        , ("human", humanFieldResolver)
+        , ("droid", droidFieldResolver)
         ]
     heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
         $ HashMap.singleton "episode"
         $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+    heroFieldResolver = ValueResolver heroField hero
     humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
         $ HashMap.singleton "id"
         $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+    humanFieldResolver = ValueResolver humanField human
     droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
+    droidFieldResolver = ValueResolver droidField droid
 
-heroObject :: Out.ObjectType Identity
+heroObject :: Out.ObjectType (Either SomeException)
 heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
-    [ ("id", Out.Resolver idFieldType (idField "id"))
-    , ("name", Out.Resolver nameFieldType (idField "name"))
-    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
-    , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
-    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
-    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    [ ("id", idFieldType)
+    , ("name", nameFieldType)
+    , ("friends", friendsFieldType)
+    , ("appearsIn", appearsInField)
+    , ("homePlanet", homePlanetFieldType)
+    , ("secretBackstory", secretBackstoryFieldType)
+    , ("__typename", typenameFieldType)
     ]
   where
-    homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+    homePlanetFieldType
+      = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+      $ idField "homePlanet"
 
-droidObject :: Out.ObjectType Identity
+droidObject :: Out.ObjectType (Either SomeException)
 droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
-    [ ("id", Out.Resolver idFieldType (idField "id"))
-    , ("name", Out.Resolver nameFieldType (idField "name"))
-    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
-    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
-    , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
-    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
-    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    [ ("id", idFieldType)
+    , ("name", nameFieldType)
+    , ("friends", friendsFieldType)
+    , ("appearsIn", appearsInField)
+    , ("primaryFunction", primaryFunctionFieldType)
+    , ("secretBackstory", secretBackstoryFieldType)
+    , ("__typename", typenameFieldType)
     ]
   where
-    primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
-
-idFieldType :: Out.Field Identity
-idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
-
-nameFieldType :: Out.Field Identity
-nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
-
-friendsFieldType :: Out.Field Identity
-friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+    primaryFunctionFieldType
+        = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+        $ idField "primaryFunction"
+
+typenameFieldType :: Resolver (Either SomeException)
+typenameFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+    $ idField "__typename"
+
+idFieldType :: Resolver (Either SomeException)
+idFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType id) mempty)
+    $ idField "id"
+
+nameFieldType :: Resolver (Either SomeException)
+nameFieldType
+    = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+    $ idField "name"
+
+friendsFieldType :: Resolver (Either SomeException)
+friendsFieldType
+    = ValueResolver (Out.Field Nothing fieldType mempty)
+    $ idField "friends"
+  where
+    fieldType = Out.ListType $ Out.NamedObjectType droidObject
 
-appearsInField :: Out.Field Identity
-appearsInField = Out.Field (Just description) fieldType mempty
+appearsInField :: Resolver (Either SomeException)
+appearsInField
+    = ValueResolver (Out.Field (Just description) fieldType mempty)
+    $ idField "appearsIn"
   where
     fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
     description = "Which movies they appear in."
 
-secretBackstoryFieldType :: Out.Field Identity
-secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+secretBackstoryFieldType :: Resolver (Either SomeException)
+secretBackstoryFieldType = ValueResolver field secretBackstory
+  where
+    field = Out.Field Nothing (Out.NamedScalarType string) mempty
 
-idField :: Text -> ActionT Identity Value
+idField :: Text -> Resolve (Either SomeException)
 idField f = do
-    v <- ActionT $ lift $ asks values
+    v <- asks values
     let (Object v') = v
     pure $ v' HashMap.! f
 
@@ -95,7 +120,7 @@ episodeEnum = EnumType "Episode" (Just description)
     empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
     jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
 
-hero :: ActionT Identity Value
+hero :: Resolve (Either SomeException)
 hero = do
   episode <- argument "episode"
   pure $ character $ case episode of
@@ -104,23 +129,19 @@ hero = do
       Enum "JEDI" -> getHero 6
       _ -> artoo
 
-human :: ActionT Identity Value
+human :: Resolve (Either SomeException)
 human = do
     id' <- argument "id"
     case id' of
-        String i -> do
-            humanCharacter <- lift $ return $ getHuman i >>= Just
-            case humanCharacter of
-                Nothing -> pure Null
-                Just e -> pure $ character e
-        _ -> ActionT $ throwE "Invalid arguments."
-
-droid :: ActionT Identity Value
+        String i -> pure $ maybe Null character $ getHuman i >>= Just
+        _ -> throwM InvalidArguments
+
+droid :: Resolve (Either SomeException)
 droid = do
     id' <- argument "id"
     case id' of
-        String i -> character <$> getDroid i
-        _ -> ActionT $ throwE "Invalid arguments."
+        String i -> pure $ maybe Null character $ getDroid i >>= Just
+        _ -> throwM InvalidArguments
 
 character :: Character -> Value
 character char = Object $ HashMap.fromList