diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/GraphQL/Class.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Resolver.hs | 61 |
2 files changed, 62 insertions, 1 deletions
diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs index 66a0b2b..3f52a13 100644 --- a/src/Language/GraphQL/Class.hs +++ b/src/Language/GraphQL/Class.hs @@ -24,7 +24,7 @@ fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value fromGraphQLToIntegral (Type.String value) = case Text.Read.decimal value of Right (converted, "") -> Just converted - _ -> Nothing + _conversionError -> Nothing fromGraphQLToIntegral _ = Nothing -- | Instances of this typeclass can be converted to GraphQL internal diff --git a/src/Language/GraphQL/Resolver.hs b/src/Language/GraphQL/Resolver.hs new file mode 100644 index 0000000..dbf9a6a --- /dev/null +++ b/src/Language/GraphQL/Resolver.hs @@ -0,0 +1,61 @@ +{- 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 |
