{- 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
    ( 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(..))

-- | Exceptions thrown by the functions in this module.
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

-- | 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 :: 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

-- | 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 :: 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