From 9a08aa5de73e225a9a76017aee4886ce7f6eccec Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 18 Sep 2020 07:32:58 +0200 Subject: Validate directives are unique per location --- src/Language/GraphQL/Validate.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'src/Language/GraphQL/Validate.hs') diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index 00ba629..ff2734d 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -15,6 +15,7 @@ module Language.GraphQL.Validate import Control.Monad (join) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Reader (runReaderT) +import Data.Foldable (toList) import Data.Sequence (Seq(..), (><), (|>)) import qualified Data.Sequence as Seq import Language.GraphQL.AST.Document @@ -185,7 +186,13 @@ fragmentSpread rule fragmentSpread'@(FragmentSpread _ directives' _) applyToChildren = directives rule directives' directives :: Traversable t => Rule m -> t Directive -> Seq (RuleT m) -directives = foldMap . fmap pure . directive +directives rule directives' + | DirectivesRule directivesRule <- rule = + applyToChildren |> directivesRule directiveList + | otherwise = applyToChildren + where + directiveList = toList directives' + applyToChildren = Seq.fromList $ fmap (directive rule) directiveList directive :: Rule m -> Directive -> RuleT m directive (ArgumentsRule _ rule) = rule -- cgit v1.2.3