OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Move JSON tests to the upcoming extra package

Browse Source
This commit is contained in:
Eugen Wissner 2021-11-22 07:22:28 +01:00
parent a044fc40d3
commit 0047a13bc0
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 66 additions and 437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
graphql.cabal
View File

@ -1,4 +1,4 @@
cabal-version: 2.2 cabal-version: 2.4
name: graphql name: graphql
version: 1.0.1.0 version: 1.0.1.0
@ -21,8 +21,8 @@ extra-source-files:
CHANGELOG.md CHANGELOG.md
README.md README.md
tested-with: tested-with:
GHC == 8.10.7 GHC == 8.10.7,
, GHC == 9.0.1 GHC == 9.0.1
source-repository head source-repository head
type: git type: git
@ -58,20 +58,20 @@ library
src src
ghc-options: -Wall ghc-options: -Wall
build-depends: build-depends:
aeson >= 1.5.6 && < 1.6 aeson >= 1.5.6 && < 1.6,
, base >= 4.7 && < 5 base >= 4.7 && < 5,
, conduit >= 1.3.4 && < 1.4 conduit >= 1.3.4 && < 1.4,
, containers >= 0.6.2 && < 0.7 containers >= 0.6.2 && < 0.7,
, exceptions >= 0.10.4 && < 0.11 exceptions >= 0.10.4 && < 0.11,
, hspec-expectations >= 0.8.2 && < 0.9 hspec-expectations >= 0.8.2 && < 0.9,
, megaparsec >= 9.0.1 && < 9.1 megaparsec >= 9.0.1 && < 9.1,
, parser-combinators >= 1.3.0 && < 1.4 parser-combinators >= 1.3.0 && < 1.4,
, scientific >= 0.3.7 && < 0.4 scientific >= 0.3.7 && < 0.4,
, template-haskell >= 2.16 && < 2.18 template-haskell >= 2.16 && < 2.18,
, text >= 1.2.4 && < 1.3 text >= 1.2.4 && < 1.3,
, transformers >= 0.5.6 && < 0.6 transformers >= 0.5.6 && < 0.6,
, unordered-containers >= 0.2.14 && < 0.3 unordered-containers >= 0.2.14 && < 0.3,
, vector >= 0.12.3 && < 0.13 vector >= 0.12.3 && < 0.13
default-language: Haskell2010 default-language: Haskell2010
test-suite graphql-test test-suite graphql-test
@ -88,23 +88,20 @@ test-suite graphql-test
Language.GraphQL.ExecuteSpec Language.GraphQL.ExecuteSpec
Language.GraphQL.Type.OutSpec Language.GraphQL.Type.OutSpec
Language.GraphQL.Validate.RulesSpec Language.GraphQL.Validate.RulesSpec
Test.DirectiveSpec
Test.FragmentSpec
Test.RootOperationSpec
hs-source-dirs: hs-source-dirs:
tests tests
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
build-depends: build-depends:
QuickCheck >= 2.14.1 && < 2.15 QuickCheck >= 2.14.1 && < 2.15,
, aeson aeson,
, base >= 4.8 && < 5 base >= 4.8 && < 5,
, conduit conduit,
, exceptions exceptions,
, graphql graphql,
, hspec >= 2.8.2 && < 2.9 hspec >= 2.9.1 && < 3,
, hspec-megaparsec >= 2.2.0 && < 2.3 hspec-megaparsec >= 2.2.0 && < 2.3,
, megaparsec megaparsec,
, scientific scientific,
, text text,
, unordered-containers unordered-containers
default-language: Haskell2010 default-language: Haskell2010

92
tests/Test/DirectiveSpec.hs
View File

@ -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

204
tests/Test/FragmentSpec.hs
View File

@ -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

72
tests/Test/RootOperationSpec.hs
View File

@ -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