aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/ErrorSpec.hs4
-rw-r--r--tests/Language/GraphQL/Execute/CoerceSpec.hs76
-rw-r--r--tests/Language/GraphQL/ExecuteSpec.hs72
-rw-r--r--tests/Test/DirectiveSpec.hs92
-rw-r--r--tests/Test/FragmentSpec.hs204
-rw-r--r--tests/Test/RootOperationSpec.hs72
6 files changed, 31 insertions, 489 deletions
diff --git a/tests/Language/GraphQL/ErrorSpec.hs b/tests/Language/GraphQL/ErrorSpec.hs
index f64e70a..75d9f33 100644
--- a/tests/Language/GraphQL/ErrorSpec.hs
+++ b/tests/Language/GraphQL/ErrorSpec.hs
@@ -7,9 +7,9 @@ module Language.GraphQL.ErrorSpec
( spec
) where
-import qualified Data.Aeson as Aeson
import Data.List.NonEmpty (NonEmpty (..))
import Language.GraphQL.Error
+import qualified Language.GraphQL.Type as Type
import Test.Hspec
( Spec
, describe
@@ -31,6 +31,6 @@ spec = describe "parseError" $
, pstateTabWidth = mkPos 1
, pstateLinePrefix = ""
}
- Response Aeson.Null actual <-
+ Response Type.Null actual <-
parseError (ParseErrorBundle parseErrors posState)
length actual `shouldBe` 1
diff --git a/tests/Language/GraphQL/Execute/CoerceSpec.hs b/tests/Language/GraphQL/Execute/CoerceSpec.hs
index 2b00895..e0df4bb 100644
--- a/tests/Language/GraphQL/Execute/CoerceSpec.hs
+++ b/tests/Language/GraphQL/Execute/CoerceSpec.hs
@@ -7,12 +7,8 @@ module Language.GraphQL.Execute.CoerceSpec
( spec
) where
-import Data.Aeson as Aeson ((.=))
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (isNothing)
-import Data.Scientific (scientific)
import qualified Language.GraphQL.Execute.Coerce as Coerce
import Language.GraphQL.Type
import qualified Language.GraphQL.Type.In as In
@@ -27,81 +23,11 @@ direction = EnumType "Direction" Nothing $ HashMap.fromList
, ("WEST", EnumValue Nothing)
]
-singletonInputObject :: In.Type
-singletonInputObject = In.NamedInputObjectType type'
- where
- type' = In.InputObjectType "ObjectName" Nothing inputFields
- inputFields = HashMap.singleton "field" field
- field = In.InputField Nothing (In.NamedScalarType string) Nothing
-
namedIdType :: In.Type
namedIdType = In.NamedScalarType id
spec :: Spec
-spec = do
- describe "VariableValue Aeson" $ do
- it "coerces strings" $
- let expected = Just (String "asdf")
- actual = Coerce.coerceVariableValue
- (In.NamedScalarType string) (Aeson.String "asdf")
- in actual `shouldBe` expected
- it "coerces non-null strings" $
- let expected = Just (String "asdf")
- actual = Coerce.coerceVariableValue
- (In.NonNullScalarType string) (Aeson.String "asdf")
- in actual `shouldBe` expected
- it "coerces booleans" $
- let expected = Just (Boolean True)
- actual = Coerce.coerceVariableValue
- (In.NamedScalarType boolean) (Aeson.Bool True)
- in actual `shouldBe` expected
- it "coerces zero to an integer" $
- let expected = Just (Int 0)
- actual = Coerce.coerceVariableValue
- (In.NamedScalarType int) (Aeson.Number 0)
- in actual `shouldBe` expected
- it "rejects fractional if an integer is expected" $
- let actual = Coerce.coerceVariableValue
- (In.NamedScalarType int) (Aeson.Number $ scientific 14 (-1))
- in actual `shouldSatisfy` isNothing
- it "coerces float numbers" $
- let expected = Just (Float 1.4)
- actual = Coerce.coerceVariableValue
- (In.NamedScalarType float) (Aeson.Number $ scientific 14 (-1))
- in actual `shouldBe` expected
- it "coerces IDs" $
- let expected = Just (String "1234")
- json = Aeson.String "1234"
- actual = Coerce.coerceVariableValue namedIdType json
- in actual `shouldBe` expected
- it "coerces input objects" $
- let actual = Coerce.coerceVariableValue singletonInputObject
- $ Aeson.object ["field" .= ("asdf" :: Aeson.Value)]
- expected = Just $ Object $ HashMap.singleton "field" "asdf"
- in actual `shouldBe` expected
- it "skips the field if it is missing in the variables" $
- let actual = Coerce.coerceVariableValue
- singletonInputObject Aeson.emptyObject
- expected = Just $ Object HashMap.empty
- in actual `shouldBe` expected
- it "fails if input object value contains extra fields" $
- let actual = Coerce.coerceVariableValue singletonInputObject
- $ Aeson.object variableFields
- variableFields =
- [ "field" .= ("asdf" :: Aeson.Value)
- , "extra" .= ("qwer" :: Aeson.Value)
- ]
- in actual `shouldSatisfy` isNothing
- it "preserves null" $
- let actual = Coerce.coerceVariableValue namedIdType Aeson.Null
- in actual `shouldBe` Just Null
- it "preserves list order" $
- let list = Aeson.toJSONList ["asdf" :: Aeson.Value, "qwer"]
- listType = (In.ListType $ In.NamedScalarType string)
- actual = Coerce.coerceVariableValue listType list
- expected = Just $ List [String "asdf", String "qwer"]
- in actual `shouldBe` expected
-
+spec =
describe "coerceInputLiteral" $ do
it "coerces enums" $
let expected = Just (Enum "NORTH")
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index 6723524..5eafb2e 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -10,9 +10,6 @@ module Language.GraphQL.ExecuteSpec
import Control.Exception (Exception(..), SomeException)
import Control.Monad.Catch (throwM)
-import Data.Aeson ((.=))
-import qualified Data.Aeson as Aeson
-import Data.Aeson.Types (emptyObject)
import Data.Conduit
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
@@ -189,12 +186,12 @@ schoolType = EnumType "School" Nothing $ HashMap.fromList
]
type EitherStreamOrValue = Either
- (ResponseEventStream (Either SomeException) Aeson.Value)
- (Response Aeson.Value)
+ (ResponseEventStream (Either SomeException) Value)
+ (Response Value)
execute' :: Document -> Either SomeException EitherStreamOrValue
execute' =
- execute philosopherSchema Nothing (mempty :: HashMap Name Aeson.Value)
+ execute philosopherSchema Nothing (mempty :: HashMap Name Value)
spec :: Spec
spec =
@@ -209,38 +206,37 @@ spec =
...cyclicFragment
}
|]
- expected = Response emptyObject mempty
+ expected = Response (Object mempty) mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" sourceQuery
in actual `shouldBe` expected
context "Query" $ do
it "skips unknown fields" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "firstName" .= ("Friedrich" :: String)
- ]
- ]
+ let data'' = Object
+ $ HashMap.singleton "philosopher"
+ $ Object
+ $ HashMap.singleton "firstName"
+ $ String "Friedrich"
expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName surname } }"
in actual `shouldBe` expected
it "merges selections" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.object
- [ "firstName" .= ("Friedrich" :: String)
- , "lastName" .= ("Nietzsche" :: String)
+ let data'' = Object
+ $ HashMap.singleton "philosopher"
+ $ Object
+ $ HashMap.fromList
+ [ ("firstName", String "Friedrich")
+ , ("lastName", String "Nietzsche")
]
- ]
expected = Response data'' mempty
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
in actual `shouldBe` expected
it "errors on invalid output enum values" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Value completion error. Expected type !School, found: EXISTENTIALISM."
@@ -253,9 +249,7 @@ spec =
in actual `shouldBe` expected
it "gives location information for non-null unions" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
@@ -268,9 +262,7 @@ spec =
in actual `shouldBe` expected
it "gives location information for invalid interfaces" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message
= "Value completion error. Expected type !Work, found:\
@@ -284,9 +276,7 @@ spec =
in actual `shouldBe` expected
it "gives location information for invalid scalar arguments" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message =
"Argument \"id\" has invalid type. Expected type ID, found: True."
@@ -299,9 +289,7 @@ spec =
in actual `shouldBe` expected
it "gives location information for failed result coercion" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message = "Unable to coerce result to !Int."
, locations = [Location 1 26]
@@ -313,9 +301,7 @@ spec =
in actual `shouldBe` expected
it "gives location information for failed result coercion" $
- let data'' = Aeson.object
- [ "genres" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "genres" Null
executionErrors = pure $ Error
{ message = "PhilosopherException"
, locations = [Location 1 3]
@@ -332,15 +318,13 @@ spec =
, locations = [Location 1 3]
, path = [Segment "count"]
}
- expected = Response Aeson.Null executionErrors
+ expected = Response Null executionErrors
Right (Right actual) = either (pure . parseError) execute'
$ parse document "" "{ count }"
in actual `shouldBe` expected
it "detects nullability errors" $
- let data'' = Aeson.object
- [ "philosopher" .= Aeson.Null
- ]
+ let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error
{ message = "Value completion error. Expected type !String, found: null."
, locations = [Location 1 26]
@@ -353,11 +337,11 @@ spec =
context "Subscription" $
it "subscribes" $
- let data'' = Aeson.object
- [ "newQuote" .= Aeson.object
- [ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
- ]
- ]
+ let data'' = Object
+ $ HashMap.singleton "newQuote"
+ $ Object
+ $ HashMap.singleton "quote"
+ $ String "Naturam expelles furca, tamen usque recurret."
expected = Response data'' mempty
Right (Left stream) = either (pure . parseError) execute'
$ parse document "" "subscription { newQuote { quote } }"
diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
deleted file mode 100644
index 50caa5b..0000000
--- a/tests/Test/DirectiveSpec.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{- 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 Test.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/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
deleted file mode 100644
index 5e0ae58..0000000
--- a/tests/Test/FragmentSpec.hs
+++ /dev/null
@@ -1,204 +0,0 @@
-{- 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 Test.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/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
deleted file mode 100644
index 9271c61..0000000
--- a/tests/Test/RootOperationSpec.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{- 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 Test.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
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:52:43 +0000