diff options
Diffstat (limited to 'src/Language/GraphQL/Validate/Rules.hs')
| -rw-r--r-- | src/Language/GraphQL/Validate/Rules.hs | 22 |
1 files changed, 8 insertions, 14 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 |
