Rename variablesInAllowedPositionRule's variables

Name variablesInAllowedPositionRule's variables more meaningful.

1 files changed, 46 insertions, 37 deletions

diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index a159983..dad98ef 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -1328,6 +1328,12 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
         -> ValidationState m (Seq Error)
     visitSelectionSet variables selectionType selections =
         foldM (evaluateSelection variables selectionType) mempty selections
+    evaluateFieldSelection variables selections accumulator = \case
+        Just newParentType -> do
+            let folder = evaluateSelection variables newParentType
+            selectionErrors <- foldM folder accumulator selections
+            pure $ accumulator <> selectionErrors
+        Nothing -> pure accumulator
     evaluateSelection :: [Full.VariableDefinition]
         -> Type.CompositeType m
         -> Seq Error
@@ -1342,30 +1348,28 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
                 Just fragmentDefinition
                     | Full.FragmentDefinition _ typeCondition _ _ _ <- fragmentDefinition
                     , Just spreadType <- Type.lookupTypeCondition typeCondition types' -> do
-                        a <- spreadVariables variables spread
-                        b <- diveIntoSpread variables spreadType fragmentDefinition
-                        pure $ accumulator <> a <> b
+                        spreadErrors <- spreadVariables variables spread
+                        selectionErrors <- diveIntoSpread variables spreadType fragmentDefinition
+                        pure $ accumulator <> spreadErrors <> selectionErrors
                 _ -> lift $ lift mempty
         | Full.FieldSelection fieldSelection <- selection
         , Full.Field _ fieldName _ _ subselections _ <- fieldSelection =
             case Type.lookupCompositeField fieldName selectionType of
                 Just (Out.Field _ typeField argumentTypes) -> do
-                    a <- fieldVariables variables argumentTypes fieldSelection
-                    case Type.outToComposite typeField of
-                        Just newParentType -> do
-                            b <- foldM (evaluateSelection variables newParentType) accumulator subselections
-                            pure $ accumulator <> a <> b
-                        Nothing -> pure $ accumulator <> a
+                    fieldErrors <- fieldVariables variables argumentTypes fieldSelection
+                    selectionErrors <- evaluateFieldSelection variables subselections accumulator
+                            $ Type.outToComposite typeField
+                    pure $ selectionErrors <> fieldErrors
                 Nothing -> pure accumulator
         | Full.InlineFragmentSelection inlineSelection <- selection
         , Full.InlineFragment typeCondition _ subselections _ <- inlineSelection = do
             types' <- lift $ asks $ Schema.types . schema
             let inlineType = fromMaybe selectionType
-                    $ typeCondition
-                    >>= flip Type.lookupTypeCondition types'
-            a <- inlineVariables variables inlineSelection
-            b <- foldM (evaluateSelection variables inlineType) accumulator subselections
-            pure $ accumulator <> a <> b
+                    $ typeCondition >>= flip Type.lookupTypeCondition types'
+            fragmentErrors <- inlineVariables variables inlineSelection
+            let folder = evaluateSelection variables inlineType
+            selectionErrors <- foldM folder accumulator subselections
+            pure $ accumulator <> fragmentErrors <> selectionErrors
     inlineVariables variables inline
         | Full.InlineFragment _ directives' _ _ <- inline =
             mapDirectives variables directives'
@@ -1409,26 +1413,28 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
     findVariableDefinition variableName variableDefinition =
         let Full.VariableDefinition variableName' _ _ _ = variableDefinition
          in variableName == variableName'
-    isVariableUsageAllowed (In.Argument _ locationType locationDefaultValue) variableDefinition@(Full.VariableDefinition _ variableType variableDefaultValue _)
-        | Full.TypeNonNull _ <- variableType =
+    isVariableUsageAllowed (In.Argument _ locationType locationDefaultValue) variableDefinition
+        | Full.VariableDefinition _ variableType _ _ <- variableDefinition
+        , Full.TypeNonNull _ <- variableType =
             typesCompatibleOrError variableDefinition locationType
         | Just nullableLocationType <- unwrapInType locationType
-        , hasNonNullVariableDefaultValue' <- hasNonNullVariableDefaultValue variableDefaultValue
+        , Full.VariableDefinition _ _ variableDefaultValue _ <- variableDefinition
+        , hasNonNullVariableDefaultValue' <-
+            hasNonNullVariableDefaultValue variableDefaultValue
         , hasLocationDefaultValue <- isJust locationDefaultValue =
             if hasNonNullVariableDefaultValue' || hasLocationDefaultValue
                 then typesCompatibleOrError variableDefinition nullableLocationType
-                else pure $ Just $ makeError variableDefinition locationType
+                else pure $ makeError variableDefinition locationType
         | otherwise = typesCompatibleOrError variableDefinition locationType
     typesCompatibleOrError variableDefinition locationType
         | Full.VariableDefinition _ variableType _ _ <- variableDefinition
         , areTypesCompatible variableType locationType = pure Nothing
-        | otherwise = pure $ Just $ makeError variableDefinition locationType
-    areTypesCompatible (Full.TypeNonNull nonNullType) (unwrapInType -> Just nullableLocationType) =
-        case nonNullType of
-            Full.NonNullTypeNamed n -> 
-                areTypesCompatible (Full.TypeNamed n) nullableLocationType
-            Full.NonNullTypeList n -> 
-                areTypesCompatible (Full.TypeList n) nullableLocationType
+        | otherwise = pure $ makeError variableDefinition locationType
+    areTypesCompatible nonNullType (unwrapInType -> Just nullableLocationType)
+        | Full.TypeNonNull (Full.NonNullTypeNamed namedType) <- nonNullType =
+            areTypesCompatible (Full.TypeNamed namedType) nullableLocationType
+        | Full.TypeNonNull (Full.NonNullTypeList namedList) <- nonNullType =
+            areTypesCompatible (Full.TypeList namedList) nullableLocationType
     areTypesCompatible _ (In.isNonNullType -> True) = False
     areTypesCompatible (Full.TypeNonNull nonNullType) locationType
         | Full.NonNullTypeNamed namedType <- nonNullType =
@@ -1469,15 +1475,18 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case
     unwrapInType (In.NonNullListType nonNullType) =
         Just $ In.ListType nonNullType
     unwrapInType _ = Nothing
-    makeError (Full.VariableDefinition variableName variableType _ location') expectedType = Error
-        { message = concat
-            [ "Variable \"$"
-            , Text.unpack variableName
-            , "\" of type \""
-            , show variableType
-            , "\" used in position expecting type \""
-            , show expectedType
-            , "\"."
-            ]
-        , locations = [location']
-        }
+    makeError variableDefinition expectedType =
+        let Full.VariableDefinition variableName variableType _ location' =
+                variableDefinition
+         in Just $ Error
+            { message = concat
+                [ "Variable \"$"
+                , Text.unpack variableName
+                , "\" of type \""
+                , show variableType
+                , "\" used in position expecting type \""
+                , show expectedType
+                , "\"."
+                ]
+            , locations = [location']
+            }