Move JSON tests to the upcoming extra package

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
+  CHANGELOG.md
-    README.md
+  README.md
 tested-with:
-    GHC == 8.10.7
+  GHC == 8.10.7,
-  , GHC == 9.0.1
+  GHC == 9.0.1
 
 source-repository head
   type: git
@@ -30,81 +30,78 @@ source-repository head
 
 library
   exposed-modules:
-      Language.GraphQL
+    Language.GraphQL
-      Language.GraphQL.AST
+    Language.GraphQL.AST
-      Language.GraphQL.AST.DirectiveLocation
+    Language.GraphQL.AST.DirectiveLocation
-      Language.GraphQL.AST.Document
+    Language.GraphQL.AST.Document
-      Language.GraphQL.AST.Encoder
+    Language.GraphQL.AST.Encoder
-      Language.GraphQL.AST.Lexer
+    Language.GraphQL.AST.Lexer
-      Language.GraphQL.AST.Parser
+    Language.GraphQL.AST.Parser
-      Language.GraphQL.Error
+    Language.GraphQL.Error
-      Language.GraphQL.Execute
+    Language.GraphQL.Execute
-      Language.GraphQL.Execute.Coerce
+    Language.GraphQL.Execute.Coerce
-      Language.GraphQL.Execute.OrderedMap
+    Language.GraphQL.Execute.OrderedMap
-      Language.GraphQL.TH
+    Language.GraphQL.TH
-      Language.GraphQL.Type
+    Language.GraphQL.Type
-      Language.GraphQL.Type.In
+    Language.GraphQL.Type.In
-      Language.GraphQL.Type.Out
+    Language.GraphQL.Type.Out
-      Language.GraphQL.Type.Schema
+    Language.GraphQL.Type.Schema
-      Language.GraphQL.Validate
+    Language.GraphQL.Validate
-      Language.GraphQL.Validate.Validation
+    Language.GraphQL.Validate.Validation
-      Test.Hspec.GraphQL
+    Test.Hspec.GraphQL
   other-modules:
-      Language.GraphQL.Execute.Transform
+    Language.GraphQL.Execute.Transform
-      Language.GraphQL.Type.Definition
+    Language.GraphQL.Type.Definition
-      Language.GraphQL.Type.Internal
+    Language.GraphQL.Type.Internal
-      Language.GraphQL.Validate.Rules
+    Language.GraphQL.Validate.Rules
   hs-source-dirs:
-      src
+    src
   ghc-options: -Wall
   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
 
 test-suite graphql-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
-      Language.GraphQL.AST.DocumentSpec
+    Language.GraphQL.AST.DocumentSpec
-      Language.GraphQL.AST.EncoderSpec
+    Language.GraphQL.AST.EncoderSpec
-      Language.GraphQL.AST.LexerSpec
+    Language.GraphQL.AST.LexerSpec
-      Language.GraphQL.AST.ParserSpec
+    Language.GraphQL.AST.ParserSpec
-      Language.GraphQL.ErrorSpec
+    Language.GraphQL.ErrorSpec
-      Language.GraphQL.Execute.CoerceSpec
+    Language.GraphQL.Execute.CoerceSpec
-      Language.GraphQL.Execute.OrderedMapSpec
+    Language.GraphQL.Execute.OrderedMapSpec
-      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:
-      tests
+    tests
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
   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

tests/Test/DirectiveSpec.hs

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

tests/Test/FragmentSpec.hs

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

tests/Test/RootOperationSpec.hs

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