diff options
| -rw-r--r-- | src/Language/GraphQL/Validate/Rules.hs | 22 | ||||
| -rw-r--r-- | tests/Language/GraphQL/Validate/RulesSpec.hs | 24 |
2 files changed, 30 insertions, 16 deletions
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index 2be8bec..2d7adba 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -2,11 +2,13 @@ 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 DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} -- | This module contains default rules defined in the GraphQL specification. @@ -61,6 +63,7 @@ import Data.Sequence (Seq(..), (|>)) import qualified Data.Sequence as Seq import Data.Text (Text) import qualified Data.Text as Text +import GHC.Records (HasField(..)) import qualified Language.GraphQL.AST.Document as Full import qualified Language.GraphQL.Type.Definition as Definition import qualified Language.GraphQL.Type.Internal as Type @@ -668,25 +671,16 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas = filterSelections' selections >>= lift . mapReaderT (<> mapDirectives directives') . pure findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments - mapArguments = Seq.fromList . (>>= findArgumentVariables) mapDirectives = foldMap findDirectiveVariables - findArgumentVariables (Full.Argument _ Full.Node{node = value, ..} _) = - findValueVariables location value + findArgumentVariables (Full.Argument _ value _) = findNodeVariables value + findNodeVariables Full.Node{ node = value, ..} = findValueVariables location value findValueVariables location (Full.Variable value') = [(value', [location])] - findValueVariables location (Full.List values) = - values - >>= (\(Full.Node{node = value}) -> findValueVariables location value) - findValueVariables _ (Full.Object fields) = - fields - >>= ( \( Full.ObjectField - { location = location - , value = Full.Node{node = value} - } - ) -> findValueVariables location value - ) + findValueVariables _ (Full.List values) = values >>= findNodeVariables + findValueVariables _ (Full.Object fields) = fields + >>= findNodeVariables . getField @"value" findValueVariables _ _ = [] makeError operationName (variableName, locations') = Error { message = errorMessage operationName variableName diff --git a/tests/Language/GraphQL/Validate/RulesSpec.hs b/tests/Language/GraphQL/Validate/RulesSpec.hs index 0d9faaa..7bdbd86 100644 --- a/tests/Language/GraphQL/Validate/RulesSpec.hs +++ b/tests/Language/GraphQL/Validate/RulesSpec.hs @@ -18,7 +18,7 @@ import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out import Language.GraphQL.Validate -import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain, xit) +import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain) import Text.Megaparsec (parse, errorBundlePretty) petSchema :: Schema IO @@ -29,6 +29,7 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList [ ("dog", dogResolver) , ("cat", catResolver) , ("findDog", findDogResolver) + , ("findCats", findCatsResolver) ] where dogField = Field Nothing (Out.NamedObjectType dogType) mempty @@ -39,6 +40,11 @@ queryType = ObjectType "Query" Nothing [] $ HashMap.fromList findDogResolver = ValueResolver findDogField $ pure Null catField = Field Nothing (Out.NamedObjectType catType) mempty catResolver = ValueResolver catField $ pure Null + findCatsArguments = HashMap.singleton "commands" + $ In.Argument Nothing (In.NonNullListType $ In.NonNullEnumType catCommandType) + $ Just $ List [] + findCatsField = Field Nothing (Out.NonNullListType $ Out.NonNullObjectType catType) findCatsArguments + findCatsResolver = ValueResolver findCatsField $ pure $ List [] catCommandType :: EnumType catCommandType = EnumType "CatCommand" Nothing $ HashMap.fromList @@ -560,7 +566,7 @@ spec = } in validate queryString `shouldBe` [expected] - xit "gets location of the variable inside an input object" $ + it "gets variable location inside an input object" $ let queryString = [gql| query { findDog (complex: { name: $name }) { @@ -574,6 +580,20 @@ spec = } in validate queryString `shouldBe` [expected] + it "gets variable location inside an array" $ + let queryString = [gql| + query { + findCats (commands: [JUMP, $command]) { + name + } + } + |] + expected = Error + { message = "Variable \"$command\" is not defined." + , locations = [AST.Location 2 30] + } + in validate queryString `shouldBe` [expected] + context "noUnusedVariablesRule" $ do it "rejects unused variables" $ let queryString = [gql| |