summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs32
-rw-r--r--tests/Test/DirectiveSpec.hs4
-rw-r--r--tests/Test/FragmentSpec.hs16
-rw-r--r--tests/Test/RootOperationSpec.hs18
-rw-r--r--tests/Test/StarWars/Data.hs12
-rw-r--r--tests/Test/StarWars/Schema.hs87
6 files changed, 90 insertions, 79 deletions
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index e7ab9f8..f994482 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -5,6 +5,7 @@ module Language.GraphQL.ExecuteSpec
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
+import Data.Either (fromRight)
import Data.Functor.Identity (Identity(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
@@ -22,26 +23,27 @@ schema = Schema {query = queryType, mutation = Nothing}
queryType :: Out.ObjectType Identity
queryType = Out.ObjectType "Query" Nothing []
- $ HashMap.singleton "philosopher" philosopherField
+ $ HashMap.singleton "philosopher"
+ $ ValueResolver philosopherField
+ $ pure $ Type.Object mempty
where
- philosopherField
- = Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
- $ pure $ Type.Object mempty
+ philosopherField =
+ Out.Field Nothing (Out.NonNullObjectType philosopherType) HashMap.empty
philosopherType :: Out.ObjectType Identity
philosopherType = Out.ObjectType "Philosopher" Nothing []
$ HashMap.fromList resolvers
where
resolvers =
- [ ("firstName", firstNameField)
- , ("lastName", lastNameField)
+ [ ("firstName", ValueResolver firstNameField firstNameResolver)
+ , ("lastName", ValueResolver lastNameField lastNameResolver)
]
- firstNameField
- = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
- $ pure $ Type.String "Friedrich"
+ firstNameField =
+ Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+ firstNameResolver = pure $ Type.String "Friedrich"
lastNameField
= Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
- $ pure $ Type.String "Nietzsche"
+ lastNameResolver = pure $ Type.String "Nietzsche"
spec :: Spec
spec =
@@ -54,8 +56,9 @@ spec =
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
- actual = runIdentity
- $ either parseError execute'
+ actual = fromRight (singleError "")
+ $ runIdentity
+ $ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
@@ -67,7 +70,8 @@ spec =
]
expected = Response data'' mempty
execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
- actual = runIdentity
- $ either parseError execute'
+ actual = fromRight (singleError "")
+ $ runIdentity
+ $ either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index 3243d2a..4d31cb9 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -16,10 +16,10 @@ import Text.RawString.QQ (r)
experimentalResolver :: Schema IO
experimentalResolver = Schema { query = queryType, mutation = Nothing }
where
- resolver = pure $ Int 5
queryType = Out.ObjectType "Query" Nothing []
$ HashMap.singleton "experimentalField"
- $ Out.Field Nothing (Out.NamedScalarType int) mempty resolver
+ $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 5
emptyObject :: Aeson.Value
emptyObject = object
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 94cc76c..af1812c 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -64,12 +64,14 @@ hatType = Out.ObjectType "Hat" Nothing []
, ("circumference", circumferenceFieldType)
]
-circumferenceFieldType :: Out.Field IO
-circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty
+circumferenceFieldType :: Out.Resolver IO
+circumferenceFieldType
+ = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ snd circumference
-sizeFieldType :: Out.Field IO
-sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+sizeFieldType :: Out.Resolver IO
+sizeFieldType
+ = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ pure $ snd size
toSchema :: Text -> (Text, Value) -> Schema IO
@@ -78,17 +80,15 @@ toSchema t (_, resolve) = Schema
where
unionMember = if t == "Hat" then hatType else shirtType
typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
- $ pure $ String "Shirt"
garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
- $ pure resolve
queryType =
case t of
"circumference" -> hatType
"size" -> shirtType
_ -> Out.ObjectType "Query" Nothing []
$ HashMap.fromList
- [ ("garment", garmentField)
- , ("__typename", typeNameField)
+ [ ("garment", ValueResolver garmentField (pure resolve))
+ , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
]
spec :: Spec
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
index 44b19a6..7202104 100644
--- a/tests/Test/RootOperationSpec.hs
+++ b/tests/Test/RootOperationSpec.hs
@@ -15,23 +15,23 @@ import qualified Language.GraphQL.Type.Out as Out
hatType :: Out.ObjectType IO
hatType = Out.ObjectType "Hat" Nothing []
$ HashMap.singleton "circumference"
- $ Out.Field Nothing (Out.NamedScalarType int) mempty
- $ pure
- $ Int 60
+ $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 60
schema :: Schema IO
schema = Schema
- (Out.ObjectType "Query" Nothing [] hatField)
- (Just $ Out.ObjectType "Mutation" Nothing [] incrementField)
+ (Out.ObjectType "Query" Nothing [] hatFieldResolver)
+ (Just $ Out.ObjectType "Mutation" Nothing [] incrementFieldResolver)
where
garment = pure $ Object $ HashMap.fromList
[ ("circumference", Int 60)
]
- incrementField = HashMap.singleton "incrementCircumference"
- $ Out.Field Nothing (Out.NamedScalarType int) mempty
+ incrementFieldResolver = HashMap.singleton "incrementCircumference"
+ $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
$ pure $ Int 61
- hatField = HashMap.singleton "garment"
- $ Out.Field Nothing (Out.NamedObjectType hatType) mempty garment
+ hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty
+ hatFieldResolver =
+ HashMap.singleton "garment" $ ValueResolver hatField garment
spec :: Spec
spec =
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index dacd0cd..00a89d9 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -66,8 +66,8 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x
-secretBackstory :: ResolverT Identity Text
-secretBackstory = ResolverT $ throwE "secretBackstory is secret."
+secretBackstory :: Resolve Identity
+secretBackstory = throwE "secretBackstory is secret."
typeName :: Character -> Text
typeName = either (const "Droid") (const "Human")
@@ -161,10 +161,10 @@ getHero :: Int -> Character
getHero 5 = luke
getHero _ = artoo
-getHuman :: Alternative f => ID -> f Character
+getHuman :: ID -> Maybe Character
getHuman = fmap Right . getHuman'
-getHuman' :: Alternative f => ID -> f Human
+getHuman' :: ID -> Maybe Human
getHuman' "1000" = pure luke'
getHuman' "1001" = pure vader
getHuman' "1002" = pure han
@@ -172,10 +172,10 @@ getHuman' "1003" = pure leia
getHuman' "1004" = pure tarkin
getHuman' _ = empty
-getDroid :: Alternative f => ID -> f Character
+getDroid :: ID -> Maybe Character
getDroid = fmap Left . getDroid'
-getDroid' :: Alternative f => ID -> f Droid
+getDroid' :: ID -> Maybe Droid
getDroid' "2000" = pure threepio
getDroid' "2001" = pure artoo'
getDroid' _ = empty
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cf18eca..ed3c32c 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -23,19 +23,20 @@ schema :: Schema Identity
schema = Schema { query = queryType, mutation = Nothing }
where
queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
- [ ("hero", heroField)
- , ("human", humanField)
- , ("droid", droidField)
+ [ ("hero", heroFieldResolver)
+ , ("human", humanFieldResolver)
+ , ("droid", droidFieldResolver)
]
- heroArguments = HashMap.singleton "episode"
+ heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "episode"
$ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
- heroField =
- Out.Field Nothing (Out.NamedObjectType heroObject) heroArguments hero
- humanArguments = HashMap.singleton "id"
+ heroFieldResolver = ValueResolver heroField hero
+ humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
+ $ HashMap.singleton "id"
$ In.Argument Nothing (In.NonNullScalarType string) Nothing
- humanField =
- Out.Field Nothing (Out.NamedObjectType heroObject) humanArguments human
- droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty droid
+ humanFieldResolver = ValueResolver humanField human
+ droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
+ droidFieldResolver = ValueResolver droidField droid
heroObject :: Out.ObjectType Identity
heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
@@ -48,8 +49,9 @@ heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
, ("__typename", typenameFieldType)
]
where
- homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
- $ idField "homePlanet"
+ homePlanetFieldType
+ = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+ $ idField "homePlanet"
droidObject :: Out.ObjectType Identity
droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
@@ -62,39 +64,48 @@ droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
, ("__typename", typenameFieldType)
]
where
- primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+ primaryFunctionFieldType
+ = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "primaryFunction"
-typenameFieldType :: Out.Field Identity
-typenameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+typenameFieldType :: Resolver Identity
+typenameFieldType
+ = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "__typename"
-idFieldType :: Out.Field Identity
-idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
+idFieldType :: Resolver Identity
+idFieldType
+ = ValueResolver (Out.Field Nothing (Out.NamedScalarType id) mempty)
$ idField "id"
-nameFieldType :: Out.Field Identity
-nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+nameFieldType :: Resolver Identity
+nameFieldType
+ = ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
$ idField "name"
-friendsFieldType :: Out.Field Identity
-friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+friendsFieldType :: Resolver Identity
+friendsFieldType
+ = ValueResolver (Out.Field Nothing fieldType mempty)
$ idField "friends"
+ where
+ fieldType = Out.ListType $ Out.NamedObjectType droidObject
-appearsInField :: Out.Field Identity
-appearsInField = Out.Field (Just description) fieldType mempty
+appearsInField :: Resolver Identity
+appearsInField
+ = ValueResolver (Out.Field (Just description) fieldType mempty)
$ idField "appearsIn"
where
fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
description = "Which movies they appear in."
-secretBackstoryFieldType :: Out.Field Identity
-secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
- $ String <$> secretBackstory
+secretBackstoryFieldType :: Resolver Identity
+secretBackstoryFieldType = ValueResolver field secretBackstory
+ where
+ field = Out.Field Nothing (Out.NamedScalarType string) mempty
-idField :: Text -> ResolverT Identity Value
+idField :: Text -> Resolve Identity
idField f = do
- v <- ResolverT $ lift $ asks values
+ v <- lift $ asks values
let (Object v') = v
pure $ v' HashMap.! f
@@ -107,7 +118,7 @@ episodeEnum = EnumType "Episode" (Just description)
empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
-hero :: ResolverT Identity Value
+hero :: Resolve Identity
hero = do
episode <- argument "episode"
pure $ character $ case episode of
@@ -116,23 +127,19 @@ hero = do
Enum "JEDI" -> getHero 6
_ -> artoo
-human :: ResolverT Identity Value
+human :: Resolve Identity
human = do
id' <- argument "id"
case id' of
- String i -> do
- humanCharacter <- lift $ return $ getHuman i >>= Just
- case humanCharacter of
- Nothing -> pure Null
- Just e -> pure $ character e
- _ -> ResolverT $ throwE "Invalid arguments."
-
-droid :: ResolverT Identity Value
+ String i -> pure $ maybe Null character $ getHuman i >>= Just
+ _ -> throwE "Invalid arguments."
+
+droid :: Resolve Identity
droid = do
id' <- argument "id"
case id' of
- String i -> character <$> getDroid i
- _ -> ResolverT $ throwE "Invalid arguments."
+ String i -> pure $ maybe Null character $ getDroid i >>= Just
+ _ -> throwE "Invalid arguments."
character :: Character -> Value
character char = Object $ HashMap.fromList
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 23:12:12 +0000