OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Rename variablesInAllowedPositionRule's variables

Browse Source 
Name variablesInAllowedPositionRule's variables more meaningful.
This commit is contained in:
Eugen Wissner 2020-12-27 11:47:29 +01:00
parent 22abf7ca58
commit 71a5964c27
1 changed files with 46 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
src/Language/GraphQL/Validate/Rules.hs
View File

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