diff options
Diffstat (limited to 'src/Language/GraphQL/Validate.hs')
| -rw-r--r-- | src/Language/GraphQL/Validate.hs | 34 |
1 files changed, 30 insertions, 4 deletions
diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index 53dc6f9..6ff1f57 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -15,7 +15,7 @@ module Language.GraphQL.Validate import Control.Monad (foldM) import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader) -import Data.Foldable (foldrM) +import Data.Foldable (fold, foldrM) import Data.Sequence (Seq(..), (><), (|>)) import qualified Data.Sequence as Seq import Language.GraphQL.AST.Document @@ -66,16 +66,42 @@ executableDefinition (DefinitionFragment definition') = operationDefinition :: forall m. OperationDefinition -> ValidateT m operationDefinition operation = - asks rules >>= foldM ruleFilter Seq.empty + let selectionSet = getSelectionSet operation + in visitChildSelections ruleFilter selectionSet where ruleFilter accumulator (OperationDefinitionRule rule) = mapReaderT (runRule accumulator) $ rule operation ruleFilter accumulator _ = pure accumulator + getSelectionSet (SelectionSet selectionSet _) = selectionSet + getSelectionSet (OperationDefinition _ _ _ _ selectionSet _) = selectionSet -fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m -fragmentDefinition fragment = +selection :: forall m. Selection -> ValidateT m +selection selection'@FragmentSpread{} = asks rules >>= foldM ruleFilter Seq.empty where + ruleFilter accumulator (SelectionRule rule) = + mapReaderT (runRule accumulator) $ rule selection' + ruleFilter accumulator _ = pure accumulator +selection (Field _ _ _ _ selectionSet) = traverseSelectionSet selectionSet +selection (InlineFragment _ _ selectionSet) = traverseSelectionSet selectionSet + +traverseSelectionSet :: Traversable t => forall m. t Selection -> ValidateT m +traverseSelectionSet = fmap fold . traverse selection + +visitChildSelections :: Traversable t + => (Seq Error -> Rule m -> ValidateT m) + -> t Selection + -> ValidateT m +visitChildSelections ruleFilter selectionSet = do + rules' <- asks rules + applied <- foldM ruleFilter Seq.empty rules' + children <- traverseSelectionSet selectionSet + pure $ children >< applied + +fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m +fragmentDefinition fragment@(FragmentDefinition _ _ _ selectionSet _) = + visitChildSelections ruleFilter selectionSet + where ruleFilter accumulator (FragmentDefinitionRule rule) = mapReaderT (runRule accumulator) $ rule fragment ruleFilter accumulator _ = pure accumulator |
