Merge Trans and Type.Out modules

src/Language/GraphQL/Execute/Execution.hs

@@ -22,7 +22,6 @@ import Language.GraphQL.AST (Name)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute.Coerce
 import qualified Language.GraphQL.Execute.Transform as Transform
-import Language.GraphQL.Trans
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
@@ -32,12 +31,15 @@ import Prelude hiding (null)
 resolveFieldValue :: Monad m
     => Type.Value
     -> Type.Subs
-    -> ResolverT m a
+    -> Type.ResolverT m a
     -> m (Either Text a)
 resolveFieldValue result args =
-    flip runReaderT (Context {arguments = Type.Arguments args, values = result})
-    . runExceptT
-    . runResolverT
+    flip runReaderT context . runExceptT . Type.runResolverT
+  where
+    context = Type.Context
+        { Type.arguments = Type.Arguments args
+        , Type.values = result
+        }
 
 collectFields :: Monad m
     => Out.ObjectType m

src/Language/GraphQL/Trans.hs

@@ -1,73 +0,0 @@
--- | Monad transformer stack used by the @GraphQL@ resolvers.
-module Language.GraphQL.Trans
-    ( argument
-    , ResolverT(..)
-    , Context(..)
-    ) where
-
-import Control.Applicative (Alternative(..))
-import Control.Monad (MonadPlus(..))
-import Control.Monad.IO.Class (MonadIO(..))
-import Control.Monad.Trans.Class (MonadTrans(..))
-import Control.Monad.Trans.Except (ExceptT)
-import Control.Monad.Trans.Reader (ReaderT, asks)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import Language.GraphQL.AST (Name)
-import Language.GraphQL.Type.Definition
-import Prelude hiding (lookup)
-
--- | Resolution context holds resolver arguments.
-data Context = Context
-    { arguments :: Arguments
-    , values :: Value
-    }
-
--- | Monad transformer stack used by the resolvers to provide error handling
--- 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 (ResolverT m) where
-    fmap f = ResolverT . fmap f . runResolverT
-
-instance Monad m => Applicative (ResolverT m) where
-    pure = ResolverT . pure
-    (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x
-
-instance Monad m => Monad (ResolverT m) where
-    return = pure
-    (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f
-
-instance MonadTrans ResolverT where
-    lift = ResolverT . lift . lift
-
-instance MonadIO m => MonadIO (ResolverT m) where
-    liftIO = lift . liftIO
-
-instance Monad m => Alternative (ResolverT m) where
-    empty = ResolverT empty
-    (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y
-
-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 -> ResolverT m Value
-argument argumentName = do
-    argumentValue <- ResolverT $ lift $ asks $ lookup . arguments
-    pure $ fromMaybe Null argumentValue
-  where
-    lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap

src/Language/GraphQL/Type.hs

@@ -2,10 +2,13 @@
 module Language.GraphQL.Type
     ( In.InputField(..)
     , In.InputObjectType(..)
+    , Out.Context(..)
     , Out.Field(..)
     , Out.InterfaceType(..)
     , Out.ObjectType(..)
+    , Out.ResolverT(..)
     , Out.UnionType(..)
+    , Out.argument
     , module Language.GraphQL.Type.Definition
     , module Language.GraphQL.Type.Schema
     ) where

src/Language/GraphQL/Type/Out.hs

@@ -2,16 +2,20 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
 
--- | Output types and values.
+-- | Output types and values, monad transformer stack used by the @GraphQL@
+-- resolvers.
 --
 -- This module is intended to be imported qualified, to avoid name clashes
 -- with 'Language.GraphQL.Type.In'.
 module Language.GraphQL.Type.Out
-    ( Field(..)
+    ( Context(..)
+    , Field(..)
     , InterfaceType(..)
     , ObjectType(..)
+    , ResolverT(..)
     , Type(..)
     , UnionType(..)
+    , argument
     , isNonNullType
     , pattern EnumBaseType
     , pattern InterfaceBaseType
@@ -21,10 +25,17 @@ module Language.GraphQL.Type.Out
     , pattern UnionBaseType
     ) where
 
+import Control.Applicative (Alternative(..))
+import Control.Monad (MonadPlus(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.Except (ExceptT)
+import Control.Monad.Trans.Reader (ReaderT, asks)
 import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Language.GraphQL.AST (Name)
-import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
 
@@ -157,3 +168,58 @@ isNonNullType (NonNullInterfaceType _) = True
 isNonNullType (NonNullUnionType _) = True
 isNonNullType (NonNullListType _) = True
 isNonNullType _ = False
+
+-- | Resolution context holds resolver arguments.
+data Context = Context
+    { arguments :: Arguments
+    , values :: Value
+    }
+
+-- | Monad transformer stack used by the resolvers to provide error handling
+-- 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 (ResolverT m) where
+    fmap f = ResolverT . fmap f . runResolverT
+
+instance Monad m => Applicative (ResolverT m) where
+    pure = ResolverT . pure
+    (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x
+
+instance Monad m => Monad (ResolverT m) where
+    return = pure
+    (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f
+
+instance MonadTrans ResolverT where
+    lift = ResolverT . lift . lift
+
+instance MonadIO m => MonadIO (ResolverT m) where
+    liftIO = lift . liftIO
+
+instance Monad m => Alternative (ResolverT m) where
+    empty = ResolverT empty
+    (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y
+
+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 -> ResolverT m Value
+argument argumentName = do
+    argumentValue <- ResolverT $ lift $ asks $ lookupArgument . arguments
+    pure $ fromMaybe Null argumentValue
+  where
+    lookupArgument (Arguments argumentMap) =
+        HashMap.lookup argumentName argumentMap