{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.Resolver
( ServerException(..)
, argument
, defaultResolver
) where
import Control.Monad.Catch (Exception(..), MonadCatch(..), MonadThrow(..))
import Control.Monad.Trans.Reader (ReaderT, asks)
import qualified Data.HashMap.Strict as HashMap
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(..))
data ServerException
= FieldNotResolvedException !Text
| ErroneousArgumentTypeException !Text
instance Show ServerException where
show :: ServerException -> String
show (FieldNotResolvedException Text
fieldName) =
Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text
"Field", Text
fieldName, Text
"not resolved."]
show (ErroneousArgumentTypeException Text
argumentName) =
Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords
[ Text
"Unable to convert the argument"
, Text
argumentName
, Text
"to a user-defined type."
]
instance Exception ServerException where
toException :: ServerException -> SomeException
toException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> ResolverException
ResolverException
fromException :: SomeException -> Maybe ServerException
fromException SomeException
x = do
ResolverException e
a <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a
defaultResolver :: MonadCatch m => Name -> Type.Resolve m
defaultResolver :: forall (m :: * -> *). MonadCatch m => Text -> Resolve m
defaultResolver Text
fieldName = do
Value
values' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Context -> Value
Type.values
case Value
values' of
Type.Object HashMap Text Value
objectValue
| Just Value
result <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
fieldName HashMap Text Value
objectValue -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
result
Value
_nonObject -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> ServerException
FieldNotResolvedException Text
fieldName
argument :: (MonadCatch m, FromGraphQL a) => Name -> ReaderT Type.Context m a
argument :: forall (m :: * -> *) a.
(MonadCatch m, FromGraphQL a) =>
Text -> ReaderT Context m a
argument Text
argumentName =
forall (m :: * -> *). Monad m => Text -> Resolve m
Type.argument Text
argumentName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. ReaderT Context m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGraphQL a => Value -> Maybe a
fromGraphQL
where
throwError :: ReaderT Context m a
throwError = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> ServerException
ErroneousArgumentTypeException Text
argumentName