Move functional tests
This commit is contained in:
parent
b387c10d75
commit
fdd627bf5d
GPG Key ID:
A27FDC1E8EE902C0
@ -5,10 +5,8 @@ version: 0.1.0.0
|
||||
synopsis: GraphQL with batteries
|
||||
description: Various extensions and convenience functions for the core
|
||||
graphql package.
|
||||
|
||||
-- A URL where users can report bugs.
|
||||
-- bug-reports:
|
||||
|
||||
homepage: https://www.caraus.tech/projects/pub-graphql-spice
|
||||
bug-reports: https://www.caraus.tech/projects/pub-graphql-spice/issues
|
||||
license: MPL-2.0
|
||||
license-files: LICENSE
|
||||
author: Eugen Wissner <belka@caraus.de>
|
||||
@ -17,6 +15,8 @@ maintainer: belka@caraus.de
|
||||
copyright: (c) 2021 Eugen Wissner
|
||||
category: Language
|
||||
extra-source-files: CHANGELOG.md
|
||||
tested-with:
|
||||
GHC == 8.10.7
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -29,6 +29,27 @@ library
|
||||
hs-source-dirs: src
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
-- aeson >= 2.0.2.0 && < 2.1
|
||||
base ^>=4.14.3.0
|
||||
, graphql >= 1.0.1.0 && < 1.1
|
||||
default-language: Haskell2010
|
||||
|
||||
|
||||
test-suite graphql-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Language.GraphQL.DirectiveSpec
|
||||
Language.GraphQL.FragmentSpec
|
||||
Language.GraphQL.RootOperationSpec
|
||||
hs-source-dirs:
|
||||
tests
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
build-depends:
|
||||
aeson
|
||||
, base >= 4.8 && < 5
|
||||
, graphql
|
||||
, hspec >= 2.9.1 && < 3
|
||||
, text
|
||||
, unordered-containers
|
||||
default-language: Haskell2010
|
||||
|
||||
92
tests/Language/GraphQL/DirectiveSpec.hs
Normal file
92
tests/Language/GraphQL/DirectiveSpec.hs
Normal file
@ -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
|
||||
204
tests/Language/GraphQL/FragmentSpec.hs
Normal file
204
tests/Language/GraphQL/FragmentSpec.hs
Normal file
@ -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
|
||||
72
tests/Language/GraphQL/RootOperationSpec.hs
Normal file
72
tests/Language/GraphQL/RootOperationSpec.hs
Normal file
@ -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
|
||||
1
tests/Spec.hs
Normal file
1
tests/Spec.hs
Normal file
@ -0,0 +1 @@
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
Loading…
Reference in New Issue
Block a user