From 587aab005ed1e4e9bd8966d44ff878891cbc8ce7 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sat, 23 Nov 2019 09:49:12 +0100
Subject: Add a reader instance to the resolvers

The Reader contains a Name/Value hashmap, which will contain resolver
arguments.
---
 src/Language/GraphQL/AST/Encoder.hs |  8 ++++----
 src/Language/GraphQL/Schema.hs      |  4 +++-
 src/Language/GraphQL/Trans.hs       | 16 +++++++++++++---
 3 files changed, 20 insertions(+), 8 deletions(-)

(limited to 'src/Language')

diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index a345ca4..afc425f 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -23,10 +23,10 @@ import Data.Text.Lazy.Builder.Int (decimal)
 import Data.Text.Lazy.Builder.RealFloat (realFloat)
 import qualified Language.GraphQL.AST as Full
 
--- | Instructs the encoder whether a GraphQL should be minified or pretty
---   printed.
---   
---   Use 'pretty' and 'minified' to construct the formatter.
+-- | Instructs the encoder whether the GraphQL document should be minified or
+--   pretty printed.
+--
+--   Use 'pretty' or 'minified' to construct the formatter.
 data Formatter
     = Minified
     | Pretty Word
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs
index 984a4d7..afe068f 100644
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@@ -23,6 +23,7 @@ module Language.GraphQL.Schema
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
+import Control.Monad.Trans.Reader (runReaderT)
 import Data.Foldable (find, fold)
 import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as Aeson
@@ -102,9 +103,10 @@ resolveFieldValue :: MonadIO m
     -> Field
     -> CollectErrsT m (HashMap Text Aeson.Value)
 resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
-    result <- lift $ runExceptT . runActionT $ f args
+    result <- lift $ reader . runExceptT . runActionT $ f args
     either resolveLeft (resolveRight fld) result
       where
+        reader = flip runReaderT $ Context mempty
         resolveLeft err = do
             _ <- addErrMsg err
             return $ HashMap.singleton (aliasOrName fld) Aeson.Null
diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs
index eb78911..4232e75 100644
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@@ -1,6 +1,7 @@
 -- | Monad transformer stack used by the @GraphQL@ resolvers.
 module Language.GraphQL.Trans
     ( ActionT(..)
+    , Context(Context)
     ) where
 
 import Control.Applicative (Alternative(..))
@@ -8,10 +9,19 @@ 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)
+import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
+import Language.GraphQL.AST.Core (Name, Value)
 
--- | Monad transformer stack used by the resolvers to provide error handling.
-newtype ActionT m a = ActionT { runActionT :: ExceptT Text m a }
+-- | Resolution context holds resolver arguments.
+newtype Context = Context (HashMap Name Value)
+
+-- | 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
+    }
 
 instance Functor m => Functor (ActionT m) where
     fmap f = ActionT . fmap f . runActionT
@@ -25,7 +35,7 @@ instance Monad m => Monad (ActionT m) where
     (ActionT action) >>= f = ActionT $ action >>= runActionT . f
 
 instance MonadTrans ActionT where
-    lift = ActionT . lift
+    lift = ActionT . lift . lift
 
 instance MonadIO m => MonadIO (ActionT m) where
     liftIO = lift . liftIO
-- 
cgit v1.2.3