summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2020-02-01 20:46:35 +0100
committerEugen Wissner <belka@caraus.de>2020-02-01 20:46:35 +0100
commit67bebf853ca5a248358ea1854124a46b70c677cd (patch)
treeb103bf025a1d0f48c2524dd3c2237ff13fd99ec5 /src
parente8b82122c646ba159146c986cc8983d66f790142 (diff)
downloadgraphql-67bebf853ca5a248358ea1854124a46b70c677cd.tar.gz
Replace MonadIO constraint with just Monad
And make the tests use Identity instead of IO.
Diffstat (limited to 'src')
-rw-r--r--src/Language/GraphQL.hs5
-rw-r--r--src/Language/GraphQL/Execute.hs9
-rw-r--r--src/Language/GraphQL/Schema.hs19
-rw-r--r--src/Language/GraphQL/Trans.hs2
4 files changed, 16 insertions, 19 deletions
diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 952f8ac..57c8bf1 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -4,7 +4,6 @@ module Language.GraphQL
, graphqlSubs
) where
-import Control.Monad.IO.Class (MonadIO)
import qualified Data.Aeson as Aeson
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Text as T
@@ -16,7 +15,7 @@ import Text.Megaparsec (parse)
-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema.Resolver's.
-graphql :: MonadIO m
+graphql :: Monad m
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
-> T.Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response.
@@ -25,7 +24,7 @@ graphql = flip graphqlSubs mempty
-- | If the text parses correctly as a @GraphQL@ query the substitution is
-- applied to the query and the query is then executed using to the given
-- 'Schema.Resolver's.
-graphqlSubs :: MonadIO m
+graphqlSubs :: Monad m
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
-> Schema.Subs -- ^ Variable substitution function.
-> T.Text -- ^ Text representing a @GraphQL@ request document.
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 5278606..de937ee 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -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
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs
index 661e452..8bde54d 100644
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@@ -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
diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs
index 24752a2..09c012b 100644
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@@ -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