Add repeatable argument to the directive

…  schema representation.

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

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

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

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"

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

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