{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Validation.Query.FragmentPreconditions ( checkFragmentPreconditions, ) where import Data.Morpheus.Error.Fragment ( cannotSpreadWithinItself, ) import Data.Morpheus.Internal.Graph ( Edges, Graph, Node, cycleChecking, ) import Data.Morpheus.Internal.Utils ( Failure (..), elems, selectOr, ) import Data.Morpheus.Types.Internal.AST ( Fragment (..), Fragments, RAW, Ref (..), Selection (..), SelectionContent (..), SelectionSet, ) import Data.Morpheus.Types.Internal.Validation ( BaseValidator, askFragments, checkUnused, ) import Relude checkUnusedFragments :: SelectionSet RAW -> BaseValidator () checkUnusedFragments :: SelectionSet RAW -> BaseValidator () checkUnusedFragments SelectionSet RAW selectionSet = do Fragments RAW fragments <- Validator VALID (OperationContext RAW RAW) (Fragments RAW) forall (m :: * -> * -> *) (s :: Stage) c (s' :: Stage). (MonadContext m s c, GetWith c (Fragments s')) => m c (Fragments s') askFragments [Node] -> [Fragment RAW] -> BaseValidator () forall k b a ca ctx (s :: Stage). (KeyOf k b, Selectable k a ca, Unused ctx b) => ca -> [b] -> Validator s ctx () checkUnused (Fragments RAW -> [Selection RAW] -> [Node] usedFragments Fragments RAW fragments (SelectionSet RAW -> [Selection RAW] forall a coll. Elems a coll => coll -> [a] elems SelectionSet RAW selectionSet)) (Fragments RAW -> [Fragment RAW] forall a coll. Elems a coll => coll -> [a] elems Fragments RAW fragments) usedFragments :: Fragments RAW -> [Selection RAW] -> [Node] usedFragments :: Fragments RAW -> [Selection RAW] -> [Node] usedFragments Fragments RAW fragments = (Selection RAW -> [Node]) -> [Selection RAW] -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] findAllUses where findUsesSelectionContent :: SelectionContent RAW -> [Node] findUsesSelectionContent :: SelectionContent RAW -> [Node] findUsesSelectionContent (SelectionSet SelectionSet RAW selectionSet) = (Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] findAllUses SelectionSet RAW selectionSet findUsesSelectionContent SelectionContent RAW SelectionField = [] findAllUses :: Selection RAW -> [Node] findAllUses :: Selection RAW -> [Node] findAllUses Selection {SelectionContent RAW selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s selectionContent :: SelectionContent RAW selectionContent} = SelectionContent RAW -> [Node] findUsesSelectionContent SelectionContent RAW selectionContent findAllUses (InlineFragment Fragment {SelectionSet RAW fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage fragmentSelection :: SelectionSet RAW fragmentSelection}) = (Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] findAllUses SelectionSet RAW fragmentSelection findAllUses (Spread Directives RAW _ Ref {FieldName refName :: Node -> FieldName refName :: FieldName refName, Position refPosition :: Node -> Position refPosition :: Position refPosition}) = [FieldName -> Position -> Node Ref FieldName refName Position refPosition] [Node] -> [Node] -> [Node] forall a. Semigroup a => a -> a -> a <> [Node] searchInFragment where searchInFragment :: [Node] searchInFragment = [Node] -> (Fragment RAW -> [Node]) -> FieldName -> Fragments RAW -> [Node] forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d selectOr [] ((Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] findAllUses (SelectionSet RAW -> [Node]) -> (Fragment RAW -> SelectionSet RAW) -> Fragment RAW -> [Node] forall b c a. (b -> c) -> (a -> b) -> a -> c . Fragment RAW -> SelectionSet RAW forall (stage :: Stage). Fragment stage -> SelectionSet stage fragmentSelection) FieldName refName Fragments RAW fragments checkFragmentPreconditions :: SelectionSet RAW -> BaseValidator () checkFragmentPreconditions :: SelectionSet RAW -> BaseValidator () checkFragmentPreconditions SelectionSet RAW selection = (BaseValidator Graph exploreSpreads BaseValidator Graph -> (Graph -> BaseValidator ()) -> BaseValidator () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (NonEmpty Node -> BaseValidator ()) -> Graph -> BaseValidator () forall (m :: * -> *). Applicative m => (NonEmpty Node -> m ()) -> Graph -> m () cycleChecking (ValidationError -> BaseValidator () forall error (f :: * -> *) v. Failure error f => error -> f v failure (ValidationError -> BaseValidator ()) -> (NonEmpty Node -> ValidationError) -> NonEmpty Node -> BaseValidator () forall b c a. (b -> c) -> (a -> b) -> a -> c . NonEmpty Node -> ValidationError cannotSpreadWithinItself)) BaseValidator () -> BaseValidator () -> BaseValidator () forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> SelectionSet RAW -> BaseValidator () checkUnusedFragments SelectionSet RAW selection exploreSpreads :: BaseValidator Graph exploreSpreads :: BaseValidator Graph exploreSpreads = (Fragment RAW -> Edges) -> [Fragment RAW] -> Graph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Fragment RAW -> Edges exploreFragmentSpreads ([Fragment RAW] -> Graph) -> (Fragments RAW -> [Fragment RAW]) -> Fragments RAW -> Graph forall b c a. (b -> c) -> (a -> b) -> a -> c . Fragments RAW -> [Fragment RAW] forall a coll. Elems a coll => coll -> [a] elems (Fragments RAW -> Graph) -> Validator VALID (OperationContext RAW RAW) (Fragments RAW) -> BaseValidator Graph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Validator VALID (OperationContext RAW RAW) (Fragments RAW) forall (m :: * -> * -> *) (s :: Stage) c (s' :: Stage). (MonadContext m s c, GetWith c (Fragments s')) => m c (Fragments s') askFragments exploreFragmentSpreads :: Fragment RAW -> Edges exploreFragmentSpreads :: Fragment RAW -> Edges exploreFragmentSpreads Fragment {FieldName fragmentName :: forall (stage :: Stage). Fragment stage -> FieldName fragmentName :: FieldName fragmentName, SelectionSet RAW fragmentSelection :: SelectionSet RAW fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage fragmentSelection, Position fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position fragmentPosition :: Position fragmentPosition} = (FieldName -> Position -> Node Ref FieldName fragmentName Position fragmentPosition, (Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] forall a. ScanSpread a => a -> [Node] scanSpread SelectionSet RAW fragmentSelection) class ScanSpread a where scanSpread :: a -> [Node] instance ScanSpread (Selection RAW) where scanSpread :: Selection RAW -> [Node] scanSpread Selection {SelectionContent RAW selectionContent :: SelectionContent RAW selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s selectionContent} = SelectionContent RAW -> [Node] forall a. ScanSpread a => a -> [Node] scanSpread SelectionContent RAW selectionContent scanSpread (InlineFragment Fragment {SelectionSet RAW fragmentSelection :: SelectionSet RAW fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage fragmentSelection}) = (Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] forall a. ScanSpread a => a -> [Node] scanSpread SelectionSet RAW fragmentSelection scanSpread (Spread Directives RAW _ Ref {FieldName refName :: FieldName refName :: Node -> FieldName refName, Position refPosition :: Position refPosition :: Node -> Position refPosition}) = [FieldName -> Position -> Node Ref FieldName refName Position refPosition] instance ScanSpread (SelectionContent RAW) where scanSpread :: SelectionContent RAW -> [Node] scanSpread SelectionContent RAW SelectionField = [] scanSpread (SelectionSet SelectionSet RAW selectionSet) = (Selection RAW -> [Node]) -> SelectionSet RAW -> [Node] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Selection RAW -> [Node] forall a. ScanSpread a => a -> [Node] scanSpread SelectionSet RAW selectionSet