summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/DirectiveSpec.hs92
-rw-r--r--tests/Language/GraphQL/FragmentSpec.hs204
-rw-r--r--tests/Language/GraphQL/RootOperationSpec.hs72
-rw-r--r--tests/Spec.hs1
4 files changed, 369 insertions, 0 deletions
diff --git a/tests/Language/GraphQL/DirectiveSpec.hs b/tests/Language/GraphQL/DirectiveSpec.hs
new file mode 100644
index 0000000..40f6215
--- /dev/null
+++ b/tests/Language/GraphQL/DirectiveSpec.hs
@@ -0,0 +1,92 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Language.GraphQL.DirectiveSpec
+ ( spec
+ ) where
+
+import Data.Aeson (object, (.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL
+import Language.GraphQL.TH
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec.GraphQL
+
+experimentalResolver :: Schema IO
+experimentalResolver = schema queryType Nothing Nothing mempty
+ where
+ queryType = Out.ObjectType "Query" Nothing []
+ $ HashMap.singleton "experimentalField"
+ $ Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 5
+
+emptyObject :: Aeson.Object
+emptyObject = HashMap.singleton "data" $ object []
+
+spec :: Spec
+spec =
+ describe "Directive executor" $ do
+ it "should be able to @skip fields" $ do
+ let sourceQuery = [gql|
+ {
+ experimentalField @skip(if: true)
+ }
+ |]
+
+ actual <- graphql experimentalResolver sourceQuery
+ actual `shouldResolveTo` emptyObject
+
+ it "should not skip fields if @skip is false" $ do
+ let sourceQuery = [gql|
+ {
+ experimentalField @skip(if: false)
+ }
+ |]
+ expected = HashMap.singleton "data"
+ $ object
+ [ "experimentalField" .= (5 :: Int)
+ ]
+ actual <- graphql experimentalResolver sourceQuery
+ actual `shouldResolveTo` expected
+
+ it "should skip fields if @include is false" $ do
+ let sourceQuery = [gql|
+ {
+ experimentalField @include(if: false)
+ }
+ |]
+
+ actual <- graphql experimentalResolver sourceQuery
+ actual `shouldResolveTo` emptyObject
+
+ it "should be able to @skip a fragment spread" $ do
+ let sourceQuery = [gql|
+ {
+ ...experimentalFragment @skip(if: true)
+ }
+
+ fragment experimentalFragment on Query {
+ experimentalField
+ }
+ |]
+
+ actual <- graphql experimentalResolver sourceQuery
+ actual `shouldResolveTo` emptyObject
+
+ it "should be able to @skip an inline fragment" $ do
+ let sourceQuery = [gql|
+ {
+ ... on Query @skip(if: true) {
+ experimentalField
+ }
+ }
+ |]
+
+ actual <- graphql experimentalResolver sourceQuery
+ actual `shouldResolveTo` emptyObject
diff --git a/tests/Language/GraphQL/FragmentSpec.hs b/tests/Language/GraphQL/FragmentSpec.hs
new file mode 100644
index 0000000..b7902d9
--- /dev/null
+++ b/tests/Language/GraphQL/FragmentSpec.hs
@@ -0,0 +1,204 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Language.GraphQL.FragmentSpec
+ ( spec
+ ) where
+
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text)
+import Language.GraphQL
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.TH
+import Test.Hspec (Spec, describe, it)
+import Test.Hspec.GraphQL
+
+size :: (Text, Value)
+size = ("size", String "L")
+
+circumference :: (Text, Value)
+circumference = ("circumference", Int 60)
+
+garment :: Text -> (Text, Value)
+garment typeName =
+ ("garment", Object $ HashMap.fromList
+ [ if typeName == "Hat" then circumference else size
+ , ("__typename", String typeName)
+ ]
+ )
+
+inlineQuery :: Text
+inlineQuery = [gql|
+ {
+ garment {
+ ... on Hat {
+ circumference
+ }
+ ... on Shirt {
+ size
+ }
+ }
+ }
+|]
+
+shirtType :: Out.ObjectType IO
+shirtType = Out.ObjectType "Shirt" Nothing [] $ HashMap.fromList
+ [ ("size", sizeFieldType)
+ ]
+
+hatType :: Out.ObjectType IO
+hatType = Out.ObjectType "Hat" Nothing [] $ HashMap.fromList
+ [ ("size", sizeFieldType)
+ , ("circumference", circumferenceFieldType)
+ ]
+
+circumferenceFieldType :: Out.Resolver IO
+circumferenceFieldType
+ = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ snd circumference
+
+sizeFieldType :: Out.Resolver IO
+sizeFieldType
+ = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
+ $ pure $ snd size
+
+toSchema :: Text -> (Text, Value) -> Schema IO
+toSchema t (_, resolve) = schema queryType Nothing Nothing mempty
+ where
+ garmentType = Out.UnionType "Garment" Nothing [hatType, shirtType]
+ typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
+ garmentField = Out.Field Nothing (Out.NamedUnionType garmentType) mempty
+ queryType =
+ case t of
+ "circumference" -> hatType
+ "size" -> shirtType
+ _ -> Out.ObjectType "Query" Nothing []
+ $ HashMap.fromList
+ [ ("garment", ValueResolver garmentField (pure resolve))
+ , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
+ ]
+
+spec :: Spec
+spec = do
+ describe "Inline fragment executor" $ do
+ it "chooses the first selection if the type matches" $ do
+ actual <- graphql (toSchema "Hat" $ garment "Hat") inlineQuery
+ let expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "garment" .= Aeson.object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ in actual `shouldResolveTo` expected
+
+ it "chooses the last selection if the type matches" $ do
+ actual <- graphql (toSchema "Shirt" $ garment "Shirt") inlineQuery
+ let expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "garment" .= Aeson.object
+ [ "size" .= ("L" :: Text)
+ ]
+ ]
+ in actual `shouldResolveTo` expected
+
+ it "embeds inline fragments without type" $ do
+ let sourceQuery = [gql|
+ {
+ circumference
+ ... {
+ size
+ }
+ }
+ |]
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
+ let expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "circumference" .= (60 :: Int)
+ , "size" .= ("L" :: Text)
+ ]
+ in actual `shouldResolveTo` expected
+
+ it "evaluates fragments on Query" $ do
+ let sourceQuery = [gql|
+ {
+ ... {
+ size
+ }
+ }
+ |]
+ in graphql (toSchema "size" size) `shouldResolve` sourceQuery
+
+ describe "Fragment spread executor" $ do
+ it "evaluates fragment spreads" $ do
+ let sourceQuery = [gql|
+ {
+ ...circumferenceFragment
+ }
+
+ fragment circumferenceFragment on Hat {
+ circumference
+ }
+ |]
+
+ actual <- graphql (toSchema "circumference" circumference) sourceQuery
+ let expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "circumference" .= (60 :: Int)
+ ]
+ in actual `shouldResolveTo` expected
+
+ it "evaluates nested fragments" $ do
+ let sourceQuery = [gql|
+ {
+ garment {
+ ...circumferenceFragment
+ }
+ }
+
+ fragment circumferenceFragment on Hat {
+ ...hatFragment
+ }
+
+ fragment hatFragment on Hat {
+ circumference
+ }
+ |]
+
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
+ let expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "garment" .= Aeson.object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ in actual `shouldResolveTo` expected
+
+ it "considers type condition" $ do
+ let sourceQuery = [gql|
+ {
+ garment {
+ ...circumferenceFragment
+ ...sizeFragment
+ }
+ }
+ fragment circumferenceFragment on Hat {
+ circumference
+ }
+ fragment sizeFragment on Shirt {
+ size
+ }
+ |]
+ expected = HashMap.singleton "data"
+ $ Aeson.object
+ [ "garment" .= Aeson.object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ actual <- graphql (toSchema "Hat" $ garment "Hat") sourceQuery
+ actual `shouldResolveTo` expected
diff --git a/tests/Language/GraphQL/RootOperationSpec.hs b/tests/Language/GraphQL/RootOperationSpec.hs
new file mode 100644
index 0000000..3c4779d
--- /dev/null
+++ b/tests/Language/GraphQL/RootOperationSpec.hs
@@ -0,0 +1,72 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Language.GraphQL.RootOperationSpec
+ ( spec
+ ) where
+
+import Data.Aeson ((.=), object)
+import qualified Data.HashMap.Strict as HashMap
+import Language.GraphQL
+import Test.Hspec (Spec, describe, it)
+import Language.GraphQL.TH
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.Out as Out
+import Test.Hspec.GraphQL
+
+hatType :: Out.ObjectType IO
+hatType = Out.ObjectType "Hat" Nothing []
+ $ HashMap.singleton "circumference"
+ $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 60
+
+garmentSchema :: Schema IO
+garmentSchema = schema queryType (Just mutationType) Nothing mempty
+ where
+ queryType = Out.ObjectType "Query" Nothing [] hatFieldResolver
+ mutationType = Out.ObjectType "Mutation" Nothing [] incrementFieldResolver
+ garment = pure $ Object $ HashMap.fromList
+ [ ("circumference", Int 60)
+ ]
+ incrementFieldResolver = HashMap.singleton "incrementCircumference"
+ $ ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
+ $ pure $ Int 61
+ hatField = Out.Field Nothing (Out.NamedObjectType hatType) mempty
+ hatFieldResolver =
+ HashMap.singleton "garment" $ ValueResolver hatField garment
+
+spec :: Spec
+spec =
+ describe "Root operation type" $ do
+ it "returns objects from the root resolvers" $ do
+ let querySource = [gql|
+ {
+ garment {
+ circumference
+ }
+ }
+ |]
+ expected = HashMap.singleton "data"
+ $ object
+ [ "garment" .= object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ actual <- graphql garmentSchema querySource
+ actual `shouldResolveTo` expected
+
+ it "chooses Mutation" $ do
+ let querySource = [gql|
+ mutation {
+ incrementCircumference
+ }
+ |]
+ expected = HashMap.singleton "data"
+ $ object
+ [ "incrementCircumference" .= (61 :: Int)
+ ]
+ actual <- graphql garmentSchema querySource
+ actual `shouldResolveTo` expected
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 20:38:53 +0000