aboutsummaryrefslogtreecommitdiff
path: root/tests/Test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test')
-rw-r--r--tests/Test/DirectiveSpec.hs18
-rw-r--r--tests/Test/FragmentSpec.hs16
-rw-r--r--tests/Test/StarWars/Data.hs13
-rw-r--r--tests/Test/StarWars/QuerySpec.hs182
-rw-r--r--tests/Test/StarWars/Schema.hs55
5 files changed, 151 insertions, 133 deletions
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index 2224bc5..3b9da19 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -5,14 +5,18 @@ module Test.DirectiveSpec
) where
import Data.Aeson (Value, object, (.=))
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
+import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
-experimentalResolver :: Schema.Resolver IO
-experimentalResolver = Schema.scalar "experimentalField" $ pure (5 :: Int)
+experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
+experimentalResolver = HashMap.singleton "Query"
+ $ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
emptyObject :: Value
emptyObject = object
@@ -29,7 +33,7 @@ spec =
}
|]
- actual <- graphql (experimentalResolver :| []) query
+ actual <- graphql experimentalResolver query
actual `shouldBe` emptyObject
it "should not skip fields if @skip is false" $ do
@@ -44,7 +48,7 @@ spec =
]
]
- actual <- graphql (experimentalResolver :| []) query
+ actual <- graphql experimentalResolver query
actual `shouldBe` expected
it "should skip fields if @include is false" $ do
@@ -54,7 +58,7 @@ spec =
}
|]
- actual <- graphql (experimentalResolver :| []) query
+ actual <- graphql experimentalResolver query
actual `shouldBe` emptyObject
it "should be able to @skip a fragment spread" $ do
@@ -68,7 +72,7 @@ spec =
}
|]
- actual <- graphql (experimentalResolver :| []) query
+ actual <- graphql experimentalResolver query
actual `shouldBe` emptyObject
it "should be able to @skip an inline fragment" $ do
@@ -80,5 +84,5 @@ spec =
}
|]
- actual <- graphql (experimentalResolver :| []) query
+ actual <- graphql experimentalResolver query
actual `shouldBe` emptyObject
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index de10d63..74293a9 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -51,7 +51,7 @@ spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
- actual <- graphql (garment "Hat" :| []) inlineQuery
+ actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -62,7 +62,7 @@ spec = do
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
- actual <- graphql (garment "Shirt" :| []) inlineQuery
+ actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -83,7 +83,7 @@ spec = do
}|]
resolvers = Schema.object "garment" $ return [circumference, size]
- actual <- graphql (resolvers :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -101,7 +101,7 @@ spec = do
}
}|]
- actual <- graphql (size :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ size :| []) query
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
@@ -116,7 +116,7 @@ spec = do
}
|]
- actual <- graphql (circumference :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
@@ -141,7 +141,7 @@ spec = do
}
|]
- actual <- graphql (garment "Hat" :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -162,7 +162,7 @@ spec = do
}
|]
- actual <- graphql (circumference :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
actual `shouldSatisfy` hasErrors
it "considers type condition" $ do
@@ -187,5 +187,5 @@ spec = do
]
]
]
- actual <- graphql (garment "Hat" :| []) query
+ actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
actual `shouldBe` expected
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 4854f8f..9466991 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -8,7 +8,6 @@ module Test.StarWars.Data
, getEpisode
, getFriends
, getHero
- , getHeroIO
, getHuman
, id_
, homePlanet
@@ -17,11 +16,8 @@ module Test.StarWars.Data
, typeName
) where
-import Data.Monoid (mempty)
-import Control.Applicative ( Alternative(..)
- , liftA2
- )
-import Control.Monad.IO.Class (MonadIO(..))
+import Data.Functor.Identity (Identity)
+import Control.Applicative (Alternative(..), liftA2)
import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
@@ -71,7 +67,7 @@ appearsIn :: Character -> [Int]
appearsIn (Left x) = _appearsIn . _droidChar $ x
appearsIn (Right x) = _appearsIn . _humanChar $ x
-secretBackstory :: MonadIO m => Character -> ActionT m Text
+secretBackstory :: Character -> ActionT Identity Text
secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
typeName :: Character -> Text
@@ -166,9 +162,6 @@ getHero :: Int -> Character
getHero 5 = luke
getHero _ = artoo
-getHeroIO :: Int -> IO Character
-getHeroIO = pure . getHero
-
getHuman :: Alternative f => ID -> f Character
getHuman = fmap Right . getHuman'
diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs
index 0f6a2ef..45fcf42 100644
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@@ -5,20 +5,15 @@ module Test.StarWars.QuerySpec
) where
import qualified Data.Aeson as Aeson
-import Data.Aeson ( object
- , (.=)
- )
+import Data.Aeson ((.=))
+import Data.Functor.Identity (Identity(..))
+import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text)
import Language.GraphQL
import Language.GraphQL.Schema (Subs)
import Text.RawString.QQ (r)
-import Test.Hspec.Expectations ( Expectation
- , shouldBe
- )
-import Test.Hspec ( Spec
- , describe
- , it
- )
+import Test.Hspec.Expectations (Expectation, shouldBe)
+import Test.Hspec (Spec, describe, it)
import Test.StarWars.Schema
-- * Test
@@ -34,7 +29,11 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
+ $ Aeson.object
+ [ "data" .= Aeson.object
+ [ "hero" .= Aeson.object ["id" .= ("2001" :: Text)]
+ ]
+ ]
it "R2-D2 ID and friends" $ testQuery
[r| query HeroNameAndFriendsQuery {
hero {
@@ -46,14 +45,14 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "hero" .= object
+ $ Aeson.object [ "data" .= Aeson.object [
+ "hero" .= Aeson.object
[ "id" .= ("2001" :: Text)
, r2d2Name
, "friends" .=
- [ object [lukeName]
- , object [hanName]
- , object [leiaName]
+ [ Aeson.object [lukeName]
+ , Aeson.object [hanName]
+ , Aeson.object [leiaName]
]
]
]]
@@ -73,37 +72,37 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "hero" .= object [
+ $ Aeson.object [ "data" .= Aeson.object [
+ "hero" .= Aeson.object [
"name" .= ("R2-D2" :: Text)
, "friends" .= [
- object [
+ Aeson.object [
"name" .= ("Luke Skywalker" :: Text)
, "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
, "friends" .= [
- object [hanName]
- , object [leiaName]
- , object [c3poName]
- , object [r2d2Name]
+ Aeson.object [hanName]
+ , Aeson.object [leiaName]
+ , Aeson.object [c3poName]
+ , Aeson.object [r2d2Name]
]
]
- , object [
+ , Aeson.object [
hanName
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
- , "friends" .= [
- object [lukeName]
- , object [leiaName]
- , object [r2d2Name]
+ , "friends" .=
+ [ Aeson.object [lukeName]
+ , Aeson.object [leiaName]
+ , Aeson.object [r2d2Name]
]
]
- , object [
+ , Aeson.object [
leiaName
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
- , "friends" .= [
- object [lukeName]
- , object [hanName]
- , object [c3poName]
- , object [r2d2Name]
+ , "friends" .=
+ [ Aeson.object [lukeName]
+ , Aeson.object [hanName]
+ , Aeson.object [c3poName]
+ , Aeson.object [r2d2Name]
]
]
]
@@ -116,40 +115,40 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "human" .= object [lukeName]
- ]]
+ $ Aeson.object [ "data" .= Aeson.object
+ [ "human" .= Aeson.object [lukeName]
+ ]]
it "Luke ID with variable" $ testQueryParams
- (\v -> if v == "someId" then Just "1000" else Nothing)
+ (HashMap.singleton "someId" "1000")
[r| query FetchSomeIDQuery($someId: String!) {
human(id: $someId) {
name
}
}
|]
- $ object [ "data" .= object [
- "human" .= object [lukeName]
+ $ Aeson.object [ "data" .= Aeson.object [
+ "human" .= Aeson.object [lukeName]
]]
it "Han ID with variable" $ testQueryParams
- (\v -> if v == "someId" then Just "1002" else Nothing)
+ (HashMap.singleton "someId" "1002")
[r| query FetchSomeIDQuery($someId: String!) {
human(id: $someId) {
name
}
}
|]
- $ object [ "data" .= object [
- "human" .= object [hanName]
+ $ Aeson.object [ "data" .= Aeson.object [
+ "human" .= Aeson.object [hanName]
]]
it "Invalid ID" $ testQueryParams
- (\v -> if v == "id" then Just "Not a valid ID" else Nothing)
+ (HashMap.singleton "id" "Not a valid ID")
[r| query humanQuery($id: String!) {
human(id: $id) {
name
}
}
- |] $ object ["data" .= object ["human" .= Aeson.Null]]
+ |] $ Aeson.object ["data" .= Aeson.object ["human" .= Aeson.Null]]
it "Luke aliased" $ testQuery
[r| query FetchLukeAliased {
luke: human(id: "1000") {
@@ -157,8 +156,8 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "luke" .= object [lukeName]
+ $ Aeson.object [ "data" .= Aeson.object [
+ "luke" .= Aeson.object [lukeName]
]]
it "R2-D2 ID and friends aliased" $ testQuery
[r| query HeroNameAndFriendsQuery {
@@ -171,14 +170,14 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "hero" .= object [
+ $ Aeson.object [ "data" .= Aeson.object [
+ "hero" .= Aeson.object [
"id" .= ("2001" :: Text)
, r2d2Name
- , "friends" .= [
- object ["friendName" .= ("Luke Skywalker" :: Text)]
- , object ["friendName" .= ("Han Solo" :: Text)]
- , object ["friendName" .= ("Leia Organa" :: Text)]
+ , "friends" .=
+ [ Aeson.object ["friendName" .= ("Luke Skywalker" :: Text)]
+ , Aeson.object ["friendName" .= ("Han Solo" :: Text)]
+ , Aeson.object ["friendName" .= ("Leia Organa" :: Text)]
]
]
]]
@@ -192,9 +191,9 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "luke" .= object [lukeName]
- , "leia" .= object [leiaName]
+ $ Aeson.object [ "data" .= Aeson.object
+ [ "luke" .= Aeson.object [lukeName]
+ , "leia" .= Aeson.object [leiaName]
]]
describe "Fragments for complex queries" $ do
@@ -210,9 +209,9 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object [ "data" .= object [
- "luke" .= object [lukeName, tatooine]
- , "leia" .= object [leiaName, alderaan]
+ $ Aeson.object [ "data" .= Aeson.object [
+ "luke" .= Aeson.object [lukeName, tatooine]
+ , "leia" .= Aeson.object [leiaName, alderaan]
]]
it "Fragment for duplicate content" $ testQuery
[r| query UseFragment {
@@ -228,9 +227,9 @@ spec = describe "Star Wars Query Tests" $ do
homePlanet
}
|]
- $ object [ "data" .= object [
- "luke" .= object [lukeName, tatooine]
- , "leia" .= object [leiaName, alderaan]
+ $ Aeson.object [ "data" .= Aeson.object [
+ "luke" .= Aeson.object [lukeName, tatooine]
+ , "leia" .= Aeson.object [leiaName, alderaan]
]]
describe "__typename" $ do
@@ -242,8 +241,11 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object ["data" .= object [
- "hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name]
+ $ Aeson.object ["data" .= Aeson.object [
+ "hero" .= Aeson.object
+ [ "__typename" .= ("Droid" :: Text)
+ , r2d2Name
+ ]
]]
it "Luke is a human" $ testQuery
[r| query CheckTypeOfLuke {
@@ -253,8 +255,11 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object ["data" .= object [
- "hero" .= object ["__typename" .= ("Human" :: Text), lukeName]
+ $ Aeson.object ["data" .= Aeson.object [
+ "hero" .= Aeson.object
+ [ "__typename" .= ("Human" :: Text)
+ , lukeName
+ ]
]]
describe "Errors in resolvers" $ do
@@ -267,15 +272,15 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object
- [ "data" .= object
- [ "hero" .= object
+ $ Aeson.object
+ [ "data" .= Aeson.object
+ [ "hero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text)
, "secretBackstory" .= Aeson.Null
]
]
, "errors" .=
- [ object
+ [ Aeson.object
["message" .= ("secretBackstory is secret." :: Text)]
]
]
@@ -290,19 +295,19 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object ["data" .= object
- [ "hero" .= object
+ $ Aeson.object ["data" .= Aeson.object
+ [ "hero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text)
, "friends" .=
- [ object
+ [ Aeson.object
[ "name" .= ("Luke Skywalker" :: Text)
, "secretBackstory" .= Aeson.Null
]
- , object
+ , Aeson.object
[ "name" .= ("Han Solo" :: Text)
, "secretBackstory" .= Aeson.Null
]
- , object
+ , Aeson.object
[ "name" .= ("Leia Organa" :: Text)
, "secretBackstory" .= Aeson.Null
]
@@ -310,9 +315,15 @@ spec = describe "Star Wars Query Tests" $ do
]
]
, "errors" .=
- [ object ["message" .= ("secretBackstory is secret." :: Text)]
- , object ["message" .= ("secretBackstory is secret." :: Text)]
- , object ["message" .= ("secretBackstory is secret." :: Text)]
+ [ Aeson.object
+ [ "message" .= ("secretBackstory is secret." :: Text)
+ ]
+ , Aeson.object
+ [ "message" .= ("secretBackstory is secret." :: Text)
+ ]
+ , Aeson.object
+ [ "message" .= ("secretBackstory is secret." :: Text)
+ ]
]
]
it "error on secretBackstory with alias" $ testQuery
@@ -323,15 +334,17 @@ spec = describe "Star Wars Query Tests" $ do
}
}
|]
- $ object
- [ "data" .= object
- [ "mainHero" .= object
+ $ Aeson.object
+ [ "data" .= Aeson.object
+ [ "mainHero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text)
, "story" .= Aeson.Null
]
]
, "errors" .=
- [ object ["message" .= ("secretBackstory is secret." :: Text)]
+ [ Aeson.object
+ [ "message" .= ("secretBackstory is secret." :: Text)
+ ]
]
]
@@ -345,7 +358,8 @@ spec = describe "Star Wars Query Tests" $ do
alderaan = "homePlanet" .= ("Alderaan" :: Text)
testQuery :: Text -> Aeson.Value -> Expectation
-testQuery q expected = graphql schema q >>= flip shouldBe expected
+testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
-testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected
+testQueryParams f q expected =
+ runIdentity (graphqlSubs schema f q) `shouldBe` expected
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 7b98747..cd25599 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.StarWars.Schema
( character
@@ -10,9 +9,12 @@ module Test.StarWars.Schema
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
-import Control.Monad.IO.Class (MonadIO(..))
+import Data.Functor.Identity (Identity)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
+import Data.Text (Text)
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
import qualified Language.GraphQL.Type as Type
@@ -20,32 +22,37 @@ import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
-schema :: MonadIO m => NonEmpty (Schema.Resolver m)
-schema = hero :| [human, droid]
+schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
+schema = HashMap.singleton "Query" $ hero :| [human, droid]
-hero :: MonadIO m => Schema.Resolver m
-hero = Schema.objectA "hero" $ \case
- [] -> character artoo
- [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4
- [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5
- [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6
- _ -> ActionT $ throwE "Invalid arguments."
+hero :: Schema.Resolver Identity
+hero = Schema.object "hero" $ do
+ episode <- argument "episode"
+ character $ case episode of
+ Schema.Enum "NEWHOPE" -> getHero 4
+ Schema.Enum "EMPIRE" -> getHero 5
+ Schema.Enum "JEDI" -> getHero 6
+ _ -> artoo
-human :: MonadIO m => Schema.Resolver m
-human = Schema.wrappedObjectA "human" $ \case
- [Schema.Argument "id" (Schema.String i)] -> do
- humanCharacter <- lift $ return $ getHuman i >>= Just
- case humanCharacter of
- Nothing -> return Type.Null
- Just e -> Type.Named <$> character e
- _ -> ActionT $ throwE "Invalid arguments."
+human :: Schema.Resolver Identity
+human = Schema.wrappedObject "human" $ do
+ id' <- argument "id"
+ case id' of
+ Schema.String i -> do
+ humanCharacter <- lift $ return $ getHuman i >>= Just
+ case humanCharacter of
+ Nothing -> return Type.Null
+ Just e -> Type.Named <$> character e
+ _ -> ActionT $ throwE "Invalid arguments."
-droid :: MonadIO m => Schema.Resolver m
-droid = Schema.objectA "droid" $ \case
- [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i)
- _ -> ActionT $ throwE "Invalid arguments."
+droid :: Schema.Resolver Identity
+droid = Schema.object "droid" $ do
+ id' <- argument "id"
+ case id' of
+ Schema.String i -> character =<< getDroid i
+ _ -> ActionT $ throwE "Invalid arguments."
-character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
+character :: Character -> ActionT Identity [Schema.Resolver Identity]
character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:53:00 +0000