prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -24,12 +24,16 @@ and this project adheres to
- Parsing subscriptions (the execution always fails yet).
- `Error.ResponseEventStream`, `Type.Out.Resolve`, `Type.Out.Subscribe` and
`Type.Out.SourceEventStream` define subscription resolvers.
- `Error.ResolverException` is an exception that can be thrown by (field value
and event stream) resolvers to signalize an error. Other exceptions will
escape.
## Changed
- `Type.Out.Resolver`: Interface fields don't have resolvers, object fields
have value resolvers, root subscription type resolvers need an additional
resolver that creates an event stream. `Resolver` represents these differences
now and pairs a field with the function(s).
now and pairs a field with the function(s). Resolvers don't have `ExceptT`,
errors are handled with `MonadThrow`/`MonadCatch`.
- All code from `Trans` is moved to `Type.Out` and exported by `Type` and
`Type.Out`.
- `AST.Core` contained only `Arguments` which was moved to `Type.Definition`.
@ -43,6 +47,8 @@ and this project adheres to
variable names is changed back to JSON since it is a common format and it
saves additional conversions. Custom format still can be used with the
underlying functions (in the `Execute` module).
- The constraint of the base monad was changed to `MonadCatch` (and it implies
`MonadThrow`).
## Removed
- `Trans.ActionT` is an unneeded layer of complexity. `Type.Out.Resolver`

4
graphql.cabal
View File

@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
-- hash: 38e16611476c6163a049a4ddbaef34cf3fdef8f85d25f7bcaed839372c9fdf75
-- hash: f3469205f704a81ee0f55655758cf588a9e9eb52303dadd58def32a2eb207696
name: graphql
version: 0.8.0.0
@ -64,6 +64,7 @@ library
, base >=4.7 && <5
, conduit
, containers
, exceptions
, megaparsec
, parser-combinators
, scientific
@ -100,6 +101,7 @@ test-suite tasty
, base >=4.7 && <5
, conduit
, containers
, exceptions
, graphql
, hspec
, hspec-expectations

1
package.yaml
View File

@ -30,6 +30,7 @@ dependencies:
- base >= 4.7 && < 5
- conduit
- containers
- exceptions
- megaparsec
- parser-combinators
- scientific

5
src/Language/GraphQL.hs
View File

@ -7,6 +7,7 @@ module Language.GraphQL
, graphqlSubs
) where
import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Either (fromRight)
@ -20,7 +21,7 @@ import Text.Megaparsec (parse)
-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
graphql :: Monad m
graphql :: MonadCatch m
=> Schema m -- ^ Resolvers.
-> Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response.
@ -29,7 +30,7 @@ graphql schema = graphqlSubs schema mempty mempty
-- | If the text parses correctly as a @GraphQL@ query the substitution is
-- applied to the query and the query is then executed using to the given
-- 'Schema'.
graphqlSubs :: Monad m
graphqlSubs :: MonadCatch m
=> Schema m -- ^ Resolvers.
-> Maybe Text -- ^ Operation name.
-> Aeson.Object -- ^ Variable substitution function.

12
src/Language/GraphQL/Error.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@ -8,6 +9,7 @@ module Language.GraphQL.Error
, CollectErrsT
, Error(..)
, Resolution(..)
, ResolverException(..)
, Response(..)
, ResponseEventStream
, addErr
@ -17,6 +19,7 @@ module Language.GraphQL.Error
) where
import Conduit
import Control.Exception (Exception(..))
import Control.Monad.Trans.State (StateT, modify, runStateT)
import Data.HashMap.Strict (HashMap)
import Data.Sequence (Seq(..), (|>))
@ -102,6 +105,15 @@ data Response a = Response
-- Stream.
type ResponseEventStream m a = ConduitT () (Response a) m ()
-- | Only exceptions that inherit from 'ResolverException' a cought by the
-- executor.
data ResolverException = forall e. Exception e => ResolverException e
instance Show ResolverException where
show (ResolverException e) = show e
instance Exception ResolverException
-- | Runs the given query computation, but collects the errors into an error
-- list, which is then sent back with the data.
runCollectErrs :: (Monad m, Serialize a)

7
src/Language/GraphQL/Execute.hs
View File

