From 4b5e25a4d84e992910ad4bdf92b0f8a2213493a8 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 25 Aug 2024 12:01:48 +0200 Subject: [PATCH] Add repeatable argument to the directive MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit … schema representation. --- CHANGELOG.md | 7 +++++++ src/Language/GraphQL/Type/In.hs | 1 + src/Language/GraphQL/Type/Internal.hs | 6 +++++- src/Language/GraphQL/Type/Schema.hs | 8 ++++---- src/Language/GraphQL/Validate.hs | 2 +- src/Language/GraphQL/Validate/Rules.hs | 8 ++++---- 6 files changed, 22 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index a1e7e1e..0117b95 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,9 +7,16 @@ and this project adheres to [Haskell Package Versioning Policy](https://pvp.haskell.org/). ## [Unreleased] +### Changed +- `Schema.Directive` is extended to contain a boolean argument, representing + repeatable directives. + ### Fixed - `gql` quasi quoter recognizeds all GraphQL line endings (CR, LF and CRLF). +### Added +- @specifiedBy directive. + ## [1.3.0.0] - 2024-05-01 ### Changed - Remove deprecated `runCollectErrs`, `Resolution`, `CollectErrsT` from the 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