{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Validation.Query.UnionSelection
( validateUnionSelection,
validateInterfaceSelection,
)
where
import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Lazy as HM
import Data.Mergeable (OrdMap)
import Data.Morpheus.Internal.Utils
( empty,
fromElems,
mergeConcat,
selectOr,
startHistory,
)
import Data.Morpheus.Types.Internal.AST.DirectiveLocation (DirectiveLocation (..))
import Data.Morpheus.Types.Internal.AST.Name (TypeName)
import Data.Morpheus.Types.Internal.AST.Selection
( Fragment (..),
Selection (..),
SelectionContent (..),
SelectionSet,
UnionTag (..),
)
import Data.Morpheus.Types.Internal.AST.Stage (RAW, VALID)
import Data.Morpheus.Types.Internal.AST.TypeCategory
( IMPLEMENTABLE,
OUT,
toCategory,
)
import Data.Morpheus.Types.Internal.AST.TypeSystem
( TypeContent (..),
TypeDefinition (..),
UnionTypeDefinition,
mkType,
)
import Data.Morpheus.Types.Internal.Validation
( FragmentValidator,
Scope (..),
askInterfaceTypes,
askTypeMember,
asksScope,
)
import Data.Morpheus.Validation.Internal.Directive (validateDirectives)
import Data.Morpheus.Validation.Query.Fragment
( ValidateFragmentSelection,
castFragmentType,
validateSpread,
)
import Relude hiding (empty, join)
splitFragment ::
(ValidateFragmentSelection s) =>
( Fragment RAW ->
FragmentValidator s (SelectionSet VALID)
) ->
[TypeDefinition IMPLEMENTABLE VALID] ->
Selection RAW ->
FragmentValidator s (Either UnionTag (Selection RAW))
splitFragment :: forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeDefinition IMPLEMENTABLE VALID]
-> Selection RAW
-> FragmentValidator s (Either UnionTag (Selection RAW))
splitFragment Fragment RAW -> FragmentValidator s (SelectionSet VALID)
_ [TypeDefinition IMPLEMENTABLE VALID]
_ x :: Selection RAW
x@Selection {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right Selection RAW
x)
splitFragment Fragment RAW -> FragmentValidator s (SelectionSet VALID)
f [TypeDefinition IMPLEMENTABLE VALID]
types (Spread Directives RAW
dirs Ref FragmentName
ref) = do
Directives VALID
_ <- forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives DirectiveLocation
LOCATION_FRAGMENT_SPREAD Directives RAW
dirs
forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeName] -> Ref FragmentName -> FragmentValidator s UnionTag
validateSpread Fragment RAW -> FragmentValidator s (SelectionSet VALID)
f (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDefinition IMPLEMENTABLE VALID]
types) Ref FragmentName
ref
splitFragment Fragment RAW -> FragmentValidator s (SelectionSet VALID)
f [TypeDefinition IMPLEMENTABLE VALID]
types (InlineFragment fragment :: Fragment RAW
fragment@Fragment {SelectionSet RAW
Directives RAW
Position
TypeName
FragmentName
fragmentDirectives :: forall (stage :: Stage). Fragment stage -> Directives stage
fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentPosition :: forall (stage :: Stage). Fragment stage -> Position
fragmentType :: forall (stage :: Stage). Fragment stage -> TypeName
fragmentName :: forall (stage :: Stage). Fragment stage -> FragmentName
fragmentDirectives :: Directives RAW
fragmentSelection :: SelectionSet RAW
fragmentPosition :: Position
fragmentType :: TypeName
fragmentName :: FragmentName
..}) = do
Directives VALID
_ <- forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives DirectiveLocation
LOCATION_INLINE_FRAGMENT Directives RAW
fragmentDirectives
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> SelectionSet VALID -> UnionTag
UnionTag TypeName
fragmentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (s :: Stage) (s1 :: Stage).
Maybe FragmentName
-> Position
-> [TypeName]
-> Fragment s
-> FragmentValidator s1 (Fragment s)
castFragmentType forall a. Maybe a
Nothing Position
fragmentPosition (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDefinition IMPLEMENTABLE VALID]
types) Fragment RAW
fragment forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fragment RAW -> FragmentValidator s (SelectionSet VALID)
f)
exploreFragments ::
(ValidateFragmentSelection s) =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID)) ->
OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID) ->
SelectionSet RAW ->
FragmentValidator s ([UnionTag], Maybe (SelectionSet RAW))
exploreFragments :: forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> SelectionSet RAW
-> FragmentValidator s ([UnionTag], Maybe (SelectionSet RAW))
exploreFragments Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
types SelectionSet RAW
selectionSet = do
([UnionTag]
tags, [Selection RAW]
selections) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeDefinition IMPLEMENTABLE VALID]
-> Selection RAW
-> FragmentValidator s (Either UnionTag (Selection RAW))
splitFragment Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
types)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet RAW
selectionSet)
([UnionTag]
tags,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Selection RAW]
selections
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems [Selection RAW]
selections
tagUnionFragments ::
[UnionTag] ->
OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID) ->
HashMap TypeName [SelectionSet VALID]
tagUnionFragments :: [UnionTag]
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> HashMap TypeName [SelectionSet VALID]
tagUnionFragments [UnionTag]
fragments OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
types = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TypeName] -> [SelectionSet VALID]
categorizeType HashMap TypeName [TypeName]
getSelectedTypes
where
getSelectedTypes :: HashMap TypeName [TypeName]
getSelectedTypes :: HashMap TypeName [TypeName]
getSelectedTypes = forall l. IsList l => [Item l] -> l
fromList (forall a b. (a -> b) -> [a] -> [b]
map UnionTag -> (TypeName, [TypeName])
select [UnionTag]
fragments)
where
select :: UnionTag -> (TypeName, [TypeName])
select UnionTag {TypeName
unionTagName :: UnionTag -> TypeName
unionTagName :: TypeName
unionTagName} =
( TypeName
unionTagName,
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr
[TypeName
unionTagName]
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> [TypeName]
getCompatibleTypes
TypeName
unionTagName
OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
types
)
categorizeType ::
[TypeName] -> [SelectionSet VALID]
categorizeType :: [TypeName] -> [SelectionSet VALID]
categorizeType [TypeName]
compatibleTypes =
UnionTag -> SelectionSet VALID
unionTagSelection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter
((forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [TypeName]
compatibleTypes) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionTag -> TypeName
unionTagName)
[UnionTag]
fragments
getCompatibleTypes :: TypeDefinition a s -> [TypeName]
getCompatibleTypes :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> [TypeName]
getCompatibleTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName, typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent 'True a s
typeContent = DataObject {[TypeName]
objectImplements :: forall (s :: Stage) (a :: TypeCategory).
CondTypeContent OBJECT a s -> [TypeName]
objectImplements :: [TypeName]
objectImplements}} = TypeName
typeName forall a. a -> [a] -> [a]
: [TypeName]
objectImplements
getCompatibleTypes TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName} = [TypeName
typeName]
maybeMerge :: [SelectionSet VALID] -> FragmentValidator s (Maybe (SelectionSet VALID))
maybeMerge :: forall (s :: Stage).
[SelectionSet VALID]
-> FragmentValidator s (Maybe (SelectionSet VALID))
maybeMerge [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
maybeMerge (SelectionSet VALID
x : [SelectionSet VALID]
xs) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. HistoryT m a -> m a
startHistory (forall (m :: * -> *) a e.
(Monad m, Merge m a, MonadError e m) =>
NonEmpty a -> m a
mergeConcat (SelectionSet VALID
x forall a. a -> [a] -> NonEmpty a
:| [SelectionSet VALID]
xs))
noEmptySelection :: FragmentValidator s a
noEmptySelection :: forall (s :: Stage) a. FragmentValidator s a
noEmptySelection = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
"empty selection sets are not supported."
joinClusters ::
Maybe (SelectionSet VALID) ->
HashMap TypeName [SelectionSet VALID] ->
FragmentValidator s (SelectionContent VALID)
joinClusters :: forall (s :: Stage).
Maybe (SelectionSet VALID)
-> HashMap TypeName [SelectionSet VALID]
-> FragmentValidator s (SelectionContent VALID)
joinClusters Maybe (SelectionSet VALID)
maybeSelSet HashMap TypeName [SelectionSet VALID]
typedSelections
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap TypeName [SelectionSet VALID]
typedSelections = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (s :: Stage) a. FragmentValidator s a
noEmptySelection (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet) Maybe (SelectionSet VALID)
maybeSelSet
| Bool
otherwise =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (s :: Stage).
(TypeName, [SelectionSet VALID]) -> FragmentValidator s UnionTag
mkUnionTag (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap TypeName [SelectionSet VALID]
typedSelections)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (SelectionSet VALID)
-> UnionSelection VALID -> SelectionContent VALID
UnionSelection Maybe (SelectionSet VALID)
maybeSelSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. HistoryT m a -> m a
startHistory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems
where
mkUnionTag :: (TypeName, [SelectionSet VALID]) -> FragmentValidator s UnionTag
mkUnionTag :: forall (s :: Stage).
(TypeName, [SelectionSet VALID]) -> FragmentValidator s UnionTag
mkUnionTag (TypeName
typeName, [SelectionSet VALID]
fragments) = TypeName -> SelectionSet VALID -> UnionTag
UnionTag TypeName
typeName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (s :: Stage).
[SelectionSet VALID]
-> FragmentValidator s (Maybe (SelectionSet VALID))
maybeMerge (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (SelectionSet VALID)
maybeSelSet forall a. Semigroup a => a -> a -> a
<> [SelectionSet VALID]
fragments) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (s :: Stage) a. FragmentValidator s a
noEmptySelection forall (f :: * -> *) a. Applicative f => a -> f a
pure)
validateInterfaceSelection ::
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID)) ->
(TypeDefinition IMPLEMENTABLE VALID -> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)) ->
TypeDefinition IMPLEMENTABLE VALID ->
SelectionSet RAW ->
FragmentValidator s (SelectionContent VALID)
validateInterfaceSelection :: forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> (TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID))
-> TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
validateInterfaceSelection
Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validate
typeDef :: TypeDefinition IMPLEMENTABLE VALID
typeDef@TypeDefinition {TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName}
SelectionSet RAW
inputSelectionSet = do
OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes <- forall (m :: * -> *) (s :: Stage) ctx.
(MonadError GQLError m, MonadReader (ValidatorContext s ctx) m,
FromCategory (TypeContent 'True) ANY IMPLEMENTABLE) =>
TypeDefinition IMPLEMENTABLE s
-> m (OrdMap TypeName (TypeDefinition IMPLEMENTABLE s))
askInterfaceTypes TypeDefinition IMPLEMENTABLE VALID
typeDef
([UnionTag]
spreads, Maybe (MergeMap 'True FieldName (Selection RAW))
selectionSet) <- forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> SelectionSet RAW
-> FragmentValidator s ([UnionTag], Maybe (SelectionSet RAW))
exploreFragments Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes SelectionSet RAW
inputSelectionSet
Maybe (MergeMap 'False FieldName (Selection VALID))
validSelectionSet <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validate TypeDefinition IMPLEMENTABLE VALID
typeDef) Maybe (MergeMap 'True FieldName (Selection RAW))
selectionSet
let tags :: HashMap TypeName [SelectionSet VALID]
tags = [UnionTag]
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> HashMap TypeName [SelectionSet VALID]
tagUnionFragments [UnionTag]
spreads OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes
Maybe (MergeMap 'False FieldName (Selection VALID))
defaultSelection <- forall (s :: Stage).
[SelectionSet VALID]
-> FragmentValidator s (Maybe (SelectionSet VALID))
maybeMerge (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (MergeMap 'False FieldName (Selection VALID))
validSelectionSet forall a. Semigroup a => a -> a -> a
<> forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr [] forall a. a -> a
id TypeName
typeName HashMap TypeName [SelectionSet VALID]
tags)
forall (s :: Stage).
Maybe (SelectionSet VALID)
-> HashMap TypeName [SelectionSet VALID]
-> FragmentValidator s (SelectionContent VALID)
joinClusters Maybe (MergeMap 'False FieldName (Selection VALID))
defaultSelection (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete TypeName
typeName HashMap TypeName [SelectionSet VALID]
tags)
mkUnionRootType :: FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)
mkUnionRootType :: forall (s :: Stage).
FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)
mkUnionRootType = (forall (a :: TypeCategory) (s :: Stage).
TypeName -> TypeContent 'True a s -> TypeDefinition a s
`mkType` forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (OBJECT <=? a) a s
DataObject [] forall coll. Empty coll => coll
empty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage) ctx (m :: * -> *) a.
MonadReader (ValidatorContext s ctx) m =>
(Scope -> a) -> m a
asksScope Scope -> TypeName
currentTypeName
validateUnionSelection ::
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID)) ->
(TypeDefinition IMPLEMENTABLE VALID -> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)) ->
UnionTypeDefinition OUT VALID ->
SelectionSet RAW ->
FragmentValidator s (SelectionContent VALID)
validateUnionSelection :: forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> (TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID))
-> UnionTypeDefinition OUT VALID
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
validateUnionSelection Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validate UnionTypeDefinition OUT VALID
members SelectionSet RAW
inputSelectionSet = do
TypeDefinition IMPLEMENTABLE VALID
typeDef <- forall (s :: Stage).
FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)
mkUnionRootType
OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) c (cat :: TypeCategory) (s :: Stage) ctx.
Constraints m c cat s ctx =>
UnionMember cat s -> m (TypeDefinition (ToOBJECT cat) s)
askTypeMember) UnionTypeDefinition OUT VALID
members
([UnionTag]
spreads, Maybe (MergeMap 'True FieldName (Selection RAW))
selectionSet) <- forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> SelectionSet RAW
-> FragmentValidator s ([UnionTag], Maybe (SelectionSet RAW))
exploreFragments Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragment OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes SelectionSet RAW
inputSelectionSet
Maybe (MergeMap 'False FieldName (Selection VALID))
validSelectionSet <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validate TypeDefinition IMPLEMENTABLE VALID
typeDef) Maybe (MergeMap 'True FieldName (Selection RAW))
selectionSet
let tags :: HashMap TypeName [SelectionSet VALID]
tags = [UnionTag]
-> OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
-> HashMap TypeName [SelectionSet VALID]
tagUnionFragments [UnionTag]
spreads OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID)
possibleTypes
forall (s :: Stage).
Maybe (SelectionSet VALID)
-> HashMap TypeName [SelectionSet VALID]
-> FragmentValidator s (SelectionContent VALID)
joinClusters Maybe (MergeMap 'False FieldName (Selection VALID))
validSelectionSet HashMap TypeName [SelectionSet VALID]
tags