diff options
Diffstat (limited to 'src/Language/GraphQL/Schema.hs')
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 62 |
1 files changed, 15 insertions, 47 deletions
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index 112847f..afe068f 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -4,17 +4,12 @@ -- functions for defining and manipulating schemas. module Language.GraphQL.Schema ( Resolver - , Schema , Subs , object , objectA , scalar , scalarA - , enum - , enumA , resolve - , wrappedEnum - , wrappedEnumA , wrappedObject , wrappedObjectA , wrappedScalar @@ -28,23 +23,19 @@ 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.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) import qualified Data.Aeson as Aeson import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.Sequence (Seq) import Data.Text (Text) import qualified Data.Text as T +import Language.GraphQL.AST.Core import Language.GraphQL.Error import Language.GraphQL.Trans -import Language.GraphQL.Type -import Language.GraphQL.AST.Core - -{-# DEPRECATED Schema "Use NonEmpty (Resolver m) instead" #-} --- | A GraphQL schema. --- @m@ is usually expected to be an instance of 'MonadIO'. -type Schema m = NonEmpty (Resolver m) +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 @@ -69,7 +60,7 @@ objectA name f = Resolver name $ resolveFieldValue f resolveRight -- | Like 'object' but also taking 'Argument's and can be null or a list of objects. wrappedObjectA :: MonadIO m - => Name -> ([Argument] -> ActionT m (Wrapping [Resolver m])) -> Resolver m + => Name -> ([Argument] -> ActionT m (Type.Wrapping [Resolver m])) -> Resolver m wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight where resolveRight fld@(Field _ _ _ sels) resolver @@ -77,7 +68,7 @@ wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight -- | Like 'object' but can be null or a list of objects. wrappedObject :: MonadIO m - => Name -> ActionT m (Wrapping [Resolver m]) -> Resolver m + => Name -> ActionT m (Type.Wrapping [Resolver m]) -> Resolver m wrappedObject name = wrappedObjectA name . const -- | A scalar represents a primitive value, like a string or an integer. @@ -91,54 +82,31 @@ scalarA name f = Resolver name $ resolveFieldValue f resolveRight where resolveRight fld result = withField (return result) fld --- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars. +-- | Like 'scalar' but also taking 'Argument's and can be null or a list of scalars. wrappedScalarA :: (MonadIO m, Aeson.ToJSON a) - => Name -> ([Argument] -> ActionT m (Wrapping a)) -> Resolver m + => Name -> ([Argument] -> ActionT m (Type.Wrapping a)) -> Resolver m wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight where - resolveRight fld (Named result) = withField (return result) fld - resolveRight fld Null + resolveRight fld (Type.Named result) = withField (return result) fld + resolveRight fld Type.Null = return $ HashMap.singleton (aliasOrName fld) Aeson.Null - resolveRight fld (List result) = withField (return result) fld + resolveRight fld (Type.List result) = withField (return result) fld -- | Like 'scalar' but can be null or a list of scalars. wrappedScalar :: (MonadIO m, Aeson.ToJSON a) - => Name -> ActionT m (Wrapping a) -> Resolver m + => Name -> ActionT m (Type.Wrapping a) -> Resolver m wrappedScalar name = wrappedScalarA name . const -{-# DEPRECATED enum "Use scalar instead" #-} -enum :: MonadIO m => Name -> ActionT m [Text] -> Resolver m -enum name = enumA name . const - -{-# DEPRECATED enumA "Use scalarA instead" #-} -enumA :: MonadIO m => Name -> ([Argument] -> ActionT m [Text]) -> Resolver m -enumA name f = Resolver name $ resolveFieldValue f resolveRight - where - resolveRight fld resolver = withField (return resolver) fld - -{-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-} -wrappedEnumA :: MonadIO m - => Name -> ([Argument] -> ActionT m (Wrapping [Text])) -> Resolver m -wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight - where - resolveRight fld (Named resolver) = withField (return resolver) fld - resolveRight fld Null - = return $ HashMap.singleton (aliasOrName fld) Aeson.Null - resolveRight fld (List resolver) = withField (return resolver) fld - -{-# DEPRECATED wrappedEnum "Use wrappedScalar instead" #-} -wrappedEnum :: MonadIO m => Name -> ActionT m (Wrapping [Text]) -> Resolver m -wrappedEnum name = wrappedEnumA name . const - resolveFieldValue :: MonadIO m => ([Argument] -> ActionT m a) -> (Field -> a -> CollectErrsT m (HashMap Text Aeson.Value)) -> 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 @@ -153,7 +121,7 @@ withField v fld -- 'Resolver' to each 'Field'. Resolves into a value containing the -- resolved 'Field', or a null value and error information. resolve :: MonadIO m - => [Resolver m] -> [Selection] -> CollectErrsT m Aeson.Value + => [Resolver m] -> Seq Selection -> CollectErrsT m Aeson.Value resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers where resolveTypeName (Resolver "__typename" f) = do |