Combine Resolver and ActionT in ResolverT

4 files changed, 38 insertions, 42 deletions

diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 0c10419..0291bf8 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -33,12 +33,12 @@ import Prelude hiding (null)
 resolveFieldValue :: Monad m
     => Type.Value
     -> Type.Subs
-    -> ActionT m a
+    -> ResolverT m a
     -> m (Either Text a)
 resolveFieldValue result args =
     flip runReaderT (Context {arguments = Arguments args, values = result})
     . runExceptT
-    . runActionT
+    . runResolverT
 
 collectFields :: Monad m
     => Out.ObjectType m
@@ -99,12 +99,12 @@ instanceOf objectType (AbstractUnionType unionType) =
     go unionMemberType acc = acc || objectType == unionMemberType
 
 executeField :: (Monad m, Serialize a)
-    => Out.Resolver m
+    => Out.Field m
     -> Type.Value
     -> NonEmpty (Transform.Field m)
     -> CollectErrsT m a
-executeField (Out.Resolver fieldDefinition resolver) prev fields = do
-    let Out.Field _ fieldType argumentDefinitions = fieldDefinition
+executeField fieldDefinition prev fields = do
+    let Out.Field _ fieldType argumentDefinitions resolver = fieldDefinition
     let (Transform.Field _ _ arguments' _ :| []) = fields
     case coerceArgumentValues argumentDefinitions arguments' of
         Nothing -> errmsg "Argument coercing failed."
diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs
index fa7718a..2ec13be 100644
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@@ -1,7 +1,7 @@
 -- | Monad transformer stack used by the @GraphQL@ resolvers.
 module Language.GraphQL.Trans
     ( argument
-    , ActionT(..)
+    , ResolverT(..)
     , Context(..)
     ) where
 
@@ -26,42 +26,49 @@ data Context = Context
     }
 
 -- | Monad transformer stack used by the resolvers to provide error handling
---   and resolution context (resolver arguments).
-newtype ActionT m a = ActionT
-    { runActionT :: ExceptT Text (ReaderT Context m) a
+-- and resolution context (resolver arguments).
+--
+-- Resolves a 'Field' into a 'Value' with error information (if an error has
+-- occurred). @m@ is an arbitrary monad, usually 'IO'.
+--
+-- Resolving a field can result in a leaf value or an object, which is
+-- represented as a list of nested resolvers, used to resolve the fields of that
+-- object.
+newtype ResolverT m a = ResolverT
+    { runResolverT :: ExceptT Text (ReaderT Context m) a
     }
 
-instance Functor m => Functor (ActionT m) where
-    fmap f = ActionT . fmap f . runActionT
+instance Functor m => Functor (ResolverT m) where
+    fmap f = ResolverT . fmap f . runResolverT
 
-instance Monad m => Applicative (ActionT m) where
-    pure = ActionT . pure
-    (ActionT f) <*> (ActionT x) = ActionT $ f <*> x
+instance Monad m => Applicative (ResolverT m) where
+    pure = ResolverT . pure
+    (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x
 
-instance Monad m => Monad (ActionT m) where
+instance Monad m => Monad (ResolverT m) where
     return = pure
-    (ActionT action) >>= f = ActionT $ action >>= runActionT . f
+    (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f
 
-instance MonadTrans ActionT where
-    lift = ActionT . lift . lift
+instance MonadTrans ResolverT where
+    lift = ResolverT . lift . lift
 
-instance MonadIO m => MonadIO (ActionT m) where
+instance MonadIO m => MonadIO (ResolverT m) where
     liftIO = lift . liftIO
 
-instance Monad m => Alternative (ActionT m) where
-    empty = ActionT empty
-    (ActionT x) <|> (ActionT y) = ActionT $ x <|> y
+instance Monad m => Alternative (ResolverT m) where
+    empty = ResolverT empty
+    (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y
 
-instance Monad m => MonadPlus (ActionT m) where
+instance Monad m => MonadPlus (ResolverT m) where
     mzero = empty
     mplus = (<|>)
 
 -- | Retrieves an argument by its name. If the argument with this name couldn't
 --   be found, returns 'Null' (i.e. the argument is assumed to
 --   be optional then).
-argument :: Monad m => Name -> ActionT m Value
+argument :: Monad m => Name -> ResolverT m Value
 argument argumentName = do
-    argumentValue <- ActionT $ lift $ asks $ lookup . arguments
+    argumentValue <- ResolverT $ lift $ asks $ lookup . arguments
     pure $ fromMaybe Null argumentValue
   where
     lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs
index 856c4f8..0f14ce8 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@@ -10,7 +10,6 @@ module Language.GraphQL.Type.Out
     ( Field(..)
     , InterfaceType(..)
     , ObjectType(..)
-    , Resolver(..)
     , Type(..)
     , UnionType(..)
     , isNonNullType
@@ -29,21 +28,12 @@ import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 
--- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
--- information (if an error has occurred). @m@ is an arbitrary monad, usually
--- 'IO'.
---
--- Resolving a field can result in a leaf value or an object, which is
--- represented as a list of nested resolvers, used to resolve the fields of that
--- object.
-data Resolver m = Resolver (Field m) (ActionT m Value)
-
 -- | Object type definition.
 --
---   Almost all of the GraphQL types you define will be object types. Object
---   types have a name, but most importantly describe their fields.
+-- Almost all of the GraphQL types you define will be object types. Object
+-- types have a name, but most importantly describe their fields.
 data ObjectType m = ObjectType
-    Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
+    Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
 
 instance forall a. Eq (ObjectType a) where
     (ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
@@ -73,6 +63,7 @@ data Field m = Field
     (Maybe Text) -- ^ Description.
     (Type m) -- ^ Field type.
     (HashMap Name In.Argument) -- ^ Arguments.
+    (ResolverT m Value) -- ^ Resolver.
 
 -- | These types may be used as output types as the result of fields.
 --
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
index 4d7b9eb..4420cbb 100644
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -61,7 +61,7 @@ collectReferencedTypes schema =
     collect traverser typeName element foundTypes
         | HashMap.member typeName foundTypes = foundTypes
         | otherwise = traverser $ HashMap.insert typeName element foundTypes
-    visitFields (Out.Field _ outputType arguments) foundTypes
+    visitFields (Out.Field _ outputType arguments _) foundTypes
         = traverseOutputType outputType
         $ foldr visitArguments foundTypes arguments
     visitArguments (In.Argument _ inputType _) = traverseInputType inputType
@@ -96,9 +96,8 @@ collectReferencedTypes schema =
         let (Definition.EnumType typeName _ _) = enumType
          in collect Prelude.id typeName (EnumType enumType)
     traverseObjectType objectType foundTypes =
-        let (Out.ObjectType typeName _ interfaces resolvers) = objectType
+        let (Out.ObjectType typeName _ interfaces fields) = objectType
             element = ObjectType objectType
-            fields = extractObjectField <$> resolvers
             traverser = polymorphicTraverser interfaces fields
          in collect traverser typeName element foundTypes
     traverseInterfaceType interfaceType foundTypes =
@@ -109,4 +108,3 @@ collectReferencedTypes schema =
     polymorphicTraverser interfaces fields
         = flip (foldr visitFields) fields
         . flip (foldr traverseInterfaceType) interfaces
-    extractObjectField (Out.Resolver field _) = field