@ -6,6 +6,7 @@ module Language.GraphQL.Execute
, module Language.GraphQL.Execute.Coerce
) where
import Control.Monad.Catch (MonadCatch)
import Data.HashMap.Strict (HashMap)
import Data.Sequence (Seq(..))
import Data.Text (Text)
@ -25,7 +26,7 @@ import Language.GraphQL.Type.Schema
--
-- Returns the result of the query against the schema wrapped in a /data/
-- field, or errors wrapped in an /errors/ field.
execute :: (Monad m, VariableValue a, Serialize b)
execute :: (MonadCatch m, VariableValue a, Serialize b)
=> Schema m -- ^ Resolvers.
-> Maybe Text -- ^ Operation name.
-> HashMap Name a -- ^ Variable substitution function.
@ -39,7 +40,7 @@ execute schema operationName subs document =
$ Transform.queryError queryError
Right transformed -> executeRequest transformed
executeRequest :: (Monad m, Serialize a)
executeRequest :: (MonadCatch m, Serialize a)
=> Transform.Document m
-> m (Either (ResponseEventStream m a) (Response a))
executeRequest (Transform.Document types' rootObjectType operation)
@ -53,7 +54,7 @@ executeRequest (Transform.Document types' rootObjectType operation)
-- This is actually executeMutation, but we don't distinguish between queries
-- and mutations yet.
executeOperation :: (Monad m, Serialize a)
executeOperation :: (MonadCatch m, Serialize a)
=> HashMap Name (Type m)
-> Out.ObjectType m
-> Seq (Transform.Selection m)

33
src/Language/GraphQL/Execute/Execution.hs
View File

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

21
src/Language/GraphQL/Execute/Subscribe.hs
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)

7
src/Language/GraphQL/Type/Out.hs
View File

@ -33,7 +33,6 @@ module Language.GraphQL.Type.Out
) where
import Conduit
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Reader (ReaderT, asks)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
@ -180,11 +179,11 @@ data Context = Context
-- | Monad transformer stack used by the resolvers for determining the resolved
-- value of a field.
type Resolve m = ExceptT Text (ReaderT Context m) Value
type Resolve m = ReaderT Context m Value
-- | Monad transformer stack used by the resolvers for determining the resolved
-- event stream of a subscription field.
type Subscribe m = ExceptT Text (ReaderT Context m) (SourceEventStream m)
type Subscribe m = ReaderT Context m (SourceEventStream m)
-- | A source stream represents the sequence of events, each of which will
-- trigger a GraphQL execution corresponding to that event.
@ -206,7 +205,7 @@ data Resolver m
-- be optional then).
argument :: Monad m => Name -> Resolve m
argument argumentName = do
argumentValue <- lift $ asks $ lookupArgument . arguments
argumentValue <- asks $ lookupArgument . arguments
pure $ fromMaybe Null argumentValue
where
lookupArgument (Arguments argumentMap) =

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

22
tests/Test/StarWars/Data.hs
View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars.Data
( Character
, StarWarsException(..)
, appearsIn
, artoo
, getDroid
@ -16,11 +17,12 @@ module Test.StarWars.Data
, typeName
) where
import Data.Functor.Identity (Identity)
import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException)
import Control.Applicative (Alternative(..), liftA2)
import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Typeable (cast)
import Language.GraphQL.Error
import Language.GraphQL.Type
-- * Data
@ -66,8 +68,20 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x
secretBackstory :: Resolve Identity
secretBackstory = throwE "secretBackstory is secret."
data StarWarsException = SecretBackstory | InvalidArguments
instance Show StarWarsException where
show SecretBackstory = "secretBackstory is secret."
show InvalidArguments = "Invalid arguments."
instance Exception StarWarsException where
toException = toException . ResolverException
fromException e = do
ResolverException resolverException <- fromException e
cast resolverException
secretBackstory :: Resolve (Either SomeException)
secretBackstory = throwM SecretBackstory
typeName :: Character -> Text
typeName = either (const "Droid") (const "Human")

8
tests/Test/StarWars/QuerySpec.hs
View File

