aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/AST/DirectiveLocation.hs2
-rw-r--r--src/Language/GraphQL/AST/Document.hs8
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs5
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs80
-rw-r--r--src/Language/GraphQL/AST/Parser.hs4
-rw-r--r--src/Language/GraphQL/Execute/Coerce.hs2
-rw-r--r--src/Language/GraphQL/TH.hs18
-rw-r--r--src/Language/GraphQL/Type/In.hs1
-rw-r--r--src/Language/GraphQL/Type/Internal.hs6
-rw-r--r--src/Language/GraphQL/Type/Schema.hs20
-rw-r--r--src/Language/GraphQL/Validate.hs8
-rw-r--r--src/Language/GraphQL/Validate/Rules.hs75
12 files changed, 135 insertions, 94 deletions
diff --git a/src/Language/GraphQL/AST/DirectiveLocation.hs b/src/Language/GraphQL/AST/DirectiveLocation.hs
index d109666..600f931 100644
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE Safe #-}
--- | Various parts of a GraphQL document can be annotated with directives.
+-- | Various parts of a GraphQL document can be annotated with directives.
-- This module describes locations in a document where directives can appear.
module Language.GraphQL.AST.DirectiveLocation
( DirectiveLocation(..)
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 66fc246..101cf78 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -380,7 +380,11 @@ instance Show NonNullType where
--
-- Directives begin with "@", can accept arguments, and can be applied to the
-- most GraphQL elements, providing additional information.
-data Directive = Directive Name [Argument] Location deriving (Eq, Show)
+data Directive = Directive
+ { name :: Name
+ , arguments :: [Argument]
+ , location :: Location
+ } deriving (Eq, Show)
-- * Type System
@@ -405,7 +409,7 @@ data TypeSystemDefinition
= SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
| TypeDefinition TypeDefinition
| DirectiveDefinition
- Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
+ Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation)
deriving (Eq, Show)
-- ** Type System Extensions
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 120fb64..a1076e4 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -159,11 +159,12 @@ typeSystemDefinition formatter = \case
<> optempty (directives formatter) operationDirectives
<> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
- Full.DirectiveDefinition description' name' arguments' locations
+ Full.DirectiveDefinition description' name' arguments' repeatable locations
-> description formatter description'
<> "@"
<> Lazy.Text.fromStrict name'
<> argumentsDefinition formatter arguments'
+ <> (if repeatable then " repeatable" else mempty)
<> " on"
<> pipeList formatter (directiveLocation <$> locations)
@@ -276,7 +277,7 @@ pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text
pipeList Minified = (" " <>) . Lazy.Text.intercalate " | " . toList
pipeList (Pretty _) = Lazy.Text.concat
. fmap (("\n" <> indentSymbol <> "| ") <>)
- . toList
+ . toList
enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text
enumValueDefinition (Pretty _) enumValue =
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index ab1f36f..62cf4d2 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -29,7 +29,8 @@ module Language.GraphQL.AST.Lexer
, unicodeBOM
) where
-import Control.Applicative (Alternative(..), liftA2)
+import Control.Applicative (Alternative(..))
+import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
import Data.Foldable (foldl')
import Data.List (dropWhileEnd)
@@ -37,22 +38,22 @@ import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
import Data.Proxy (Proxy(..))
import Data.Void (Void)
-import Text.Megaparsec ( Parsec
- , (<?>)
- , between
- , chunk
- , chunkToTokens
- , notFollowedBy
- , oneOf
- , option
- , optional
- , satisfy
- , sepBy
- , skipSome
- , takeP
- , takeWhile1P
- , try
- )
+import Text.Megaparsec
+ ( Parsec
+ , (<?>)
+ , between
+ , chunk
+ , chunkToTokens
+ , notFollowedBy
+ , oneOf
+ , option
+ , optional
+ , satisfy
+ , skipSome
+ , takeP
+ , takeWhile1P
+ , try
+ )
import Text.Megaparsec.Char (char, digitChar, space1)
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Data.Text (Text)
@@ -142,12 +143,13 @@ blockString :: Parser T.Text
blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
where
stringValue = do
- byLine <- sepBy (many blockStringCharacter) lineTerminator
- let indentSize = foldr countIndent 0 $ tail byLine
- withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
+ byLine <- NonEmpty.sepBy1 (many blockStringCharacter) lineTerminator
+ let indentSize = foldr countIndent 0 $ NonEmpty.tail byLine
+ withoutIndent = NonEmpty.head byLine
+ : (removeIndent indentSize <$> NonEmpty.tail byLine)
withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
- return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
+ pure $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
removeEmptyLine [] = True
removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
removeEmptyLine _ = False
@@ -180,10 +182,10 @@ name :: Parser T.Text
name = do
firstLetter <- nameFirstLetter
rest <- many $ nameFirstLetter <|> digitChar
- _ <- spaceConsumer
- return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
- where
- nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
+ void spaceConsumer
+ pure $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
+ where
+ nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
isChunkDelimiter :: Char -> Bool
isChunkDelimiter = flip notElem ['"', '\\', '\n', '\r']
@@ -197,25 +199,25 @@ lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
isSourceCharacter :: Char -> Bool
isSourceCharacter = isSourceCharacter' . ord
where
- isSourceCharacter' code = code >= 0x0020
- || code == 0x0009
- || code == 0x000a
- || code == 0x000d
+ isSourceCharacter' code
+ = code >= 0x0020
+ || elem code [0x0009, 0x000a, 0x000d]
escapeSequence :: Parser Char
escapeSequence = do
- _ <- char '\\'
+ void $ char '\\'
escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
case escaped of
- 'b' -> return '\b'
- 'f' -> return '\f'
- 'n' -> return '\n'
- 'r' -> return '\r'
- 't' -> return '\t'
- 'u' -> chr . foldl' step 0
- . chunkToTokens (Proxy :: Proxy T.Text)
- <$> takeP Nothing 4
- _ -> return escaped
+ 'b' -> pure '\b'
+ 'f' -> pure '\f'
+ 'n' -> pure '\n'
+ 'r' -> pure '\r'
+ 't' -> pure '\t'
+ 'u' -> chr
+ . foldl' step 0
+ . chunkToTokens (Proxy :: Proxy T.Text)
+ <$> takeP Nothing 4
+ _ -> pure escaped
where
step accumulator = (accumulator * 16 +) . digitToInt
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index e19823c..f325ee7 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -8,7 +8,7 @@ module Language.GraphQL.AST.Parser
( document
) where
-import Control.Applicative (Alternative(..), liftA2, optional)
+import Control.Applicative (Alternative(..), optional)
import Control.Applicative.Combinators (sepBy1)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
@@ -27,6 +27,7 @@ import Text.Megaparsec
, unPos
, (<?>)
)
+import Data.Maybe (isJust)
-- | Parser for the GraphQL documents.
document :: Parser Full.Document
@@ -82,6 +83,7 @@ directiveDefinition description' = Full.DirectiveDefinition description'
<* at
<*> name
<*> argumentsDefinition
+ <*> (isJust <$> optional (symbol "repeatable"))
<* symbol "on"
<*> directiveLocations
<?> "DirectiveDefinition"
diff --git a/src/Language/GraphQL/Execute/Coerce.hs b/src/Language/GraphQL/Execute/Coerce.hs
index 54fc1c1..f67d74b 100644
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@@ -147,7 +147,7 @@ coerceInputLiteral (In.EnumBaseType type') (Type.Enum enumValue)
| member enumValue type' = Just $ Type.Enum enumValue
where
member value (Type.EnumType _ _ members) = HashMap.member value members
-coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) =
+coerceInputLiteral (In.InputObjectBaseType type') (Type.Object values) =
let (In.InputObjectType _ _ inputFields) = type'
in Type.Object
<$> HashMap.foldrWithKey (matchFieldValues' values) (Just HashMap.empty) inputFields
diff --git a/src/Language/GraphQL/TH.hs b/src/Language/GraphQL/TH.hs
index 8e1fcb3..22ffdd0 100644
--- a/src/Language/GraphQL/TH.hs
+++ b/src/Language/GraphQL/TH.hs
@@ -12,20 +12,30 @@ import Language.Haskell.TH (Exp(..), Lit(..))
stripIndentation :: String -> String
stripIndentation code = reverse
- $ dropNewlines
+ $ dropWhile isLineBreak
$ reverse
$ unlines
- $ indent spaces <$> lines withoutLeadingNewlines
+ $ indent spaces <$> lines' withoutLeadingNewlines
where
indent 0 xs = xs
indent count (' ' : xs) = indent (count - 1) xs
indent _ xs = xs
- withoutLeadingNewlines = dropNewlines code
- dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==)
+ withoutLeadingNewlines = dropWhile isLineBreak code
spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
+ lines' "" = []
+ lines' string =
+ let (line, rest) = break isLineBreak string
+ reminder =
+ case rest of
+ [] -> []
+ '\r' : '\n' : strippedString -> lines' strippedString
+ _ : strippedString -> lines' strippedString
+ in line : reminder
+ isLineBreak = flip any ['\n', '\r'] . (==)
-- | Removes leading and trailing newlines. Indentation of the first line is
-- removed from each line of the string.
+{-# DEPRECATED gql "Use Language.GraphQL.Class.gql from graphql-spice instead" #-}
gql :: QuasiQuoter
gql = QuasiQuoter
{ quoteExp = pure . LitE . StringL . stripIndentation
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 c8ac77a..6084a77 100644
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -85,15 +85,16 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire
[ ("skip", skipDirective)
, ("include", includeDirective)
, ("deprecated", deprecatedDirective)
+ , ("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
@@ -106,16 +107,15 @@ 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 \
\the Markdown syntax, as specified by \
\[CommonMark](https://commonmark.org/).'"
deprecatedArguments = HashMap.singleton "reason"
- $ In.Argument reasonDescription reasonType
+ $ In.Argument reasonDescription (In.NamedScalarType Definition.string)
$ Just "No longer supported"
- reasonType = In.NamedScalarType Definition.string
deprecatedDescription = Just
"Marks an element of a GraphQL schema as no longer supported."
deprecatedLocations =
@@ -124,6 +124,16 @@ schemaWithTypes description' queryRoot mutationRoot subscriptionRoot types' dire
, TypeSystemDirectiveLocation DirectiveLocation.InputFieldDefinition
, TypeSystemDirectiveLocation DirectiveLocation.EnumValue
]
+ specifiedByDirective =
+ Directive specifiedByDescription specifiedByArguments False specifiedByLocations
+ urlDescription = Just
+ "The URL that specifies the behavior of this scalar."
+ specifiedByArguments = HashMap.singleton "url"
+ $ In.Argument urlDescription (In.NonNullScalarType Definition.string) Nothing
+ specifiedByDescription = Just
+ "Exposes a URL that specifies the behavior of this scalar."
+ specifiedByLocations =
+ [TypeSystemDirectiveLocation DirectiveLocation.Scalar]
-- | Traverses the schema and finds all referenced types.
collectReferencedTypes :: forall m
diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs
index f929b98..5feb85a 100644
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@@ -200,7 +200,7 @@ typeSystemDefinition context rule = \case
directives context rule schemaLocation directives'
Full.TypeDefinition typeDefinition' ->
typeDefinition context rule typeDefinition'
- Full.DirectiveDefinition _ _ arguments' _ ->
+ Full.DirectiveDefinition _ _ arguments' _ _ ->
argumentsDefinition context rule arguments'
typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
@@ -283,7 +283,7 @@ operationDefinition rule context operation
schema' = Validation.schema context
queryRoot = Just $ Out.NamedObjectType $ Schema.query schema'
types' = Schema.types schema'
-
+
typeToOut :: forall m. Schema.Type m -> Maybe (Out.Type m)
typeToOut (Schema.ObjectType objectType) =
Just $ Out.NamedObjectType objectType
@@ -403,7 +403,7 @@ arguments :: forall m
-> Seq (Validation.RuleT m)
arguments rule argumentTypes = foldMap forEach . Seq.fromList
where
- forEach argument'@(Full.Argument argumentName _ _) =
+ forEach argument'@(Full.Argument argumentName _ _) =
let argumentType = HashMap.lookup argumentName argumentTypes
in argument rule argumentType argument'
@@ -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 2d7adba..3fef94d 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -50,14 +50,15 @@ import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
import Data.Bifunctor (first)
-import Data.Foldable (find, fold, foldl', toList)
+import Data.Foldable (Foldable(..), find)
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
-import Data.List (groupBy, sortBy, sortOn)
+import Data.List (sortBy)
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
import Data.Ord (comparing)
import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq
@@ -253,14 +254,16 @@ findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
-> Full.Location
-> String
-> RuleT m
-findDuplicates filterByName thisLocation errorMessage = do
- ast' <- asks ast
- let locations' = foldr filterByName [] ast'
- if length locations' > 1 && head locations' == thisLocation
- then pure $ error' locations'
- else lift mempty
+findDuplicates filterByName thisLocation errorMessage =
+ asks ast >>= go . foldr filterByName []
where
- error' locations' = Error
+ go locations' =
+ case locations' of
+ headLocation : otherLocations -- length locations' > 1
+ | not $ null otherLocations
+ , headLocation == thisLocation -> pure $ makeError locations'
+ _ -> lift mempty
+ makeError locations' = Error
{ message = errorMessage
, locations = locations'
}
@@ -530,16 +533,20 @@ uniqueArgumentNamesRule = ArgumentsRule fieldRule directiveRule
-- used, the expected metadata or behavior becomes ambiguous, therefore only one
-- of each directive is allowed per location.
uniqueDirectiveNamesRule :: forall m. Rule m
-uniqueDirectiveNamesRule = DirectivesRule
- $ const $ lift . filterDuplicates extract "directive"
- where
- extract (Full.Directive directiveName _ location') =
- (directiveName, location')
-
-groupSorted :: forall a. (a -> Text) -> [a] -> [[a]]
-groupSorted getName = groupBy equalByName . sortOn getName
+uniqueDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
+ definitions' <- asks $ Schema.directives . schema
+ let filterNonRepeatable = flip HashSet.member nonRepeatableSet
+ . getField @"name"
+ nonRepeatableSet =
+ HashMap.foldlWithKey foldNonRepeatable HashSet.empty definitions'
+ lift $ filterDuplicates extract "directive"
+ $ filter filterNonRepeatable directives'
where
- equalByName lhs rhs = getName lhs == getName rhs
+ foldNonRepeatable hashSet directiveName' (Schema.Directive _ _ False _) =
+ HashSet.insert directiveName' hashSet
+ foldNonRepeatable hashSet _ _ = hashSet
+ extract (Full.Directive directiveName' _ location') =
+ (directiveName', location')
filterDuplicates :: forall a
. (a -> (Text, Full.Location))
@@ -549,12 +556,12 @@ filterDuplicates :: forall a
filterDuplicates extract nodeType = Seq.fromList
. fmap makeError
. filter ((> 1) . length)
- . groupSorted getName
+ . NonEmpty.groupAllWith getName
where
getName = fst . extract
makeError directives' = Error
- { message = makeMessage $ head directives'
- , locations = snd . extract <$> directives'
+ { message = makeMessage $ NonEmpty.head directives'
+ , locations = snd . extract <$> toList directives'
}
makeMessage directive = concat
[ "There can be only one "
@@ -833,7 +840,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
@@ -854,18 +861,18 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
knownDirectiveNamesRule :: Rule m
knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
definitions' <- asks $ Schema.directives . schema
- let directiveSet = HashSet.fromList $ fmap directiveName directives'
- let definitionSet = HashSet.fromList $ HashMap.keys definitions'
- let difference = HashSet.difference directiveSet definitionSet
- let undefined' = filter (definitionFilter difference) directives'
+ let directiveSet = HashSet.fromList $ fmap (getField @"name") directives'
+ definitionSet = HashSet.fromList $ HashMap.keys definitions'
+ difference = HashSet.difference directiveSet definitionSet
+ undefined' = filter (definitionFilter difference) directives'
lift $ Seq.fromList $ makeError <$> undefined'
where
+ definitionFilter :: HashSet Full.Name -> Full.Directive -> Bool
definitionFilter difference = flip HashSet.member difference
- . directiveName
- directiveName (Full.Directive directiveName' _ _) = directiveName'
- makeError (Full.Directive directiveName' _ location') = Error
- { message = errorMessage directiveName'
- , locations = [location']
+ . getField @"name"
+ makeError Full.Directive{..} = Error
+ { message = errorMessage name
+ , locations = [location]
}
errorMessage directiveName' = concat
[ "Unknown directive \"@"
@@ -913,7 +920,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]
@@ -943,7 +950,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
@@ -1411,7 +1418,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
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 09:35:34 +0000