From 0047a13bc0c056d3adc3bbee00284ee07d831cc6 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 22 Nov 2021 07:22:28 +0100 Subject: Move JSON tests to the upcoming extra package --- tests/Test/DirectiveSpec.hs | 92 ------------------ tests/Test/FragmentSpec.hs | 204 ---------------------------------------- tests/Test/RootOperationSpec.hs | 72 -------------- 3 files changed, 368 deletions(-) delete mode 100644 tests/Test/DirectiveSpec.hs delete mode 100644 tests/Test/FragmentSpec.hs delete mode 100644 tests/Test/RootOperationSpec.hs (limited to 'tests') 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 -- cgit v1.2.3