Combine Resolver and ActionT in ResolverT

This commit is contained in:
Eugen Wissner 2020-06-29 13:14:23 +02:00
parent 9798b08b4c
commit 705e506c13
13 changed files with 127 additions and 107 deletions

View File

@ -7,6 +7,14 @@ and this project adheres to
[Haskell Package Versioning Policy](https://pvp.haskell.org/). [Haskell Package Versioning Policy](https://pvp.haskell.org/).
## [Unreleased] ## [Unreleased]
## Changed
- `Trans.ActionT` is renamed to `ResolverT`. Since `Type.Out.Resolver` has gone
it is a better name for GraphQL resolvers.
## Removed
- `Type.Out.Resolver`: It is an unneeded layer of complexity. Resolvers are a
part of the fields and are called `Trans.ResolverT`.
## [0.8.0.0] - 2020-06-20 ## [0.8.0.0] - 2020-06-20
### Fixed ### Fixed
- The parser rejects variables when parsing defaultValue (DefaultValue). The - The parser rejects variables when parsing defaultValue (DefaultValue). The

View File

@ -41,13 +41,12 @@ First we build a GraphQL schema.
> >
> queryType :: ObjectType IO > queryType :: ObjectType IO
> queryType = ObjectType "Query" Nothing [] > queryType = ObjectType "Query" Nothing []
> $ HashMap.singleton "hello" > $ HashMap.singleton "hello" helloField
> $ Out.Resolver helloField hello
> >
> helloField :: Field IO > helloField :: Field IO
> helloField = Field Nothing (Out.NamedScalarType string) mempty > helloField = Field Nothing (Out.NamedScalarType string) mempty hello
> >
> hello :: ActionT IO Value > hello :: ResolverT IO Value
> hello = pure $ String "it's me" > hello = pure $ String "it's me"
This defines a simple schema with one type and one field, that resolves to a fixed value. This defines a simple schema with one type and one field, that resolves to a fixed value.
@ -79,13 +78,12 @@ For this example, we're going to be using time.
> >
> queryType2 :: ObjectType IO > queryType2 :: ObjectType IO
> queryType2 = ObjectType "Query" Nothing [] > queryType2 = ObjectType "Query" Nothing []
> $ HashMap.singleton "time" > $ HashMap.singleton "time" timeField
> $ Out.Resolver timeField time
> >
> timeField :: Field IO > timeField :: Field IO
> timeField = Field Nothing (Out.NamedScalarType string) mempty > timeField = Field Nothing (Out.NamedScalarType string) mempty time
> >
> time :: ActionT IO Value > time :: ResolverT IO Value
> time = do > time = do
> t <- liftIO getCurrentTime > t <- liftIO getCurrentTime
> pure $ String $ Text.pack $ show t > pure $ String $ Text.pack $ show t
@ -146,8 +144,8 @@ Now that we have two resolvers, we can define a schema which uses them both.
> >
> queryType3 :: ObjectType IO > queryType3 :: ObjectType IO
> queryType3 = ObjectType "Query" Nothing [] $ HashMap.fromList > queryType3 = ObjectType "Query" Nothing [] $ HashMap.fromList
> [ ("hello", Out.Resolver helloField hello) > [ ("hello", helloField)
> , ("time", Out.Resolver timeField time) > , ("time", timeField)
> ] > ]
> >
> query3 :: Text > query3 :: Text

View File

@ -33,12 +33,12 @@ import Prelude hiding (null)
resolveFieldValue :: Monad m resolveFieldValue :: Monad m
=> Type.Value => Type.Value
-> Type.Subs -> Type.Subs
-> ActionT m a -> ResolverT m a
-> m (Either Text a) -> m (Either Text a)
resolveFieldValue result args = resolveFieldValue result args =
flip runReaderT (Context {arguments = Arguments args, values = result}) flip runReaderT (Context {arguments = Arguments args, values = result})
. runExceptT . runExceptT
. runActionT . runResolverT
collectFields :: Monad m collectFields :: Monad m
=> Out.ObjectType m => Out.ObjectType m
@ -99,12 +99,12 @@ instanceOf objectType (AbstractUnionType unionType) =
go unionMemberType acc = acc || objectType == unionMemberType go unionMemberType acc = acc || objectType == unionMemberType
executeField :: (Monad m, Serialize a) executeField :: (Monad m, Serialize a)
=> Out.Resolver m => Out.Field m
-> Type.Value -> Type.Value
-> NonEmpty (Transform.Field m) -> NonEmpty (Transform.Field m)
-> CollectErrsT m a -> CollectErrsT m a
executeField (Out.Resolver fieldDefinition resolver) prev fields = do executeField fieldDefinition prev fields = do
let Out.Field _ fieldType argumentDefinitions = fieldDefinition let Out.Field _ fieldType argumentDefinitions resolver = fieldDefinition
let (Transform.Field _ _ arguments' _ :| []) = fields let (Transform.Field _ _ arguments' _ :| []) = fields
case coerceArgumentValues argumentDefinitions arguments' of case coerceArgumentValues argumentDefinitions arguments' of
Nothing -> errmsg "Argument coercing failed." Nothing -> errmsg "Argument coercing failed."

View File

@ -1,7 +1,7 @@
-- | Monad transformer stack used by the @GraphQL@ resolvers. -- | Monad transformer stack used by the @GraphQL@ resolvers.
module Language.GraphQL.Trans module Language.GraphQL.Trans
( argument ( argument
, ActionT(..) , ResolverT(..)
, Context(..) , Context(..)
) where ) where
@ -26,42 +26,49 @@ data Context = Context
} }
-- | Monad transformer stack used by the resolvers to provide error handling -- | Monad transformer stack used by the resolvers to provide error handling
-- and resolution context (resolver arguments). -- and resolution context (resolver arguments).
newtype ActionT m a = ActionT --
{ runActionT :: ExceptT Text (ReaderT Context m) a -- Resolves a 'Field' into a 'Value' with error information (if an error has
-- occurred). @m@ is an arbitrary monad, usually 'IO'.
--
-- Resolving a field can result in a leaf value or an object, which is
-- represented as a list of nested resolvers, used to resolve the fields of that
-- object.
newtype ResolverT m a = ResolverT
{ runResolverT :: ExceptT Text (ReaderT Context m) a
} }
instance Functor m => Functor (ActionT m) where instance Functor m => Functor (ResolverT m) where
fmap f = ActionT . fmap f . runActionT fmap f = ResolverT . fmap f . runResolverT
instance Monad m => Applicative (ActionT m) where instance Monad m => Applicative (ResolverT m) where
pure = ActionT . pure pure = ResolverT . pure
(ActionT f) <*> (ActionT x) = ActionT $ f <*> x (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x
instance Monad m => Monad (ActionT m) where instance Monad m => Monad (ResolverT m) where
return = pure return = pure
(ActionT action) >>= f = ActionT $ action >>= runActionT . f (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f
instance MonadTrans ActionT where instance MonadTrans ResolverT where
lift = ActionT . lift . lift lift = ResolverT . lift . lift
instance MonadIO m => MonadIO (ActionT m) where instance MonadIO m => MonadIO (ResolverT m) where
liftIO = lift . liftIO liftIO = lift . liftIO
instance Monad m => Alternative (ActionT m) where instance Monad m => Alternative (ResolverT m) where
empty = ActionT empty empty = ResolverT empty
(ActionT x) <|> (ActionT y) = ActionT $ x <|> y (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y
instance Monad m => MonadPlus (ActionT m) where instance Monad m => MonadPlus (ResolverT m) where
mzero = empty mzero = empty
mplus = (<|>) mplus = (<|>)
-- | Retrieves an argument by its name. If the argument with this name couldn't -- | Retrieves an argument by its name. If the argument with this name couldn't
-- be found, returns 'Null' (i.e. the argument is assumed to -- be found, returns 'Null' (i.e. the argument is assumed to
-- be optional then). -- be optional then).
argument :: Monad m => Name -> ActionT m Value argument :: Monad m => Name -> ResolverT m Value
argument argumentName = do argument argumentName = do
argumentValue <- ActionT $ lift $ asks $ lookup . arguments argumentValue <- ResolverT $ lift $ asks $ lookup . arguments
pure $ fromMaybe Null argumentValue pure $ fromMaybe Null argumentValue
where where
lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap

View File

@ -10,7 +10,6 @@ module Language.GraphQL.Type.Out
( Field(..) ( Field(..)
, InterfaceType(..) , InterfaceType(..)
, ObjectType(..) , ObjectType(..)
, Resolver(..)
, Type(..) , Type(..)
, UnionType(..) , UnionType(..)
, isNonNullType , isNonNullType
@ -29,21 +28,12 @@ import Language.GraphQL.Trans
import Language.GraphQL.Type.Definition import Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.In as In
-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
-- information (if an error has occurred). @m@ is an arbitrary monad, usually
-- 'IO'.
--
-- Resolving a field can result in a leaf value or an object, which is
-- represented as a list of nested resolvers, used to resolve the fields of that
-- object.
data Resolver m = Resolver (Field m) (ActionT m Value)
-- | Object type definition. -- | Object type definition.
-- --
-- Almost all of the GraphQL types you define will be object types. Object -- Almost all of the GraphQL types you define will be object types. Object
-- types have a name, but most importantly describe their fields. -- types have a name, but most importantly describe their fields.
data ObjectType m = ObjectType data ObjectType m = ObjectType
Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m)) Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
instance forall a. Eq (ObjectType a) where instance forall a. Eq (ObjectType a) where
(ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that (ObjectType this _ _ _) == (ObjectType that _ _ _) = this == that
@ -73,6 +63,7 @@ data Field m = Field
(Maybe Text) -- ^ Description. (Maybe Text) -- ^ Description.
(Type m) -- ^ Field type. (Type m) -- ^ Field type.
(HashMap Name In.Argument) -- ^ Arguments. (HashMap Name In.Argument) -- ^ Arguments.
(ResolverT m Value) -- ^ Resolver.
-- | These types may be used as output types as the result of fields. -- | These types may be used as output types as the result of fields.
-- --

View File

@ -61,7 +61,7 @@ collectReferencedTypes schema =
collect traverser typeName element foundTypes collect traverser typeName element foundTypes
| HashMap.member typeName foundTypes = foundTypes | HashMap.member typeName foundTypes = foundTypes
| otherwise = traverser $ HashMap.insert typeName element foundTypes | otherwise = traverser $ HashMap.insert typeName element foundTypes
visitFields (Out.Field _ outputType arguments) foundTypes visitFields (Out.Field _ outputType arguments _) foundTypes
= traverseOutputType outputType = traverseOutputType outputType
$ foldr visitArguments foundTypes arguments $ foldr visitArguments foundTypes arguments
visitArguments (In.Argument _ inputType _) = traverseInputType inputType visitArguments (In.Argument _ inputType _) = traverseInputType inputType
@ -96,9 +96,8 @@ collectReferencedTypes schema =
let (Definition.EnumType typeName _ _) = enumType let (Definition.EnumType typeName _ _) = enumType
in collect Prelude.id typeName (EnumType enumType) in collect Prelude.id typeName (EnumType enumType)
traverseObjectType objectType foundTypes = traverseObjectType objectType foundTypes =
let (Out.ObjectType typeName _ interfaces resolvers) = objectType let (Out.ObjectType typeName _ interfaces fields) = objectType
element = ObjectType objectType element = ObjectType objectType
fields = extractObjectField <$> resolvers
traverser = polymorphicTraverser interfaces fields traverser = polymorphicTraverser interfaces fields
in collect traverser typeName element foundTypes in collect traverser typeName element foundTypes
traverseInterfaceType interfaceType foundTypes = traverseInterfaceType interfaceType foundTypes =
@ -109,4 +108,3 @@ collectReferencedTypes schema =
polymorphicTraverser interfaces fields polymorphicTraverser interfaces fields
= flip (foldr visitFields) fields = flip (foldr visitFields) fields
. flip (foldr traverseInterfaceType) interfaces . flip (foldr traverseInterfaceType) interfaces
extractObjectField (Out.Resolver field _) = field

View File

@ -1,4 +1,4 @@
resolver: lts-16.2 resolver: lts-16.3
packages: packages:
- . - .

View File

@ -22,26 +22,26 @@ schema = Schema {query = queryType, mutation = Nothing}
queryType :: Out.ObjectType Identity queryType :: Out.ObjectType Identity
queryType = Out.ObjectType "Query" Nothing [] queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "philosopher" $ HashMap.singleton "philosopher" philosopherField
$ Out.Resolver philosopherField
$ pure
$ Type.Object mempty
where where
philosopherField = philosopherField
Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty = Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
$ pure $ Type.Object mempty
philosopherType :: Out.ObjectType Identity philosopherType :: Out.ObjectType Identity
philosopherType = Out.ObjectType "Philosopher" Nothing [] philosopherType = Out.ObjectType "Philosopher" Nothing []
$ HashMap.fromList resolvers $ HashMap.fromList resolvers
where where
resolvers = resolvers =
[ ("firstName", firstNameResolver) [ ("firstName", firstNameField)
, ("lastName", lastNameResolver) , ("lastName", lastNameField)
] ]
firstNameResolver = Out.Resolver firstNameField $ pure $ Type.String "Friedrich" firstNameField
lastNameResolver = Out.Resolver lastNameField $ pure $ Type.String "Nietzsche" = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
firstNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty $ pure $ Type.String "Friedrich"
lastNameField = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty lastNameField
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
$ pure $ Type.String "Nietzsche"
spec :: Spec spec :: Spec
spec = spec =

View File

@ -19,7 +19,7 @@ experimentalResolver = Schema { query = queryType, mutation = Nothing }
resolver = pure $ Int 5 resolver = pure $ Int 5
queryType = Out.ObjectType "Query" Nothing [] queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "experimentalField" $ HashMap.singleton "experimentalField"
$ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty) resolver $ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
emptyObject :: Aeson.Value emptyObject :: Aeson.Value
emptyObject = object emptyObject = object

View File

@ -53,22 +53,24 @@ hasErrors _ = True
shirtType :: Out.ObjectType IO shirtType :: Out.ObjectType IO
shirtType = Out.ObjectType "Shirt" Nothing [] shirtType = Out.ObjectType "Shirt" Nothing []
$ HashMap.fromList $ HashMap.fromList
[ ("size", Out.Resolver sizeFieldType $ pure $ snd size) [ ("size", sizeFieldType)
, ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference) , ("circumference", circumferenceFieldType)
] ]
hatType :: Out.ObjectType IO hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing [] hatType = Out.ObjectType "Hat" Nothing []
$ HashMap.fromList $ HashMap.fromList
[ ("size", Out.Resolver sizeFieldType $ pure $ snd size) [ ("size", sizeFieldType)
, ("circumference", Out.Resolver circumferenceFieldType $ pure $ snd circumference) , ("circumference", circumferenceFieldType)
] ]
circumferenceFieldType :: Out.Field IO circumferenceFieldType :: Out.Field IO
circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty
$ pure $ snd circumference
sizeFieldType :: Out.Field IO sizeFieldType :: Out.Field IO
sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ pure $ snd size
toSchema :: Text -> (Text, Value) -> Schema IO toSchema :: Text -> (Text, Value) -> Schema IO
toSchema t (_, resolve) = Schema toSchema t (_, resolve) = Schema
@ -76,15 +78,17 @@ toSchema t (_, resolve) = Schema
where where
unionMember = if t == "Hat" then hatType else shirtType unionMember = if t == "Hat" then hatType else shirtType
typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
$ pure $ String "Shirt"
garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
$ pure resolve
queryType = queryType =
case t of case t of
"circumference" -> hatType "circumference" -> hatType
"size" -> shirtType "size" -> shirtType
_ -> Out.ObjectType "Query" Nothing [] _ -> Out.ObjectType "Query" Nothing []
$ HashMap.fromList $ HashMap.fromList
[ ("garment", Out.Resolver garmentField $ pure resolve) [ ("garment", garmentField)
, ("__typename", Out.Resolver typeNameField $ pure $ String "Shirt") , ("__typename", typeNameField)
] ]
spec :: Spec spec :: Spec

View File

@ -15,8 +15,9 @@ import qualified Language.GraphQL.Type.Out as Out
hatType :: Out.ObjectType IO hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing [] hatType = Out.ObjectType "Hat" Nothing []
$ HashMap.singleton "circumference" $ HashMap.singleton "circumference"
$ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty) $ Out.Field Nothing (Out.NamedScalarType int) mempty
$ pure $ Int 60 $ pure
$ Int 60
schema :: Schema IO schema :: Schema IO
schema = Schema schema = Schema
@ -27,10 +28,10 @@ schema = Schema
[ ("circumference", Int 60) [ ("circumference", Int 60)
] ]
incrementField = HashMap.singleton "incrementCircumference" incrementField = HashMap.singleton "incrementCircumference"
$ Out.Resolver (Out.Field Nothing (Out.NamedScalarType int) mempty) $ Out.Field Nothing (Out.NamedScalarType int) mempty
$ pure $ Int 61 $ pure $ Int 61
hatField = HashMap.singleton "garment" hatField = HashMap.singleton "garment"
$ Out.Resolver (Out.Field Nothing (Out.NamedObjectType hatType) mempty) garment $ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
spec :: Spec spec :: Spec
spec = spec =

View File

@ -66,8 +66,8 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x appearsIn (Right x) = _appearsIn . _humanChar $ x
secretBackstory :: ActionT Identity Text secretBackstory :: ResolverT Identity Text
secretBackstory = ActionT $ throwE "secretBackstory is secret." secretBackstory = ResolverT $ throwE "secretBackstory is secret."
typeName :: Character -> Text typeName :: Character -> Text
typeName = either (const "Droid") (const "Human") typeName = either (const "Droid") (const "Human")

View File

@ -24,65 +24,78 @@ schema :: Schema Identity
schema = Schema { query = queryType, mutation = Nothing } schema = Schema { query = queryType, mutation = Nothing }
where where
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
[ ("hero", Out.Resolver heroField hero) [ ("hero", heroField)
, ("human", Out.Resolver humanField human) , ("human", humanField)
, ("droid", Out.Resolver droidField droid) , ("droid", droidField)
] ]
heroField = Out.Field Nothing (Out.NamedObjectType heroObject) heroArguments = HashMap.singleton "episode"
$ HashMap.singleton "episode"
$ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
humanField = Out.Field Nothing (Out.NamedObjectType heroObject) heroField =
$ HashMap.singleton "id" Out.Field Nothing (Out.NamedObjectType heroObject) heroArguments hero
humanArguments = HashMap.singleton "id"
$ In.Argument Nothing (In.NonNullScalarType string) Nothing $ In.Argument Nothing (In.NonNullScalarType string) Nothing
droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty humanField =
Out.Field Nothing (Out.NamedObjectType heroObject) humanArguments human
droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty droid
heroObject :: Out.ObjectType Identity heroObject :: Out.ObjectType Identity
heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
[ ("id", Out.Resolver idFieldType (idField "id")) [ ("id", idFieldType)
, ("name", Out.Resolver nameFieldType (idField "name")) , ("name", nameFieldType)
, ("friends", Out.Resolver friendsFieldType (idField "friends")) , ("friends", friendsFieldType)
, ("appearsIn", Out.Resolver appearsInField (idField "appearsIn")) , ("appearsIn", appearsInField)
, ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet")) , ("homePlanet", homePlanetFieldType)
, ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory)) , ("secretBackstory", secretBackstoryFieldType)
, ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename")) , ("__typename", typenameFieldType)
] ]
where where
homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ idField "homePlanet"
droidObject :: Out.ObjectType Identity droidObject :: Out.ObjectType Identity
droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
[ ("id", Out.Resolver idFieldType (idField "id")) [ ("id", idFieldType)
, ("name", Out.Resolver nameFieldType (idField "name")) , ("name", nameFieldType)
, ("friends", Out.Resolver friendsFieldType (idField "friends")) , ("friends", friendsFieldType)
, ("appearsIn", Out.Resolver appearsInField (idField "appearsIn")) , ("appearsIn", appearsInField)
, ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction")) , ("primaryFunction", primaryFunctionFieldType)
, ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory)) , ("secretBackstory", secretBackstoryFieldType)
, ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename")) , ("__typename", typenameFieldType)
] ]
where where
primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ idField "primaryFunction"
typenameFieldType :: Out.Field Identity
typenameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ idField "__typename"
idFieldType :: Out.Field Identity idFieldType :: Out.Field Identity
idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
$ idField "id"
nameFieldType :: Out.Field Identity nameFieldType :: Out.Field Identity
nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ idField "name"
friendsFieldType :: Out.Field Identity friendsFieldType :: Out.Field Identity
friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
$ idField "friends"
appearsInField :: Out.Field Identity appearsInField :: Out.Field Identity
appearsInField = Out.Field (Just description) fieldType mempty appearsInField = Out.Field (Just description) fieldType mempty
$ idField "appearsIn"
where where
fieldType = Out.ListType $ Out.NamedEnumType episodeEnum fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
description = "Which movies they appear in." description = "Which movies they appear in."
secretBackstoryFieldType :: Out.Field Identity secretBackstoryFieldType :: Out.Field Identity
secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
$ String <$> secretBackstory
idField :: Text -> ActionT Identity Value idField :: Text -> ResolverT Identity Value
idField f = do idField f = do
v <- ActionT $ lift $ asks values v <- ResolverT $ lift $ asks values
let (Object v') = v let (Object v') = v
pure $ v' HashMap.! f pure $ v' HashMap.! f
@ -95,7 +108,7 @@ episodeEnum = EnumType "Episode" (Just description)
empire = ("EMPIRE", EnumValue $ Just "Released in 1980.") empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
jedi = ("JEDI", EnumValue $ Just "Released in 1983.") jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
hero :: ActionT Identity Value hero :: ResolverT Identity Value
hero = do hero = do
episode <- argument "episode" episode <- argument "episode"
pure $ character $ case episode of pure $ character $ case episode of
@ -104,7 +117,7 @@ hero = do
Enum "JEDI" -> getHero 6 Enum "JEDI" -> getHero 6
_ -> artoo _ -> artoo
human :: ActionT Identity Value human :: ResolverT Identity Value
human = do human = do
id' <- argument "id" id' <- argument "id"
case id' of case id' of
@ -113,14 +126,14 @@ human = do
case humanCharacter of case humanCharacter of
Nothing -> pure Null Nothing -> pure Null
Just e -> pure $ character e Just e -> pure $ character e
_ -> ActionT $ throwE "Invalid arguments." _ -> ResolverT $ throwE "Invalid arguments."
droid :: ActionT Identity Value droid :: ResolverT Identity Value
droid = do droid = do
id' <- argument "id" id' <- argument "id"
case id' of case id' of
String i -> character <$> getDroid i String i -> character <$> getDroid i
_ -> ActionT $ throwE "Invalid arguments." _ -> ResolverT $ throwE "Invalid arguments."
character :: Character -> Value character :: Character -> Value
character char = Object $ HashMap.fromList character char = Object $ HashMap.fromList