Constrain base monad to MonadCatch

Let's try MonadThrow/MonadCatch. It looks nice at a first glance. The
monad transformer stack contains only the ReaderT, less lifts are
required. Exception subtyping is easier, the user can (and should)
define custom error types and throw them. And it is still possible to
use pure error handling, if someone doesn't like runtime exceptions or
need to run a query in a pure environment.

Fixes #42.
This commit is contained in:
2020-07-17 07:05:03 +02:00
parent e24386402b
commit 09135c581a
13 changed files with 115 additions and 75 deletions

View File

@ -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)