Replace MonadIO constraint with just Monad
And make the tests use Identity instead of IO.
This commit is contained in:
@ -6,7 +6,6 @@ module Language.GraphQL.Execute
|
||||
, executeWithName
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Foldable (toList)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
@ -24,7 +23,7 @@ import qualified Language.GraphQL.Schema as Schema
|
||||
--
|
||||
-- Returns the result of the query against the schema wrapped in a /data/
|
||||
-- field, or errors wrapped in an /errors/ field.
|
||||
execute :: MonadIO m
|
||||
execute :: Monad m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> Document -- @GraphQL@ document.
|
||||
@ -40,7 +39,7 @@ execute schema subs doc =
|
||||
--
|
||||
-- Returns the result of the query against the schema wrapped in a /data/
|
||||
-- field, or errors wrapped in an /errors/ field.
|
||||
executeWithName :: MonadIO m
|
||||
executeWithName :: Monad m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers
|
||||
-> Text -- ^ Operation name.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
@ -51,7 +50,7 @@ executeWithName schema name subs doc =
|
||||
where
|
||||
transformError = return $ singleError "Schema transformation error."
|
||||
|
||||
document :: MonadIO m
|
||||
document :: Monad m
|
||||
=> NonEmpty (Schema.Resolver m)
|
||||
-> Maybe Text
|
||||
-> AST.Core.Document
|
||||
@ -67,7 +66,7 @@ document schema (Just name) operations = case NE.dropWhile matchingName operatio
|
||||
matchingName _ = False
|
||||
document _ _ _ = return $ singleError "Missing operation name."
|
||||
|
||||
operation :: MonadIO m
|
||||
operation :: Monad m
|
||||
=> NonEmpty (Schema.Resolver m)
|
||||
-> AST.Core.Operation
|
||||
-> m Aeson.Value
|
||||
|
@ -15,7 +15,6 @@ module Language.GraphQL.Schema
|
||||
, Value(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.Except (runExceptT)
|
||||
import Control.Monad.Trans.Reader (runReaderT)
|
||||
@ -33,8 +32,8 @@ import Language.GraphQL.Trans
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
|
||||
-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
|
||||
-- information (if an error has occurred). @m@ is usually expected to be an
|
||||
-- instance of 'MonadIO'.
|
||||
-- information (if an error has occurred). @m@ is an arbitrary monad, usually
|
||||
-- 'IO'.
|
||||
data Resolver m = Resolver
|
||||
Text -- ^ Name
|
||||
(Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
|
||||
@ -44,14 +43,14 @@ data Resolver m = Resolver
|
||||
type Subs = HashMap Name Value
|
||||
|
||||
-- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
|
||||
object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m
|
||||
object :: Monad m => Name -> ActionT m [Resolver m] -> Resolver m
|
||||
object name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld@(Field _ _ _ flds) resolver = withField (resolve resolver flds) fld
|
||||
|
||||
-- | Like 'object' but can be null or a list of objects.
|
||||
wrappedObject ::
|
||||
MonadIO m =>
|
||||
Monad m =>
|
||||
Name ->
|
||||
ActionT m (Type.Wrapping [Resolver m]) ->
|
||||
Resolver m
|
||||
@ -61,14 +60,14 @@ wrappedObject name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
= withField (traverse (`resolve` sels) resolver) fld
|
||||
|
||||
-- | A scalar represents a primitive value, like a string or an integer.
|
||||
scalar :: (MonadIO m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m
|
||||
scalar :: (Monad m, Aeson.ToJSON a) => Name -> ActionT m a -> Resolver m
|
||||
scalar name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld result = withField (return result) fld
|
||||
|
||||
-- | Like 'scalar' but can be null or a list of scalars.
|
||||
wrappedScalar ::
|
||||
(MonadIO m, Aeson.ToJSON a) =>
|
||||
(Monad m, Aeson.ToJSON a) =>
|
||||
Name ->
|
||||
ActionT m (Type.Wrapping a) ->
|
||||
Resolver m
|
||||
@ -80,7 +79,7 @@ wrappedScalar name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
resolveRight fld (Type.List result) = withField (return result) fld
|
||||
|
||||
resolveFieldValue ::
|
||||
MonadIO m =>
|
||||
Monad m =>
|
||||
ActionT m a ->
|
||||
(Field -> a -> CollectErrsT m (HashMap Text Aeson.Value)) ->
|
||||
Field ->
|
||||
@ -95,7 +94,7 @@ resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
|
||||
return $ HashMap.singleton (aliasOrName fld) Aeson.Null
|
||||
|
||||
-- | Helper function to facilitate error handling and result emitting.
|
||||
withField :: (MonadIO m, Aeson.ToJSON a)
|
||||
withField :: (Monad m, Aeson.ToJSON a)
|
||||
=> CollectErrsT m a -> Field -> CollectErrsT m (HashMap Text Aeson.Value)
|
||||
withField v fld
|
||||
= HashMap.singleton (aliasOrName fld) . Aeson.toJSON <$> runAppendErrs v
|
||||
@ -103,7 +102,7 @@ withField v fld
|
||||
-- | Takes a list of 'Resolver's and a list of 'Field's and applies each
|
||||
-- 'Resolver' to each 'Field'. Resolves into a value containing the
|
||||
-- resolved 'Field', or a null value and error information.
|
||||
resolve :: MonadIO m
|
||||
resolve :: Monad m
|
||||
=> [Resolver m] -> Seq Selection -> CollectErrsT m Aeson.Value
|
||||
resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
||||
where
|
||||
|
@ -56,7 +56,7 @@ instance Monad m => MonadPlus (ActionT m) where
|
||||
-- | Retrieves an argument by its name. If the argument with this name couldn't
|
||||
-- be found, returns 'Value.Null' (i.e. the argument is assumed to
|
||||
-- be optional then).
|
||||
argument :: MonadIO m => Name -> ActionT m Value
|
||||
argument :: Monad m => Name -> ActionT m Value
|
||||
argument argumentName = do
|
||||
argumentValue <- ActionT $ lift $ asks $ lookup . arguments
|
||||
pure $ fromMaybe Null argumentValue
|
||||
|
Reference in New Issue
Block a user