summaryrefslogtreecommitdiff
path: root/tests/Test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test')
-rw-r--r--tests/Test/DirectiveSpec.hs36
-rw-r--r--tests/Test/FragmentSpec.hs76
-rw-r--r--tests/Test/QuerySpec.hs40
-rw-r--r--tests/Test/RootOperationSpec.hs62
-rw-r--r--tests/Test/StarWars/Data.hs8
-rw-r--r--tests/Test/StarWars/Schema.hs15
6 files changed, 126 insertions, 111 deletions
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index b4cf364..f39c9c0 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -5,18 +5,22 @@ 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 Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema (Schema(..))
import Test.Hspec (Spec, describe, it, shouldBe)
import Text.RawString.QQ (r)
-experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
-experimentalResolver = HashMap.singleton "Query"
- $ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
+experimentalResolver :: Schema IO
+experimentalResolver = Schema { query = queryType, mutation = Nothing }
+ where
+ queryType = ObjectType "Query"
+ $ HashMap.singleton "experimentalField"
+ $ Schema.ValueResolver
+ $ pure
+ $ Number 5
emptyObject :: Value
emptyObject = object
@@ -27,17 +31,17 @@ spec :: Spec
spec =
describe "Directive executor" $ do
it "should be able to @skip fields" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @skip(if: true)
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should not skip fields if @skip is false" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @skip(if: false)
}
@@ -48,21 +52,21 @@ spec =
]
]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` expected
it "should skip fields if @include is false" $ do
- let query = [r|
+ let sourceQuery = [r|
{
experimentalField @include(if: false)
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip a fragment spread" $ do
- let query = [r|
+ let sourceQuery = [r|
{
...experimentalFragment @skip(if: true)
}
@@ -72,11 +76,11 @@ spec =
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
it "should be able to @skip an inline fragment" $ do
- let query = [r|
+ let sourceQuery = [r|
{
... on ExperimentalType @skip(if: true) {
experimentalField
@@ -84,5 +88,5 @@ spec =
}
|]
- actual <- graphql experimentalResolver query
+ actual <- graphql experimentalResolver sourceQuery
actual `shouldBe` emptyObject
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 99c0715..879a9b7 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -10,13 +10,16 @@ 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
- , shouldSatisfy
- , shouldNotSatisfy
- )
+import Test.Hspec
+ ( Spec
+ , describe
+ , it
+ , shouldBe
+ , shouldSatisfy
+ , shouldNotSatisfy
+ )
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
import Text.RawString.QQ (r)
size :: Schema.Resolver IO
@@ -47,11 +50,18 @@ hasErrors :: Value -> Bool
hasErrors (Object object') = HashMap.member "errors" object'
hasErrors _ = True
+toSchema :: Schema.Resolver IO -> Schema IO
+toSchema resolver = Schema { query = queryType, mutation = Nothing }
+ where
+ queryType = ObjectType "Query"
+ $ Schema.resolversToMap
+ $ resolver :| []
+
spec :: Spec
spec = do
describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
+ actual <- graphql (toSchema $ garment "Hat") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -62,7 +72,7 @@ spec = do
in actual `shouldBe` expected
it "chooses the last selection if the type matches" $ do
- actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
+ actual <- graphql (toSchema $ garment "Shirt") inlineQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -73,7 +83,7 @@ spec = do
in actual `shouldBe` expected
it "embeds inline fragments without type" $ do
- let query = [r|{
+ let sourceQuery = [r|{
garment {
circumference
... {
@@ -83,7 +93,7 @@ spec = do
}|]
resolvers = Schema.object "garment" $ return [circumference, size]
- actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
+ actual <- graphql (toSchema resolvers) sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -95,18 +105,18 @@ spec = do
in actual `shouldBe` expected
it "evaluates fragments on Query" $ do
- let query = [r|{
+ let sourceQuery = [r|{
... {
size
}
}|]
- actual <- graphql (HashMap.singleton "Query" $ size :| []) query
+ actual <- graphql (toSchema size) sourceQuery
actual `shouldNotSatisfy` hasErrors
describe "Fragment spread executor" $ do
it "evaluates fragment spreads" $ do
- let query = [r|
+ let sourceQuery = [r|
{
...circumferenceFragment
}
@@ -116,7 +126,7 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
+ actual <- graphql (toSchema circumference) sourceQuery
let expected = object
[ "data" .= object
[ "circumference" .= (60 :: Int)
@@ -125,7 +135,7 @@ spec = do
in actual `shouldBe` expected
it "evaluates nested fragments" $ do
- let query = [r|
+ let sourceQuery = [r|
{
garment {
...circumferenceFragment
@@ -141,7 +151,7 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
+ actual <- graphql (toSchema $ garment "Hat") sourceQuery
let expected = object
[ "data" .= object
[ "garment" .= object
@@ -152,7 +162,7 @@ spec = do
in actual `shouldBe` expected
it "rejects recursive fragments" $ do
- let query = [r|
+ let sourceQuery = [r|
{
...circumferenceFragment
}
@@ -162,11 +172,11 @@ spec = do
}
|]
- actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
+ actual <- graphql (toSchema circumference) sourceQuery
actual `shouldSatisfy` hasErrors
it "considers type condition" $ do
- let query = [r|
+ let sourceQuery = [r|
{
garment {
...circumferenceFragment
@@ -187,29 +197,5 @@ spec = do
]
]
]
- actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
- actual `shouldBe` expected
-
- it "test1" $ do
- let query = [r|
- {
- garment {
- circumference
- }
- }
- |]
- expected = object
- [ "data" .= object
- [ "garment" .= object
- [ "circumference" .= (60 :: Int)
- ]
- ]
- ]
- actual <- graphql schema query
+ actual <- graphql (toSchema $ garment "Hat") sourceQuery
actual `shouldBe` expected
- where
- schema = HashMap.singleton "Query" $ garment' :| []
- garment' = Schema.object "garment" $ return
- [ circumference'
- ]
- circumference' = Schema.scalar "circumference" $ pure (60 :: Int)
diff --git a/tests/Test/QuerySpec.hs b/tests/Test/QuerySpec.hs
deleted file mode 100644
index 95608b0..0000000
--- a/tests/Test/QuerySpec.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Test.QuerySpec
- ( spec
- ) where
-
-import Data.Aeson ((.=), object)
-import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
-import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec (Spec, describe, it, shouldBe)
-import Text.RawString.QQ (r)
-
-spec :: Spec
-spec =
- describe "Query executor" $
- it "returns objects from the root resolvers" $ do
- let query = [r|
- {
- garment {
- circumference
- }
- }
- |]
- expected = object
- [ "data" .= object
- [ "garment" .= object
- [ "circumference" .= (60 :: Int)
- ]
- ]
- ]
- actual <- graphql schema query
- actual `shouldBe` expected
- where
- schema = HashMap.singleton "Query" $ garment' :| []
- garment' = Schema.object "garment" $ return
- [ circumference'
- ]
- circumference' = Schema.scalar "circumference" $ pure (60 :: Int)
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
new file mode 100644
index 0000000..fc86d04
--- /dev/null
+++ b/tests/Test/RootOperationSpec.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Test.RootOperationSpec
+ ( spec
+ ) where
+
+import Data.Aeson ((.=), object)
+import Data.List.NonEmpty (NonEmpty(..))
+import Language.GraphQL
+import qualified Language.GraphQL.Schema as Schema
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.RawString.QQ (r)
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
+
+schema :: Schema IO
+schema = Schema
+ (ObjectType "Query" queryResolvers)
+ (Just $ ObjectType "Mutation" mutationResolvers)
+ where
+ queryResolvers = Schema.resolversToMap $ garment :| []
+ mutationResolvers = Schema.resolversToMap $ increment :| []
+ garment = Schema.object "garment" $ pure
+ [ Schema.scalar "circumference" $ pure (60 :: Int)
+ ]
+ increment = Schema.scalar "incrementCircumference"
+ $ pure (61 :: Int)
+
+spec :: Spec
+spec =
+ describe "Root operation type" $ do
+ it "returns objects from the root resolvers" $ do
+ let querySource = [r|
+ {
+ garment {
+ circumference
+ }
+ }
+ |]
+ expected = object
+ [ "data" .= object
+ [ "garment" .= object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ ]
+ actual <- graphql schema querySource
+ actual `shouldBe` expected
+
+ it "chooses Mutation" $ do
+ let querySource = [r|
+ mutation {
+ incrementCircumference
+ }
+ |]
+ expected = object
+ [ "data" .= object
+ [ "incrementCircumference" .= (61 :: Int)
+ ]
+ ]
+ actual <- graphql schema querySource
+ actual `shouldBe` expected
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 9466991..3cc8945 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -11,7 +11,7 @@ module Test.StarWars.Data
, getHuman
, id_
, homePlanet
- , name
+ , name_
, secretBackstory
, typeName
) where
@@ -55,9 +55,9 @@ id_ :: Character -> ID
id_ (Left x) = _id_ . _droidChar $ x
id_ (Right x) = _id_ . _humanChar $ x
-name :: Character -> Text
-name (Left x) = _name . _droidChar $ x
-name (Right x) = _name . _humanChar $ x
+name_ :: Character -> Text
+name_ (Left x) = _name . _droidChar $ x
+name_ (Right x) = _name . _humanChar $ x
friends :: Character -> [ID]
friends (Left x) = _friends . _droidChar $ x
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cd25599..8b65e22 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -10,20 +10,23 @@ module Test.StarWars.Schema
import Control.Monad.Trans.Except (throwE)
import Control.Monad.Trans.Class (lift)
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 Language.GraphQL.Type.Definition
import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Type.Schema
import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
-schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
-schema = HashMap.singleton "Query" $ hero :| [human, droid]
+schema :: Schema Identity
+schema = Schema { query = queryType, mutation = Nothing }
+ where
+ queryType = ObjectType "Query"
+ $ Schema.resolversToMap
+ $ hero :| [human, droid]
hero :: Schema.Resolver Identity
hero = Schema.object "hero" $ do
@@ -55,7 +58,7 @@ droid = Schema.object "droid" $ do
character :: Character -> ActionT Identity [Schema.Resolver Identity]
character char = return
[ Schema.scalar "id" $ return $ id_ char
- , Schema.scalar "name" $ return $ name char
+ , Schema.scalar "name" $ return $ name_ char
, Schema.wrappedObject "friends"
$ traverse character $ Type.List $ Type.Named <$> getFriends char
, Schema.wrappedScalar "appearsIn" $ return . Type.List
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-27 00:35:55 +0000