OSS/graphql
1
1
Fork 1
Code Issues 4 Pull Requests Actions Releases 22 Wiki Activity

Constrain base monad to MonadCatch

Browse Source 
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:
Eugen Wissner
2020-07-17 07:05:03 +02:00
parent e24386402b
commit 09135c581a
13 changed files with 115 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
tests/Language/GraphQL/ExecuteSpec.hs
View File

@ -7,11 +7,10 @@ module Language.GraphQL.ExecuteSpec
( spec
) where
import Control.Exception (SomeException)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Conduit
import Data.Either (fromRight)
import Data.Functor.Identity (Identity(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL.AST (Name)
@ -23,14 +22,14 @@ import Language.GraphQL.Type.Out as Out
import Test.Hspec (Spec, context, describe, it, shouldBe)
import Text.Megaparsec (parse)
schema :: Schema Identity
schema :: Schema (Either SomeException)
schema = Schema
{ query = queryType
, mutation = Nothing
, subscription = Just subscriptionType
}
queryType :: Out.ObjectType Identity
queryType :: Out.ObjectType (Either SomeException)
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "philosopher"
$ ValueResolver philosopherField
@ -39,7 +38,7 @@ queryType = Out.ObjectType "Query" Nothing []
philosopherField =
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
philosopherType :: Out.ObjectType Identity
philosopherType :: Out.ObjectType (Either SomeException)
philosopherType = Out.ObjectType "Philosopher" Nothing []
$ HashMap.fromList resolvers
where
@ -54,7 +53,7 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
lastNameResolver = pure $ Type.String "Nietzsche"
subscriptionType :: Out.ObjectType Identity
subscriptionType :: Out.ObjectType (Either SomeException)
subscriptionType = Out.ObjectType "Subscription" Nothing []
$ HashMap.singleton "newQuote"
$ EventStreamResolver quoteField (pure $ Type.Object mempty)
@ -63,7 +62,7 @@ subscriptionType = Out.ObjectType "Subscription" Nothing []
quoteField =
Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
quoteType :: Out.ObjectType Identity
quoteType :: Out.ObjectType (Either SomeException)
quoteType = Out.ObjectType "Quote" Nothing []
$ HashMap.singleton "quote"
$ ValueResolver quoteField
@ -84,9 +83,7 @@ spec =
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
@ -98,9 +95,7 @@ spec =
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
actual = fromRight (singleError "")
$ runIdentity
$ either (pure . parseError) execute'
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
context "Subscription" $
@ -112,8 +107,7 @@ spec =
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
Left stream = runIdentity
$ either (pure . parseError) execute'
Right (Left stream) = either (pure . parseError) execute'
$ parse document "" "subscription { newQuote { quote } }"
Just actual = runConduitPure $ stream .| await
Right (Just actual) = runConduit $ stream .| await
in actual `shouldBe` expected