summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Language/GraphQL/Class.hs2
-rw-r--r--src/Language/GraphQL/Resolver.hs61
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