summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/Execute/Execution.hs12
-rw-r--r--src/Language/GraphQL/Trans.hs73
-rw-r--r--src/Language/GraphQL/Type.hs3
-rw-r--r--src/Language/GraphQL/Type/Out.hs72
4 files changed, 79 insertions, 81 deletions
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 5e53311..2b12c43 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/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
diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs
deleted file mode 100644
index a55ac49..0000000
--- a/src/Language/GraphQL/Trans.hs
+++ /dev/null
@@ -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
diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs
index 5dfd622..0a30924 100644
--- a/src/Language/GraphQL/Type.hs
+++ b/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
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