forked from OSS/graphql
Define resolvers on type fields
Returning resolvers from other resolvers isn't supported anymore. Since we have a type system now, we define the resolvers in the object type fields and pass an object with the previous result to them.
This commit is contained in:
@ -66,8 +66,8 @@ appearsIn :: Character -> [Int]
|
||||
appearsIn (Left x) = _appearsIn . _droidChar $ x
|
||||
appearsIn (Right x) = _appearsIn . _humanChar $ x
|
||||
|
||||
secretBackstory :: Character -> ActionT Identity Text
|
||||
secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
|
||||
secretBackstory :: ActionT Identity Text
|
||||
secretBackstory = ActionT $ throwE "secretBackstory is secret."
|
||||
|
||||
typeName :: Character -> Text
|
||||
typeName = either (const "Droid") (const "Human")
|
||||
|
@ -1,24 +1,22 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Test.StarWars.Schema
|
||||
( character
|
||||
, droid
|
||||
, hero
|
||||
, human
|
||||
, schema
|
||||
( schema
|
||||
) where
|
||||
|
||||
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 qualified Language.GraphQL.Schema as Schema
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type.Definition
|
||||
import qualified Language.GraphQL.Type.In as In
|
||||
import qualified Language.GraphQL.Type.Out as Out
|
||||
import Language.GraphQL.Type.Schema
|
||||
import Test.StarWars.Data
|
||||
import Prelude hiding (id)
|
||||
|
||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
|
||||
|
||||
@ -26,50 +24,72 @@ schema :: Schema Identity
|
||||
schema = Schema { query = queryType, mutation = Nothing }
|
||||
where
|
||||
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
|
||||
[ ("hero", Out.Field Nothing (Out.NamedScalarType string) mempty hero)
|
||||
, ("human", Out.Field Nothing (Out.NamedScalarType string) mempty human)
|
||||
, ("droid", Out.Field Nothing (Out.NamedScalarType string) mempty droid)
|
||||
[ ("hero", Out.Field Nothing (Out.NamedObjectType heroObject) mempty hero)
|
||||
, ("human", Out.Field Nothing (Out.NamedObjectType heroObject) mempty human)
|
||||
, ("droid", Out.Field Nothing (Out.NamedObjectType droidObject) mempty droid)
|
||||
]
|
||||
|
||||
hero :: ActionT Identity (Out.Value Identity)
|
||||
heroObject :: Out.ObjectType Identity
|
||||
heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
|
||||
[ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
|
||||
, ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
|
||||
, ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType heroObject) mempty (idField "friends"))
|
||||
, ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
|
||||
, ("homePlanet", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "homePlanet"))
|
||||
, ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
|
||||
, ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
|
||||
]
|
||||
|
||||
droidObject :: Out.ObjectType Identity
|
||||
droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
|
||||
[ ("id", Out.Field Nothing (Out.NamedScalarType id) mempty (idField "id"))
|
||||
, ("name", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "name"))
|
||||
, ("friends", Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty (idField "friends"))
|
||||
, ("appearsIn", Out.Field Nothing (Out.ListType $ Out.NamedScalarType int) mempty (idField "appearsIn"))
|
||||
, ("primaryFunction", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "primaryFunction"))
|
||||
, ("secretBackstory", Out.Field Nothing (Out.NamedScalarType string) mempty (String <$> secretBackstory))
|
||||
, ("__typename", Out.Field Nothing (Out.NamedScalarType string) mempty (idField "__typename"))
|
||||
]
|
||||
|
||||
idField :: Text -> ActionT Identity Value
|
||||
idField f = do
|
||||
v <- ActionT $ lift $ asks values
|
||||
let (Object v') = v
|
||||
pure $ v' HashMap.! f
|
||||
|
||||
hero :: ActionT Identity Value
|
||||
hero = do
|
||||
episode <- argument "episode"
|
||||
pure $ character $ case episode of
|
||||
In.Enum "NEWHOPE" -> getHero 4
|
||||
In.Enum "EMPIRE" -> getHero 5
|
||||
In.Enum "JEDI" -> getHero 6
|
||||
Enum "NEWHOPE" -> getHero 4
|
||||
Enum "EMPIRE" -> getHero 5
|
||||
Enum "JEDI" -> getHero 6
|
||||
_ -> artoo
|
||||
|
||||
human :: ActionT Identity (Out.Value Identity)
|
||||
human :: ActionT Identity Value
|
||||
human = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
In.String i -> do
|
||||
String i -> do
|
||||
humanCharacter <- lift $ return $ getHuman i >>= Just
|
||||
case humanCharacter of
|
||||
Nothing -> pure Out.Null
|
||||
Nothing -> pure Null
|
||||
Just e -> pure $ character e
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
droid :: ActionT Identity (Out.Value Identity)
|
||||
droid :: ActionT Identity Value
|
||||
droid = do
|
||||
id' <- argument "id"
|
||||
case id' of
|
||||
In.String i -> character <$> getDroid i
|
||||
String i -> character <$> getDroid i
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
character :: Character -> Out.Value Identity
|
||||
character char = Schema.object
|
||||
[ Schema.Resolver "id" $ pure $ Out.String $ id_ char
|
||||
, Schema.Resolver "name" $ pure $ Out.String $ name_ char
|
||||
, Schema.Resolver "friends"
|
||||
$ pure $ Out.List $ character <$> getFriends char
|
||||
, Schema.Resolver "appearsIn" $ pure
|
||||
$ Out.List $ Out.Enum <$> catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.Resolver "secretBackstory" $ Out.String
|
||||
<$> secretBackstory char
|
||||
, Schema.Resolver "homePlanet" $ pure $ Out.String
|
||||
$ either mempty homePlanet char
|
||||
, Schema.Resolver "__typename" $ pure $ Out.String
|
||||
$ typeName char
|
||||
character :: Character -> Value
|
||||
character char = Object $ HashMap.fromList
|
||||
[ ("id", String $ id_ char)
|
||||
, ("name", String $ name_ char)
|
||||
, ("friends", List $ character <$> getFriends char)
|
||||
, ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
|
||||
, ("homePlanet", String $ either mempty homePlanet char)
|
||||
, ("__typename", String $ typeName char)
|
||||
]
|
||||
|
Reference in New Issue
Block a user