62 lines
2.3 KiB
Haskell
62 lines
2.3 KiB
Haskell
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
|
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
|
obtain one at https://mozilla.org/MPL/2.0/. -}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
-- | Helper functions and exceptions to write resolvers.
|
|
module Language.GraphQL.Resolver
|
|
( argument
|
|
, defaultResolver
|
|
) where
|
|
|
|
import Control.Monad.Catch (Exception(..), MonadCatch(..), MonadThrow(..))
|
|
import Control.Monad.Trans.Reader (ReaderT, asks)
|
|
import Data.HashMap.Strict ((!))
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as Text
|
|
import Data.Typeable (cast)
|
|
import Language.GraphQL.AST.Document (Name)
|
|
import Language.GraphQL.Error
|
|
import qualified Language.GraphQL.Type as Type
|
|
import Language.GraphQL.Class (FromGraphQL(..))
|
|
|
|
-- | Exceptions thrown by the functions in this module.
|
|
data ServerException
|
|
= FieldNotResolvedException !Text
|
|
| ErroneousArgumentTypeException !Text
|
|
|
|
instance Show ServerException where
|
|
show (FieldNotResolvedException fieldName) =
|
|
Text.unpack $ Text.unwords ["Field", fieldName, "not resolved."]
|
|
show (ErroneousArgumentTypeException argumentName) =
|
|
Text.unpack $ Text.unwords
|
|
[ "Unable to convert the argument"
|
|
, argumentName
|
|
, "to a user-defined type."
|
|
]
|
|
|
|
instance Exception ServerException where
|
|
toException = toException . ResolverException
|
|
fromException x = do
|
|
ResolverException a <- fromException x
|
|
cast a
|
|
|
|
-- | Default resolver expects that the field value is returned by the parent
|
|
-- object. If the parent is not an object or it doesn't contain the requested
|
|
-- field name, an error is thrown.
|
|
defaultResolver :: MonadCatch m => Name -> Type.Resolve m
|
|
defaultResolver fieldName = do
|
|
values' <- asks Type.values
|
|
case values' of
|
|
Type.Object objectValue -> pure $ objectValue ! fieldName
|
|
_nonObject -> throwM $ FieldNotResolvedException fieldName
|
|
|
|
-- | Takes an argument name, validates that the argument exists, and optionally
|
|
-- converts it to a user-defined type.
|
|
argument :: (MonadCatch m, FromGraphQL a) => Name -> ReaderT Type.Context m a
|
|
argument argumentName =
|
|
Type.argument argumentName >>= maybe throwError pure . fromGraphQL
|
|
where
|
|
throwError = throwM $ ErroneousArgumentTypeException argumentName
|