From 0047a13bc0c056d3adc3bbee00284ee07d831cc6 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 22 Nov 2021 07:22:28 +0100 Subject: [PATCH] Move JSON tests to the upcoming extra package --- graphql.cabal | 135 +++++++++++---------- tests/Test/DirectiveSpec.hs | 92 -------------- tests/Test/FragmentSpec.hs | 204 -------------------------------- tests/Test/RootOperationSpec.hs | 72 ----------- 4 files changed, 66 insertions(+), 437 deletions(-) delete mode 100644 tests/Test/DirectiveSpec.hs delete mode 100644 tests/Test/FragmentSpec.hs delete mode 100644 tests/Test/RootOperationSpec.hs diff --git a/graphql.cabal b/graphql.cabal index 08fb6de..232b537 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.2 +cabal-version: 2.4 name: graphql version: 1.0.1.0 @@ -18,11 +18,11 @@ license-files: LICENSE, LICENSE.MPL build-type: Simple extra-source-files: - CHANGELOG.md - README.md + CHANGELOG.md + README.md tested-with: - GHC == 8.10.7 - , GHC == 9.0.1 + GHC == 8.10.7, + GHC == 9.0.1 source-repository head type: git @@ -30,81 +30,78 @@ source-repository head library exposed-modules: - Language.GraphQL - Language.GraphQL.AST - Language.GraphQL.AST.DirectiveLocation - Language.GraphQL.AST.Document - Language.GraphQL.AST.Encoder - Language.GraphQL.AST.Lexer - Language.GraphQL.AST.Parser - Language.GraphQL.Error - Language.GraphQL.Execute - Language.GraphQL.Execute.Coerce - Language.GraphQL.Execute.OrderedMap - Language.GraphQL.TH - Language.GraphQL.Type - Language.GraphQL.Type.In - Language.GraphQL.Type.Out - Language.GraphQL.Type.Schema - Language.GraphQL.Validate - Language.GraphQL.Validate.Validation - Test.Hspec.GraphQL + Language.GraphQL + Language.GraphQL.AST + Language.GraphQL.AST.DirectiveLocation + Language.GraphQL.AST.Document + Language.GraphQL.AST.Encoder + Language.GraphQL.AST.Lexer + Language.GraphQL.AST.Parser + Language.GraphQL.Error + Language.GraphQL.Execute + Language.GraphQL.Execute.Coerce + Language.GraphQL.Execute.OrderedMap + Language.GraphQL.TH + Language.GraphQL.Type + Language.GraphQL.Type.In + Language.GraphQL.Type.Out + Language.GraphQL.Type.Schema + Language.GraphQL.Validate + Language.GraphQL.Validate.Validation + Test.Hspec.GraphQL other-modules: - Language.GraphQL.Execute.Transform - Language.GraphQL.Type.Definition - Language.GraphQL.Type.Internal - Language.GraphQL.Validate.Rules + Language.GraphQL.Execute.Transform + Language.GraphQL.Type.Definition + Language.GraphQL.Type.Internal + Language.GraphQL.Validate.Rules hs-source-dirs: - src + src ghc-options: -Wall build-depends: - aeson >= 1.5.6 && < 1.6 - , base >= 4.7 && < 5 - , conduit >= 1.3.4 && < 1.4 - , containers >= 0.6.2 && < 0.7 - , exceptions >= 0.10.4 && < 0.11 - , hspec-expectations >= 0.8.2 && < 0.9 - , megaparsec >= 9.0.1 && < 9.1 - , parser-combinators >= 1.3.0 && < 1.4 - , scientific >= 0.3.7 && < 0.4 - , template-haskell >= 2.16 && < 2.18 - , text >= 1.2.4 && < 1.3 - , transformers >= 0.5.6 && < 0.6 - , unordered-containers >= 0.2.14 && < 0.3 - , vector >= 0.12.3 && < 0.13 + aeson >= 1.5.6 && < 1.6, + base >= 4.7 && < 5, + conduit >= 1.3.4 && < 1.4, + containers >= 0.6.2 && < 0.7, + exceptions >= 0.10.4 && < 0.11, + hspec-expectations >= 0.8.2 && < 0.9, + megaparsec >= 9.0.1 && < 9.1, + parser-combinators >= 1.3.0 && < 1.4, + scientific >= 0.3.7 && < 0.4, + template-haskell >= 2.16 && < 2.18, + text >= 1.2.4 && < 1.3, + transformers >= 0.5.6 && < 0.6, + unordered-containers >= 0.2.14 && < 0.3, + vector >= 0.12.3 && < 0.13 default-language: Haskell2010 test-suite graphql-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Language.GraphQL.AST.DocumentSpec - Language.GraphQL.AST.EncoderSpec - Language.GraphQL.AST.LexerSpec - Language.GraphQL.AST.ParserSpec - Language.GraphQL.ErrorSpec - Language.GraphQL.Execute.CoerceSpec - Language.GraphQL.Execute.OrderedMapSpec - Language.GraphQL.ExecuteSpec - Language.GraphQL.Type.OutSpec - Language.GraphQL.Validate.RulesSpec - Test.DirectiveSpec - Test.FragmentSpec - Test.RootOperationSpec + Language.GraphQL.AST.DocumentSpec + Language.GraphQL.AST.EncoderSpec + Language.GraphQL.AST.LexerSpec + Language.GraphQL.AST.ParserSpec + Language.GraphQL.ErrorSpec + Language.GraphQL.Execute.CoerceSpec + Language.GraphQL.Execute.OrderedMapSpec + Language.GraphQL.ExecuteSpec + Language.GraphQL.Type.OutSpec + Language.GraphQL.Validate.RulesSpec hs-source-dirs: - tests + tests ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: - QuickCheck >= 2.14.1 && < 2.15 - , aeson - , base >= 4.8 && < 5 - , conduit - , exceptions - , graphql - , hspec >= 2.8.2 && < 2.9 - , hspec-megaparsec >= 2.2.0 && < 2.3 - , megaparsec - , scientific - , text - , unordered-containers + QuickCheck >= 2.14.1 && < 2.15, + aeson, + base >= 4.8 && < 5, + conduit, + exceptions, + graphql, + hspec >= 2.9.1 && < 3, + hspec-megaparsec >= 2.2.0 && < 2.3, + megaparsec, + scientific, + text, + unordered-containers default-language: Haskell2010 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