summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/Execute
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/Execute')
-rw-r--r--src/Language/GraphQL/Execute/Execution.hs33
-rw-r--r--src/Language/GraphQL/Execute/Subscribe.hs21
2 files changed, 32 insertions, 22 deletions
diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
index 22f3595..d8d5b13 100644
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@@ -8,8 +8,8 @@ module Language.GraphQL.Execute.Execution
, executeSelectionSet
) where
+import Control.Monad.Catch (Exception(..), MonadCatch(..))
import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.Reader (runReaderT)
import Control.Monad.Trans.State (gets)
import Data.List.NonEmpty (NonEmpty(..))
@@ -19,7 +19,7 @@ import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..))
-import Data.Text (Text)
+import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Language.GraphQL.Error
import Language.GraphQL.Execute.Coerce
@@ -31,14 +31,19 @@ import Language.GraphQL.Type.Internal
import Language.GraphQL.Type.Schema
import Prelude hiding (null)
-resolveFieldValue :: Monad m
+resolveFieldValue :: MonadCatch m
=> Type.Value
-> Type.Subs
-> Type.Resolve m
- -> m (Either Text Type.Value)
+ -> CollectErrsT m Type.Value
resolveFieldValue result args resolver =
- flip runReaderT context $ runExceptT resolver
+ catch (lift $ runReaderT resolver context) handleFieldError
where
+ handleFieldError :: MonadCatch m
+ => ResolverException
+ -> CollectErrsT m Type.Value
+ handleFieldError e =
+ addErr (Error (Text.pack $ displayException e) []) >> pure Type.Null
context = Type.Context
{ Type.arguments = Type.Arguments args
, Type.values = result
@@ -102,7 +107,7 @@ instanceOf objectType (AbstractUnionType unionType) =
where
go unionMemberType acc = acc || objectType == unionMemberType
-executeField :: (Monad m, Serialize a)
+executeField :: (MonadCatch m, Serialize a)
=> Out.Resolver m
-> Type.Value
-> NonEmpty (Transform.Field m)
@@ -119,12 +124,10 @@ executeField fieldResolver prev fields
case coerceArgumentValues argumentDefinitions arguments' of
Nothing -> addErrMsg "Argument coercing failed."
Just argumentValues -> do
- answer <- lift $ resolveFieldValue prev argumentValues resolver
- case answer of
- Right result -> completeValue fieldType fields result
- Left errorMessage -> addErrMsg errorMessage
+ answer <- resolveFieldValue prev argumentValues resolver
+ completeValue fieldType fields answer
-completeValue :: (Monad m, Serialize a)
+completeValue :: (MonadCatch m, Serialize a)
=> Out.Type m
-> NonEmpty (Transform.Field m)
-> Type.Value
@@ -166,13 +169,15 @@ completeValue (Out.UnionBaseType unionType) fields result
Nothing -> addErrMsg "Value completion failed."
completeValue _ _ _ = addErrMsg "Value completion failed."
-mergeSelectionSets :: Monad m => NonEmpty (Transform.Field m) -> Seq (Transform.Selection m)
+mergeSelectionSets :: MonadCatch m
+ => NonEmpty (Transform.Field m)
+ -> Seq (Transform.Selection m)
mergeSelectionSets = foldr forEach mempty
where
forEach (Transform.Field _ _ _ fieldSelectionSet) selectionSet =
selectionSet <> fieldSelectionSet
-coerceResult :: (Monad m, Serialize a)
+coerceResult :: (MonadCatch m, Serialize a)
=> Out.Type m
-> Output a
-> CollectErrsT m a
@@ -183,7 +188,7 @@ coerceResult outputType result
-- | Takes an 'Out.ObjectType' and a list of 'Transform.Selection's and applies
-- each field to each 'Transform.Selection'. Resolves into a value containing
-- the resolved 'Transform.Selection', or a null value and error information.
-executeSelectionSet :: (Monad m, Serialize a)
+executeSelectionSet :: (MonadCatch m, Serialize a)
=> Type.Value
-> Out.ObjectType m
-> Seq (Transform.Selection m)
diff --git a/src/Language/GraphQL/Execute/Subscribe.hs b/src/Language/GraphQL/Execute/Subscribe.hs
index ee9b116..0bd274f 100644
--- a/src/Language/GraphQL/Execute/Subscribe.hs
+++ b/src/Language/GraphQL/Execute/Subscribe.hs
@@ -9,7 +9,7 @@ module Language.GraphQL.Execute.Subscribe
) where
import Conduit
-import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import Control.Monad.Catch (Exception(..), MonadCatch(..))
import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
@@ -17,6 +17,7 @@ import qualified Data.Map.Strict as Map
import qualified Data.List.NonEmpty as NonEmpty
import Data.Sequence (Seq(..))
import Data.Text (Text)
+import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Language.GraphQL.Execute.Coerce
import Language.GraphQL.Execute.Execution
@@ -29,7 +30,7 @@ import Language.GraphQL.Type.Schema
-- This is actually executeMutation, but we don't distinguish between queries
-- and mutations yet.
-subscribe :: (Monad m, Serialize a)
+subscribe :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
@@ -38,7 +39,7 @@ subscribe types' objectType fields = do
sourceStream <- createSourceEventStream types' objectType fields
traverse (mapSourceToResponseEvent types' objectType fields) sourceStream
-mapSourceToResponseEvent :: (Monad m, Serialize a)
+mapSourceToResponseEvent :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
@@ -48,7 +49,7 @@ mapSourceToResponseEvent types' subscriptionType fields sourceStream = pure
$ sourceStream
.| mapMC (executeSubscriptionEvent types' subscriptionType fields)
-createSourceEventStream :: Monad m
+createSourceEventStream :: MonadCatch m
=> HashMap Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
@@ -67,14 +68,18 @@ createSourceEventStream _types subscriptionType@(Out.ObjectType _ _ _ fieldTypes
where
groupedFieldSet = collectFields subscriptionType fields
-resolveFieldEventStream :: Monad m
+resolveFieldEventStream :: MonadCatch m
=> Type.Value
-> Type.Subs
- -> ExceptT Text (ReaderT Out.Context m) (Out.SourceEventStream m)
+ -> Out.Subscribe m
-> m (Either Text (Out.SourceEventStream m))
resolveFieldEventStream result args resolver =
- flip runReaderT context $ runExceptT resolver
+ catch (Right <$> runReaderT resolver context) handleEventStreamError
where
+ handleEventStreamError :: MonadCatch m
+ => ResolverException
+ -> m (Either Text (Out.SourceEventStream m))
+ handleEventStreamError = pure . Left . Text.pack . displayException
context = Type.Context
{ Type.arguments = Type.Arguments args
, Type.values = result
@@ -82,7 +87,7 @@ resolveFieldEventStream result args resolver =
-- This is actually executeMutation, but we don't distinguish between queries
-- and mutations yet.
-executeSubscriptionEvent :: (Monad m, Serialize a)
+executeSubscriptionEvent :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-27 01:20:11 +0000