@ -6,7 +6,6 @@ module Test.StarWars.QuerySpec
import qualified Data.Aeson as Aeson
import Data.Aeson ((.=))
import Data.Functor.Identity (Identity(..))
import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL
@ -357,8 +356,11 @@ spec = describe "Star Wars Query Tests" $ do
alderaan = "homePlanet" .= ("Alderaan" :: Text)
testQuery :: Text -> Aeson.Value -> Expectation
testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
testQuery q expected =
let Right actual = graphql schema q
in actual `shouldBe` expected
testQueryParams :: Aeson.Object -> Text -> Aeson.Value -> Expectation
testQueryParams f q expected =
runIdentity (graphqlSubs schema Nothing f q) `shouldBe` expected
let Right actual = graphqlSubs schema Nothing f q
in actual `shouldBe` expected

36
tests/Test/StarWars/Schema.hs
View File

@ -4,10 +4,8 @@ module Test.StarWars.Schema
( schema
) where
import Control.Monad.Catch (MonadThrow(..), SomeException)
import Control.Monad.Trans.Reader (asks)
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
import Data.Functor.Identity (Identity)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (catMaybes)
import Data.Text (Text)
@ -19,7 +17,7 @@ import Prelude hiding (id)
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
schema :: Schema Identity
schema :: Schema (Either SomeException)
schema = Schema
{ query = queryType
, mutation = Nothing
@ -42,7 +40,7 @@ schema = Schema
droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
droidFieldResolver = ValueResolver droidField droid
heroObject :: Out.ObjectType Identity
heroObject :: Out.ObjectType (Either SomeException)
heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
[ ("id", idFieldType)
, ("name", nameFieldType)
@ -57,7 +55,7 @@ heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "homePlanet"
droidObject :: Out.ObjectType Identity
droidObject :: Out.ObjectType (Either SomeException)
droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
[ ("id", idFieldType)
, ("name", nameFieldType)
@ -72,29 +70,29 @@ droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "primaryFunction"
typenameFieldType :: Resolver Identity
typenameFieldType :: Resolver (Either SomeException)
typenameFieldType
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "__typename"
idFieldType :: Resolver Identity
idFieldType :: Resolver (Either SomeException)
idFieldType
= ValueResolver (Out.Field Nothing (Out.NamedScalarType id) mempty)
$ idField "id"
nameFieldType :: Resolver Identity
nameFieldType :: Resolver (Either SomeException)
nameFieldType
= ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "name"
friendsFieldType :: Resolver Identity
friendsFieldType :: Resolver (Either SomeException)
friendsFieldType
= ValueResolver (Out.Field Nothing fieldType mempty)
$ idField "friends"
where
fieldType = Out.ListType $ Out.NamedObjectType droidObject
appearsInField :: Resolver Identity
appearsInField :: Resolver (Either SomeException)
appearsInField
= ValueResolver (Out.Field (Just description) fieldType mempty)
$ idField "appearsIn"
@ -102,14 +100,14 @@ appearsInField
fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
description = "Which movies they appear in."
secretBackstoryFieldType :: Resolver Identity
secretBackstoryFieldType :: Resolver (Either SomeException)
secretBackstoryFieldType = ValueResolver field secretBackstory
where
field = Out.Field Nothing (Out.NamedScalarType string) mempty
idField :: Text -> Resolve Identity
idField :: Text -> Resolve (Either SomeException)
idField f = do
v <- lift $ asks values
v <- asks values
let (Object v') = v
pure $ v' HashMap.! f
@ -122,7 +120,7 @@ episodeEnum = EnumType "Episode" (Just description)
empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
hero :: Resolve Identity
hero :: Resolve (Either SomeException)
hero = do
episode <- argument "episode"
pure $ character $ case episode of
@ -131,19 +129,19 @@ hero = do
Enum "JEDI" -> getHero 6
_ -> artoo
human :: Resolve Identity
human :: Resolve (Either SomeException)
human = do
id' <- argument "id"
case id' of
String i -> pure $ maybe Null character $ getHuman i >>= Just
_ -> throwE "Invalid arguments."
_ -> throwM InvalidArguments
droid :: Resolve Identity
droid :: Resolve (Either SomeException)
droid = do
id' <- argument "id"
case id' of
String i -> pure $ maybe Null character $ getDroid i >>= Just
_ -> throwE "Invalid arguments."
_ -> throwM InvalidArguments
character :: Character -> Value
character char = Object $ HashMap.fromList