1 files changed, 69 insertions, 3 deletions
diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs
index 0f14ce8..97107ca 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/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