diff options
| author | Eugen Wissner <belka@caraus.de> | 2020-02-01 20:46:35 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2020-02-01 20:46:35 +0100 |
| commit | 67bebf853ca5a248358ea1854124a46b70c677cd (patch) | |
| tree | b103bf025a1d0f48c2524dd3c2237ff13fd99ec5 /src/Language | |
| parent | e8b82122c646ba159146c986cc8983d66f790142 (diff) | |
| download | graphql-67bebf853ca5a248358ea1854124a46b70c677cd.tar.gz | |
Replace MonadIO constraint with just Monad
And make the tests use Identity instead of IO.
Diffstat (limited to 'src/Language')
| -rw-r--r-- | src/Language/GraphQL.hs | 5 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 9 | ||||
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 19 | ||||
| -rw-r--r-- | src/Language/GraphQL/Trans.hs | 2 |
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 |
