diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/GraphQL/Type/In.hs | 1 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Internal.hs | 6 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Schema.hs | 8 | ||||
| -rw-r--r-- | src/Language/GraphQL/Validate.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Validate/Rules.hs | 8 |
5 files changed, 15 insertions, 10 deletions
diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs index c777e69..bd78c8c 100644 --- a/src/Language/GraphQL/Type/In.hs +++ b/src/Language/GraphQL/Type/In.hs @@ -74,6 +74,7 @@ instance Show Type where -- | Field argument definition. data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) + deriving Eq -- | Field argument definitions. type Arguments = HashMap Name Argument diff --git a/src/Language/GraphQL/Type/Internal.hs b/src/Language/GraphQL/Type/Internal.hs index ce3b121..a126782 100644 --- a/src/Language/GraphQL/Type/Internal.hs +++ b/src/Language/GraphQL/Type/Internal.hs @@ -48,7 +48,11 @@ data Type m deriving Eq -- | Directive definition. -data Directive = Directive (Maybe Text) [DirectiveLocation] In.Arguments +-- +-- A definition consists of an optional description, arguments, whether the +-- directive is repeatable, and the allowed directive locations. +data Directive = Directive (Maybe Text) In.Arguments Bool [DirectiveLocation] + deriving Eq -- | Directive definitions. type Directives = HashMap Full.Name Directive diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs index 27053f2..6084a77 100644 --- a/src/Language/GraphQL/Type/Schema.hs +++ b/src/Language/GraphQL/Type/Schema.hs @@ -88,13 +88,13 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire , ("specifiedBy", specifiedByDirective) ] includeDirective = - Directive includeDescription skipIncludeLocations includeArguments + Directive includeDescription includeArguments False skipIncludeLocations includeArguments = HashMap.singleton "if" $ In.Argument (Just "Included when true.") ifType Nothing includeDescription = Just "Directs the executor to include this field or fragment only when the \ \`if` argument is true." - skipDirective = Directive skipDescription skipIncludeLocations skipArguments + skipDirective = Directive skipDescription skipArguments False skipIncludeLocations skipArguments = HashMap.singleton "if" $ In.Argument (Just "skipped when true.") ifType Nothing ifType = In.NonNullScalarType Definition.boolean @@ -107,7 +107,7 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire , ExecutableDirectiveLocation DirectiveLocation.InlineFragment ] deprecatedDirective = - Directive deprecatedDescription deprecatedLocations deprecatedArguments + Directive deprecatedDescription deprecatedArguments False deprecatedLocations reasonDescription = Just "Explains why this element was deprecated, usually also including a \ \suggestion for how to access supported similar data. Formatted using \ @@ -125,7 +125,7 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire , TypeSystemDirectiveLocation DirectiveLocation.EnumValue ] specifiedByDirective = - Directive specifiedByDescription specifiedByLocations specifiedByArguments + Directive specifiedByDescription specifiedByArguments False specifiedByLocations urlDescription = Just "The URL that specifies the behavior of this scalar." specifiedByArguments = HashMap.singleton "url" diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index f929b98..f6f8788 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -482,4 +482,4 @@ directive context rule (Full.Directive directiveName arguments' _) = $ Validation.schema context in arguments rule argumentTypes arguments' where - directiveArguments (Schema.Directive _ _ argumentTypes) = argumentTypes + directiveArguments (Schema.Directive _ argumentTypes _ _) = argumentTypes diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index e60d39d..c68cd61 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -831,7 +831,7 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule . Schema.directives . schema Full.Argument argumentName _ location' <- lift $ Seq.fromList arguments case available of - Just (Schema.Directive _ _ definitions) + Just (Schema.Directive _ definitions _ _) | not $ HashMap.member argumentName definitions -> pure $ makeError argumentName directiveName location' _ -> lift mempty @@ -911,7 +911,7 @@ directivesInValidLocationsRule = DirectivesRule directivesRule maybeDefinition <- asks $ HashMap.lookup directiveName . Schema.directives . schema case maybeDefinition of - Just (Schema.Directive _ allowedLocations _) + Just (Schema.Directive _ _ _ allowedLocations) | directiveLocation `notElem` allowedLocations -> pure $ Error { message = errorMessage directiveName directiveLocation , locations = [location] @@ -941,7 +941,7 @@ providedRequiredArgumentsRule = ArgumentsRule fieldRule directiveRule available <- asks $ HashMap.lookup directiveName . Schema.directives . schema case available of - Just (Schema.Directive _ _ definitions) -> + Just (Schema.Directive _ definitions _ _) -> let forEach = go (directiveMessage directiveName) arguments location' in lift $ HashMap.foldrWithKey forEach Seq.empty definitions _ -> lift mempty @@ -1409,7 +1409,7 @@ variablesInAllowedPositionRule = OperationDefinitionRule $ \case let Full.Directive directiveName arguments _ = directive directiveDefinitions <- lift $ asks $ Schema.directives . schema case HashMap.lookup directiveName directiveDefinitions of - Just (Schema.Directive _ _ directiveArguments) -> + Just (Schema.Directive _ directiveArguments _ _) -> mapArguments variables directiveArguments arguments Nothing -> pure mempty mapArguments variables argumentTypes = fmap fold |