1 files changed, 13 insertions, 8 deletions
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)