{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Validation.Query.Selection
  ( validateOperation,
    validateFragmentSelection,
  )
where

import Control.Monad.Except (throwError)
import Data.Mergeable
  ( toNonEmpty,
  )
import Data.Morpheus.Error.Selection
  ( hasNoSubfields,
    subfieldsNotSelected,
  )
import Data.Morpheus.Ext.Empty (Empty (..))
import Data.Morpheus.Internal.Utils
  ( keyOf,
    mergeConcat,
    singleton,
    startHistory,
    throwErrors,
  )
import Data.Morpheus.Types.Internal.AST
  ( Arguments,
    DirectiveLocation (FIELD, FRAGMENT_SPREAD, INLINE_FRAGMENT, MUTATION, QUERY, SUBSCRIPTION),
    Directives,
    FieldDefinition (..),
    FieldName,
    FieldsDefinition,
    Fragment (..),
    FragmentName,
    GQLError,
    IMPLEMENTABLE,
    OUT,
    Operation (..),
    OperationType (..),
    RAW,
    Ref (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    UnionTag (..),
    VALID,
    at,
    isLeaf,
    mkTypeRef,
    msg,
    possibleTypes,
    toCategory,
    typed,
  )
import Data.Morpheus.Types.Internal.Validation
  ( FragmentValidator,
    SelectionValidator,
    askType,
    getOperationType,
    schema,
    selectKnown,
    setSelection,
    withScope,
  )
import Data.Morpheus.Validation.Internal.Arguments
  ( validateFieldArguments,
  )
import Data.Morpheus.Validation.Internal.Directive
  ( shouldIncludeSelection,
    validateDirectives,
  )
import Data.Morpheus.Validation.Query.Fragment
  ( ValidateFragmentSelection,
    selectFragmentType,
    validateFragment,
    validateSpread,
  )
import Data.Morpheus.Validation.Query.UnionSelection
  ( validateInterfaceSelection,
    validateUnionSelection,
  )
import Relude hiding (empty, join)

selectionsWithoutTypename :: SelectionSet VALID -> [Selection VALID]
selectionsWithoutTypename :: SelectionSet VALID -> [Selection VALID]
selectionsWithoutTypename = (Selection VALID -> Bool) -> [Selection VALID] -> [Selection VALID]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FieldName
"__typename" FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
/=) (FieldName -> Bool)
-> (Selection VALID -> FieldName) -> Selection VALID -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf) ([Selection VALID] -> [Selection VALID])
-> (MergeMap 'False FieldName (Selection VALID)
    -> [Selection VALID])
-> MergeMap 'False FieldName (Selection VALID)
-> [Selection VALID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

singleTopLevelSelection :: Operation RAW -> SelectionSet VALID -> SelectionValidator ()
singleTopLevelSelection :: Operation RAW -> SelectionSet VALID -> SelectionValidator ()
singleTopLevelSelection Operation {operationType :: forall (s :: Stage). Operation s -> OperationType
operationType = OperationType
Subscription, Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName
operationName} SelectionSet VALID
selSet =
  case SelectionSet VALID -> [Selection VALID]
selectionsWithoutTypename SelectionSet VALID
selSet of
    (Selection VALID
_ : (Selection VALID
x : [Selection VALID]
xs)) -> NonEmpty GQLError
-> Validator VALID (OperationContext VALID VALID) ()
forall e (m :: * -> *) b. MonadError e m => NonEmpty e -> m b
throwErrors (NonEmpty GQLError
 -> Validator VALID (OperationContext VALID VALID) ())
-> NonEmpty GQLError
-> Validator VALID (OperationContext VALID VALID) ()
forall a b. (a -> b) -> a -> b
$ (Selection VALID -> GQLError)
-> NonEmpty (Selection VALID) -> NonEmpty GQLError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe FieldName -> Selection VALID -> GQLError
singleTopLevelSelectionError Maybe FieldName
operationName) (Selection VALID
x Selection VALID -> [Selection VALID] -> NonEmpty (Selection VALID)
forall a. a -> [a] -> NonEmpty a
:| [Selection VALID]
xs)
    [Selection VALID]
_ -> () -> Validator VALID (OperationContext VALID VALID) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
singleTopLevelSelection Operation RAW
_ SelectionSet VALID
_ = () -> Validator VALID (OperationContext VALID VALID) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

singleTopLevelSelectionError :: Maybe FieldName -> Selection VALID -> GQLError
singleTopLevelSelectionError :: Maybe FieldName -> Selection VALID -> GQLError
singleTopLevelSelectionError Maybe FieldName
name Selection {Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition} =
  ( GQLError -> (FieldName -> GQLError) -> Maybe FieldName -> GQLError
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GQLError
"Anonymous Subscription" ((GQLError
"Subscription " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<>) (GQLError -> GQLError)
-> (FieldName -> GQLError) -> FieldName -> GQLError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg) Maybe FieldName
name
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" must select "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"only one top level field."
  )
    GQLError -> Position -> GQLError
`at` Position
selectionPosition

validateOperation ::
  Operation RAW ->
  SelectionValidator (Operation VALID)
validateOperation :: Operation RAW -> SelectionValidator (Operation VALID)
validateOperation
  rawOperation :: Operation RAW
rawOperation@Operation
    { Maybe FieldName
operationName :: Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName,
      OperationType
operationType :: OperationType
operationType :: forall (s :: Stage). Operation s -> OperationType
operationType,
      SelectionSet RAW
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection :: SelectionSet RAW
operationSelection,
      Directives RAW
operationDirectives :: forall (s :: Stage). Operation s -> Directives s
operationDirectives :: Directives RAW
operationDirectives,
      VariableDefinitions RAW
Position
operationArguments :: forall (s :: Stage). Operation s -> VariableDefinitions s
operationPosition :: forall (s :: Stage). Operation s -> Position
operationArguments :: VariableDefinitions RAW
operationPosition :: Position
..
    } =
    do
      TypeDefinition OBJECT VALID
typeDef <- Operation RAW -> SelectionValidator (TypeDefinition OBJECT VALID)
forall (a :: Stage).
Operation a -> SelectionValidator (TypeDefinition OBJECT VALID)
getOperationType Operation RAW
rawOperation
      MergeMap 'False FieldName (Selection VALID)
selection <- TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator VALID (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet (TypeDefinition OBJECT VALID -> TypeDefinition IMPLEMENTABLE VALID
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory TypeDefinition OBJECT VALID
typeDef) SelectionSet RAW
operationSelection
      Operation RAW -> SelectionSet VALID -> SelectionValidator ()
singleTopLevelSelection Operation RAW
rawOperation MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
selection
      Directives VALID
directives <-
        DirectiveLocation
-> Directives RAW
-> Validator
     VALID (OperationContext VALID VALID) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives
          (OperationType -> DirectiveLocation
toDirectiveLocation OperationType
operationType)
          Directives RAW
operationDirectives
      Operation VALID
-> Validator VALID (OperationContext VALID VALID) (Operation VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Operation VALID
 -> Validator
      VALID (OperationContext VALID VALID) (Operation VALID))
-> Operation VALID
-> Validator VALID (OperationContext VALID VALID) (Operation VALID)
forall a b. (a -> b) -> a -> b
$
        Operation :: forall (s :: Stage).
Position
-> OperationType
-> Maybe FieldName
-> VariableDefinitions s
-> Directives s
-> SelectionSet s
-> Operation s
Operation
          { Maybe FieldName
operationName :: Maybe FieldName
operationName :: Maybe FieldName
operationName,
            OperationType
operationType :: OperationType
operationType :: OperationType
operationType,
            operationArguments :: VariableDefinitions VALID
operationArguments = VariableDefinitions VALID
forall coll. Empty coll => coll
empty,
            operationSelection :: SelectionSet VALID
operationSelection = MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
selection,
            operationDirectives :: Directives VALID
operationDirectives = Directives VALID
directives,
            Position
operationPosition :: Position
operationPosition :: Position
..
          }

toDirectiveLocation :: OperationType -> DirectiveLocation
toDirectiveLocation :: OperationType -> DirectiveLocation
toDirectiveLocation OperationType
Subscription = DirectiveLocation
SUBSCRIPTION
toDirectiveLocation OperationType
Mutation = DirectiveLocation
MUTATION
toDirectiveLocation OperationType
Query = DirectiveLocation
QUERY

processSelectionDirectives ::
  DirectiveLocation ->
  Directives RAW ->
  (Directives VALID -> FragmentValidator s (SelectionSet VALID)) ->
  FragmentValidator s (Maybe (SelectionSet VALID))
processSelectionDirectives :: DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
processSelectionDirectives DirectiveLocation
location Directives RAW
rawDirectives Directives VALID -> FragmentValidator s (SelectionSet VALID)
sel = do
  Directives VALID
directives <- DirectiveLocation
-> Directives RAW
-> Validator VALID (OperationContext VALID s) (Directives VALID)
forall ctx (schemaS :: Stage) (s :: Stage).
ArgumentsConstraints ctx schemaS s =>
DirectiveLocation
-> Directives s -> Validator schemaS ctx (Directives VALID)
validateDirectives DirectiveLocation
location Directives RAW
rawDirectives
  Bool
include <- Directives VALID -> Validator VALID (OperationContext VALID s) Bool
forall (schemaS :: Stage) ctx.
Directives VALID -> Validator schemaS ctx Bool
shouldIncludeSelection Directives VALID
directives
  MergeMap 'False FieldName (Selection VALID)
selection <- Directives VALID -> FragmentValidator s (SelectionSet VALID)
sel Directives VALID
directives
  Maybe (MergeMap 'False FieldName (Selection VALID))
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MergeMap 'False FieldName (Selection VALID))
 -> Validator
      VALID
      (OperationContext VALID s)
      (Maybe (MergeMap 'False FieldName (Selection VALID))))
-> Maybe (MergeMap 'False FieldName (Selection VALID))
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
forall a b. (a -> b) -> a -> b
$
    if Bool
include
      then MergeMap 'False FieldName (Selection VALID)
-> Maybe (MergeMap 'False FieldName (Selection VALID))
forall a. a -> Maybe a
Just MergeMap 'False FieldName (Selection VALID)
selection
      else Maybe (MergeMap 'False FieldName (Selection VALID))
forall a. Maybe a
Nothing

validateFragmentSelection :: (ValidateFragmentSelection s) => Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection :: Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection f :: Fragment RAW
f@Fragment {SelectionSet RAW
fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentSelection :: SelectionSet RAW
fragmentSelection} = do
  TypeDefinition IMPLEMENTABLE VALID
typeDef <- Fragment RAW
-> FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)
forall (s :: Stage).
Fragment RAW
-> FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)
selectFragmentType Fragment RAW
f
  TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet TypeDefinition IMPLEMENTABLE VALID
typeDef SelectionSet RAW
fragmentSelection

getFields :: TypeDefinition IMPLEMENTABLE s -> FieldsDefinition OUT s
getFields :: TypeDefinition IMPLEMENTABLE s -> FieldsDefinition OUT s
getFields TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields}} = FieldsDefinition OUT s
objectFields
getFields TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface FieldsDefinition OUT s
fields} = FieldsDefinition OUT s
fields

validateSelectionSet ::
  (ValidateFragmentSelection s) =>
  TypeDefinition IMPLEMENTABLE VALID ->
  SelectionSet RAW ->
  FragmentValidator s (SelectionSet VALID)
validateSelectionSet :: TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet TypeDefinition IMPLEMENTABLE VALID
typeDef =
  (Selection RAW
 -> Validator
      VALID
      (OperationContext VALID s)
      (Maybe (MergeMap 'False FieldName (Selection VALID))))
-> [Selection RAW]
-> Validator
     VALID
     (OperationContext VALID s)
     [Maybe (MergeMap 'False FieldName (Selection VALID))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (TypeDefinition IMPLEMENTABLE VALID
-> Selection RAW
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> Selection RAW
-> FragmentValidator s (Maybe (SelectionSet VALID))
validateSelection TypeDefinition IMPLEMENTABLE VALID
typeDef) ([Selection RAW]
 -> Validator
      VALID
      (OperationContext VALID s)
      [Maybe (MergeMap 'False FieldName (Selection VALID))])
-> (MergeMap TRUE FieldName (Selection RAW) -> [Selection RAW])
-> MergeMap TRUE FieldName (Selection RAW)
-> Validator
     VALID
     (OperationContext VALID s)
     [Maybe (MergeMap 'False FieldName (Selection VALID))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MergeMap TRUE FieldName (Selection RAW) -> [Selection RAW]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (MergeMap TRUE FieldName (Selection RAW)
 -> Validator
      VALID
      (OperationContext VALID s)
      [Maybe (MergeMap 'False FieldName (Selection VALID))])
-> ([Maybe (MergeMap 'False FieldName (Selection VALID))]
    -> Validator
         VALID
         (OperationContext VALID s)
         (MergeMap 'False FieldName (Selection VALID)))
-> MergeMap TRUE FieldName (Selection RAW)
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [MergeMap 'False FieldName (Selection VALID)]
-> Validator
     VALID
     (OperationContext VALID s)
     (NonEmpty (MergeMap 'False FieldName (Selection VALID)))
forall e (f :: * -> *) a.
(IsString e, MonadError e f) =>
[a] -> f (NonEmpty a)
toNonEmpty ([MergeMap 'False FieldName (Selection VALID)]
 -> Validator
      VALID
      (OperationContext VALID s)
      (NonEmpty (MergeMap 'False FieldName (Selection VALID))))
-> ([Maybe (MergeMap 'False FieldName (Selection VALID))]
    -> [MergeMap 'False FieldName (Selection VALID)])
-> [Maybe (MergeMap 'False FieldName (Selection VALID))]
-> Validator
     VALID
     (OperationContext VALID s)
     (NonEmpty (MergeMap 'False FieldName (Selection VALID)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (MergeMap 'False FieldName (Selection VALID))]
-> [MergeMap 'False FieldName (Selection VALID)]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe (MergeMap 'False FieldName (Selection VALID))]
 -> Validator
      VALID
      (OperationContext VALID s)
      (NonEmpty (MergeMap 'False FieldName (Selection VALID))))
-> (NonEmpty (MergeMap 'False FieldName (Selection VALID))
    -> Validator
         VALID
         (OperationContext VALID s)
         (MergeMap 'False FieldName (Selection VALID)))
-> [Maybe (MergeMap 'False FieldName (Selection VALID))]
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> HistoryT
  (Validator VALID (OperationContext VALID s))
  (MergeMap 'False FieldName (Selection VALID))
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (m :: * -> *) a. HistoryT m a -> m a
startHistory (HistoryT
   (Validator VALID (OperationContext VALID s))
   (MergeMap 'False FieldName (Selection VALID))
 -> Validator
      VALID
      (OperationContext VALID s)
      (MergeMap 'False FieldName (Selection VALID)))
-> (NonEmpty (MergeMap 'False FieldName (Selection VALID))
    -> HistoryT
         (Validator VALID (OperationContext VALID s))
         (MergeMap 'False FieldName (Selection VALID)))
-> NonEmpty (MergeMap 'False FieldName (Selection VALID))
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (MergeMap 'False FieldName (Selection VALID))
-> HistoryT
     (Validator VALID (OperationContext VALID s))
     (MergeMap 'False FieldName (Selection VALID))
forall (m :: * -> *) a e.
(Monad m, Merge m a, MonadError e m) =>
NonEmpty a -> m a
mergeConcat

-- validate single selection: InlineFragments and Spreads will Be resolved and included in SelectionSet
validateSelection :: ValidateFragmentSelection s => TypeDefinition IMPLEMENTABLE VALID -> Selection RAW -> FragmentValidator s (Maybe (SelectionSet VALID))
validateSelection :: TypeDefinition IMPLEMENTABLE VALID
-> Selection RAW
-> FragmentValidator s (Maybe (SelectionSet VALID))
validateSelection TypeDefinition IMPLEMENTABLE VALID
typeDef Selection {Maybe FieldName
Directives RAW
Arguments RAW
Position
FieldName
SelectionContent RAW
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionDirectives :: forall (s :: Stage). Selection s -> Directives s
selectionArguments :: forall (s :: Stage). Selection s -> Arguments s
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName
selectionContent :: SelectionContent RAW
selectionDirectives :: Directives RAW
selectionArguments :: Arguments RAW
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionPosition :: Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
..} =
  (Scope -> Scope)
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
forall (s :: Stage) c (m :: * -> *) b.
MonadReader (ValidatorContext s c) m =>
(Scope -> Scope) -> m b -> m b
withScope (TypeDefinition IMPLEMENTABLE VALID
-> Ref FieldName -> Scope -> Scope
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Ref FieldName -> Scope -> Scope
setSelection TypeDefinition IMPLEMENTABLE VALID
typeDef Ref FieldName
selectionRef) (Validator
   VALID
   (OperationContext VALID s)
   (Maybe (MergeMap 'False FieldName (Selection VALID)))
 -> Validator
      VALID
      (OperationContext VALID s)
      (Maybe (MergeMap 'False FieldName (Selection VALID))))
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
-> Validator
     VALID
     (OperationContext VALID s)
     (Maybe (MergeMap 'False FieldName (Selection VALID)))
forall a b. (a -> b) -> a -> b
$
    DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall (s :: Stage).
DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
processSelectionDirectives DirectiveLocation
FIELD Directives RAW
selectionDirectives Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
Directives VALID -> FragmentValidator s (SelectionSet VALID)
validateContent
  where
    selectionRef :: Ref FieldName
selectionRef = FieldName -> Position -> Ref FieldName
forall name. name -> Position -> Ref name
Ref FieldName
selectionName Position
selectionPosition
    validateContent :: Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
validateContent Directives VALID
directives = do
      (Arguments VALID
validArgs, SelectionContent VALID
content) <- TypeDefinition IMPLEMENTABLE VALID
-> Ref FieldName
-> Arguments RAW
-> SelectionContent RAW
-> FragmentValidator s (Arguments VALID, SelectionContent VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> Ref FieldName
-> Arguments RAW
-> SelectionContent RAW
-> FragmentValidator s (Arguments VALID, SelectionContent VALID)
validateSelectionContent TypeDefinition IMPLEMENTABLE VALID
typeDef Ref FieldName
selectionRef Arguments RAW
selectionArguments SelectionContent RAW
selectionContent
      let selection :: Selection VALID
selection =
            Selection :: forall (s :: Stage).
Position
-> Maybe FieldName
-> FieldName
-> Arguments s
-> Directives s
-> SelectionContent s
-> Selection s
Selection
              { selectionArguments :: Arguments VALID
selectionArguments = Arguments VALID
validArgs,
                selectionDirectives :: Directives VALID
selectionDirectives = Directives VALID
directives,
                selectionContent :: SelectionContent VALID
selectionContent = SelectionContent VALID
content,
                Maybe FieldName
Position
FieldName
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionName :: FieldName
selectionAlias :: Maybe FieldName
selectionPosition :: Position
selectionPosition :: Position
..
              }
      MergeMap 'False FieldName (Selection VALID)
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MergeMap 'False FieldName (Selection VALID)
 -> Validator
      VALID
      (OperationContext VALID s)
      (MergeMap 'False FieldName (Selection VALID)))
-> MergeMap 'False FieldName (Selection VALID)
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall a b. (a -> b) -> a -> b
$ FieldName
-> Selection VALID -> MergeMap 'False FieldName (Selection VALID)
forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton (Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf Selection VALID
selection) Selection VALID
selection
validateSelection TypeDefinition IMPLEMENTABLE VALID
typeDef (Spread Directives RAW
dirs Ref FragmentName
ref) =
  DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall (s :: Stage).
DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
processSelectionDirectives DirectiveLocation
FRAGMENT_SPREAD Directives RAW
dirs
    ((Directives VALID -> FragmentValidator s (SelectionSet VALID))
 -> FragmentValidator s (Maybe (SelectionSet VALID)))
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall a b. (a -> b) -> a -> b
$ Validator
  VALID
  (OperationContext VALID s)
  (MergeMap 'False FieldName (Selection VALID))
-> Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall a b. a -> b -> a
const
    (Validator
   VALID
   (OperationContext VALID s)
   (MergeMap 'False FieldName (Selection VALID))
 -> Directives VALID
 -> Validator
      VALID
      (OperationContext VALID s)
      (MergeMap 'False FieldName (Selection VALID)))
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
-> Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall a b. (a -> b) -> a -> b
$ TypeDefinition IMPLEMENTABLE VALID
-> Ref FragmentName -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage) (a :: TypeCategory).
ValidateFragmentSelection s =>
TypeDefinition a VALID
-> Ref FragmentName -> FragmentValidator s (SelectionSet VALID)
validateSpreadSelection TypeDefinition IMPLEMENTABLE VALID
typeDef Ref FragmentName
ref
validateSelection TypeDefinition IMPLEMENTABLE VALID
typeDef (InlineFragment fragment :: Fragment RAW
fragment@Fragment {Directives RAW
fragmentDirectives :: forall (stage :: Stage). Fragment stage -> Directives stage
fragmentDirectives :: Directives RAW
fragmentDirectives}) =
  DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall (s :: Stage).
DirectiveLocation
-> Directives RAW
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
processSelectionDirectives DirectiveLocation
INLINE_FRAGMENT Directives RAW
fragmentDirectives
    ((Directives VALID -> FragmentValidator s (SelectionSet VALID))
 -> FragmentValidator s (Maybe (SelectionSet VALID)))
-> (Directives VALID -> FragmentValidator s (SelectionSet VALID))
-> FragmentValidator s (Maybe (SelectionSet VALID))
forall a b. (a -> b) -> a -> b
$ Validator
  VALID
  (OperationContext VALID s)
  (MergeMap 'False FieldName (Selection VALID))
-> Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall a b. a -> b -> a
const
    (Validator
   VALID
   (OperationContext VALID s)
   (MergeMap 'False FieldName (Selection VALID))
 -> Directives VALID
 -> Validator
      VALID
      (OperationContext VALID s)
      (MergeMap 'False FieldName (Selection VALID)))
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
-> Directives VALID
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall a b. (a -> b) -> a -> b
$ TypeDefinition IMPLEMENTABLE VALID
-> Fragment RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateInlineFragmentSelection TypeDefinition IMPLEMENTABLE VALID
typeDef Fragment RAW
fragment

validateSpreadSelection ::
  ValidateFragmentSelection s =>
  TypeDefinition a VALID ->
  Ref FragmentName ->
  FragmentValidator s (SelectionSet VALID)
validateSpreadSelection :: TypeDefinition a VALID
-> Ref FragmentName -> FragmentValidator s (SelectionSet VALID)
validateSpreadSelection TypeDefinition a VALID
typeDef Ref FragmentName
ref = do
  [TypeName]
types <- TypeDefinition a VALID -> Schema VALID -> [TypeName]
forall (a :: TypeCategory) (s :: Stage) (s' :: Stage).
TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes TypeDefinition a VALID
typeDef (Schema VALID -> [TypeName])
-> Validator VALID (OperationContext VALID s) (Schema VALID)
-> Validator VALID (OperationContext VALID s) [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValidatorContext VALID (OperationContext VALID s) -> Schema VALID)
-> Validator VALID (OperationContext VALID s) (Schema VALID)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidatorContext VALID (OperationContext VALID s) -> Schema VALID
forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
schema
  UnionTag -> MergeMap 'False FieldName (Selection VALID)
UnionTag -> SelectionSet VALID
unionTagSelection (UnionTag -> MergeMap 'False FieldName (Selection VALID))
-> Validator VALID (OperationContext VALID s) UnionTag
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeName]
-> Ref FragmentName
-> Validator VALID (OperationContext VALID s) UnionTag
forall (s :: Stage).
ValidateFragmentSelection s =>
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeName] -> Ref FragmentName -> FragmentValidator s UnionTag
validateSpread Fragment RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection [TypeName]
types Ref FragmentName
ref

validateInlineFragmentSelection ::
  ValidateFragmentSelection s =>
  TypeDefinition IMPLEMENTABLE VALID ->
  Fragment RAW ->
  FragmentValidator s (SelectionSet VALID)
validateInlineFragmentSelection :: TypeDefinition IMPLEMENTABLE VALID
-> Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateInlineFragmentSelection TypeDefinition IMPLEMENTABLE VALID
typeDef Fragment RAW
x = do
  [TypeName]
types <- TypeDefinition IMPLEMENTABLE VALID -> Schema VALID -> [TypeName]
forall (a :: TypeCategory) (s :: Stage) (s' :: Stage).
TypeDefinition a s -> Schema s' -> [TypeName]
possibleTypes TypeDefinition IMPLEMENTABLE VALID
typeDef (Schema VALID -> [TypeName])
-> Validator VALID (OperationContext VALID s) (Schema VALID)
-> Validator VALID (OperationContext VALID s) [TypeName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValidatorContext VALID (OperationContext VALID s) -> Schema VALID)
-> Validator VALID (OperationContext VALID s) (Schema VALID)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ValidatorContext VALID (OperationContext VALID s) -> Schema VALID
forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
schema
  Fragment VALID -> MergeMap 'False FieldName (Selection VALID)
forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentSelection (Fragment VALID -> MergeMap 'False FieldName (Selection VALID))
-> Validator VALID (OperationContext VALID s) (Fragment VALID)
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeName]
-> Fragment RAW
-> Validator VALID (OperationContext VALID s) (Fragment VALID)
forall (s :: Stage).
(Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> [TypeName]
-> Fragment RAW
-> FragmentValidator s (Fragment VALID)
validateFragment Fragment RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection [TypeName]
types Fragment RAW
x

selectSelectionField ::
  Ref FieldName ->
  TypeDefinition IMPLEMENTABLE s ->
  FragmentValidator s' (FieldDefinition OUT s)
selectSelectionField :: Ref FieldName
-> TypeDefinition IMPLEMENTABLE s
-> FragmentValidator s' (FieldDefinition OUT s)
selectSelectionField Ref FieldName
ref TypeDefinition IMPLEMENTABLE s
typeDef
  | Ref FieldName -> FieldName
forall name. Ref name -> name
refName Ref FieldName
ref FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" =
    FieldDefinition OUT s
-> FragmentValidator s' (FieldDefinition OUT s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
        { fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
          fieldName :: FieldName
fieldName = FieldName
"__typename",
          fieldType :: TypeRef
fieldType = TypeName -> TypeRef
mkTypeRef TypeName
"String",
          fieldContent :: Maybe (FieldContent TRUE OUT s)
fieldContent = Maybe (FieldContent TRUE OUT s)
forall a. Maybe a
Nothing,
          fieldDirectives :: Directives s
fieldDirectives = Directives s
forall coll. Empty coll => coll
empty
        }
  | Bool
otherwise = Ref FieldName
-> OrdMap FieldName (FieldDefinition OUT s)
-> FragmentValidator s' (FieldDefinition OUT s)
forall k (c :: * -> *) sel ctx a (s :: Stage).
(IsMap k c, Unknown sel ctx, KeyOf k sel) =>
sel -> c a -> Validator s ctx a
selectKnown Ref FieldName
ref (TypeDefinition IMPLEMENTABLE s
-> OrdMap FieldName (FieldDefinition OUT s)
forall (s :: Stage).
TypeDefinition IMPLEMENTABLE s -> FieldsDefinition OUT s
getFields TypeDefinition IMPLEMENTABLE s
typeDef)

validateSelectionContent ::
  forall s.
  ValidateFragmentSelection s =>
  TypeDefinition IMPLEMENTABLE VALID ->
  Ref FieldName ->
  Arguments RAW ->
  SelectionContent RAW ->
  FragmentValidator s (Arguments VALID, SelectionContent VALID)
validateSelectionContent :: TypeDefinition IMPLEMENTABLE VALID
-> Ref FieldName
-> Arguments RAW
-> SelectionContent RAW
-> FragmentValidator s (Arguments VALID, SelectionContent VALID)
validateSelectionContent TypeDefinition IMPLEMENTABLE VALID
typeDef Ref FieldName
ref Arguments RAW
selectionArguments SelectionContent RAW
content = do
  FieldDefinition OUT VALID
fieldDef <- Ref FieldName
-> TypeDefinition IMPLEMENTABLE VALID
-> FragmentValidator s (FieldDefinition OUT VALID)
forall (s :: Stage) (s' :: Stage).
Ref FieldName
-> TypeDefinition IMPLEMENTABLE s
-> FragmentValidator s' (FieldDefinition OUT s)
selectSelectionField Ref FieldName
ref TypeDefinition IMPLEMENTABLE VALID
typeDef
  TypeDefinition OUT VALID
fieldTypeDef <- Typed OUT VALID TypeRef
-> Validator
     VALID (OperationContext VALID s) (TypeDefinition OUT VALID)
forall (m :: * -> *) c (cat :: TypeCategory) (s :: Stage) ctx.
Constraints m c cat s ctx =>
Typed cat s TypeRef -> m (TypeDefinition cat s)
askType ((FieldDefinition OUT VALID -> TypeRef)
-> FieldDefinition OUT VALID -> Typed OUT VALID TypeRef
forall (a :: TypeCategory -> Stage -> *) (c :: TypeCategory)
       (s :: Stage) b.
(a c s -> b) -> a c s -> Typed c s b
typed FieldDefinition OUT VALID -> TypeRef
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType FieldDefinition OUT VALID
fieldDef)
  Arguments VALID
validArgs <- FieldDefinition OUT VALID
-> Arguments RAW -> FragmentValidator s (Arguments VALID)
forall (s :: Stage).
FieldDefinition OUT VALID
-> Arguments RAW -> FragmentValidator s (Arguments VALID)
validateFieldArguments FieldDefinition OUT VALID
fieldDef Arguments RAW
selectionArguments
  SelectionContent VALID
validContent <- TypeDefinition OUT VALID
-> SelectionContent RAW
-> FragmentValidator s (SelectionContent VALID)
validateContent TypeDefinition OUT VALID
fieldTypeDef SelectionContent RAW
content
  (Arguments VALID, SelectionContent VALID)
-> FragmentValidator s (Arguments VALID, SelectionContent VALID)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments VALID
validArgs, SelectionContent VALID
validContent)
  where
    validateContent :: TypeDefinition OUT VALID
-> SelectionContent RAW
-> FragmentValidator s (SelectionContent VALID)
validateContent TypeDefinition OUT VALID
fieldTypeDef SelectionContent RAW
SelectionField = Ref FieldName
-> TypeDefinition OUT VALID
-> FragmentValidator s (SelectionContent VALID)
forall (s' :: Stage) (s :: Stage).
Ref FieldName
-> TypeDefinition OUT VALID
-> FragmentValidator s' (SelectionContent s)
validateContentLeaf Ref FieldName
ref TypeDefinition OUT VALID
fieldTypeDef
    validateContent TypeDefinition OUT VALID
fieldTypeDef (SelectionSet SelectionSet RAW
rawSelectionSet) = TypeDefinition OUT VALID
-> Ref FieldName
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition OUT VALID
-> Ref FieldName
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
validateByTypeContent TypeDefinition OUT VALID
fieldTypeDef Ref FieldName
ref SelectionSet RAW
rawSelectionSet

validateContentLeaf ::
  Ref FieldName ->
  TypeDefinition OUT VALID ->
  FragmentValidator s' (SelectionContent s)
validateContentLeaf :: Ref FieldName
-> TypeDefinition OUT VALID
-> FragmentValidator s' (SelectionContent s)
validateContentLeaf
  (Ref FieldName
selectionName Position
selectionPosition)
  TypeDefinition {TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName :: TypeName
typeName, TypeContent TRUE OUT VALID
typeContent :: TypeContent TRUE OUT VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent}
    | TypeContent TRUE OUT VALID -> Bool
forall (a :: TypeCategory) (s :: Stage).
TypeContent TRUE a s -> Bool
isLeaf TypeContent TRUE OUT VALID
typeContent = SelectionContent s -> FragmentValidator s' (SelectionContent s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionContent s
forall (s :: Stage). SelectionContent s
SelectionField
    | Bool
otherwise =
      GQLError -> FragmentValidator s' (SelectionContent s)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> FragmentValidator s' (SelectionContent s))
-> GQLError -> FragmentValidator s' (SelectionContent s)
forall a b. (a -> b) -> a -> b
$ FieldName -> TypeName -> Position -> GQLError
subfieldsNotSelected FieldName
selectionName TypeName
typeName Position
selectionPosition

validateByTypeContent ::
  forall s.
  (ValidateFragmentSelection s) =>
  TypeDefinition OUT VALID ->
  Ref FieldName ->
  SelectionSet RAW ->
  FragmentValidator s (SelectionContent VALID)
validateByTypeContent :: TypeDefinition OUT VALID
-> Ref FieldName
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
validateByTypeContent
  typeDef :: TypeDefinition OUT VALID
typeDef@TypeDefinition {TypeContent TRUE OUT VALID
typeContent :: TypeContent TRUE OUT VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent, Maybe Description
Directives VALID
TypeName
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDirectives :: Directives VALID
typeName :: TypeName
typeDescription :: Maybe Description
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
..}
  Ref FieldName
currentSelectionRef =
    (Scope -> Scope)
-> FragmentValidator s (SelectionContent VALID)
-> FragmentValidator s (SelectionContent VALID)
forall (s :: Stage) c (m :: * -> *) b.
MonadReader (ValidatorContext s c) m =>
(Scope -> Scope) -> m b -> m b
withScope (TypeDefinition OUT VALID -> Ref FieldName -> Scope -> Scope
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Ref FieldName -> Scope -> Scope
setSelection TypeDefinition OUT VALID
typeDef Ref FieldName
currentSelectionRef)
      (FragmentValidator s (SelectionContent VALID)
 -> FragmentValidator s (SelectionContent VALID))
-> (MergeMap TRUE FieldName (Selection RAW)
    -> FragmentValidator s (SelectionContent VALID))
-> MergeMap TRUE FieldName (Selection RAW)
-> FragmentValidator s (SelectionContent VALID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeContent TRUE OUT VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionContent VALID)
__validate TypeContent TRUE OUT VALID
typeContent
    where
      __validate ::
        TypeContent TRUE OUT VALID ->
        SelectionSet RAW ->
        FragmentValidator s (SelectionContent VALID)
      -- Validate UnionSelection
      __validate :: TypeContent TRUE OUT VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionContent VALID)
__validate DataUnion {UnionTypeDefinition OUT VALID
unionMembers :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OUT a s -> UnionTypeDefinition OUT s
unionMembers :: UnionTypeDefinition OUT VALID
unionMembers} =
        (Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> (TypeDefinition IMPLEMENTABLE VALID
    -> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID))
-> UnionTypeDefinition OUT VALID
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
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)
forall (s :: Stage).
ValidateFragmentSelection s =>
Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection
          TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet
          UnionTypeDefinition OUT VALID
unionMembers
      -- Validate Regular selection set
      __validate DataObject {[TypeName]
FieldsDefinition OUT VALID
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> [TypeName]
objectFields :: FieldsDefinition OUT VALID
objectImplements :: [TypeName]
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
..} =
        (MergeMap 'False FieldName (Selection VALID)
 -> SelectionContent VALID)
-> Validator
     VALID
     (OperationContext VALID s)
     (MergeMap 'False FieldName (Selection VALID))
-> FragmentValidator s (SelectionContent VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MergeMap 'False FieldName (Selection VALID)
-> SelectionContent VALID
forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet (Validator
   VALID
   (OperationContext VALID s)
   (MergeMap 'False FieldName (Selection VALID))
 -> FragmentValidator s (SelectionContent VALID))
-> (MergeMap TRUE FieldName (Selection RAW)
    -> Validator
         VALID
         (OperationContext VALID s)
         (MergeMap 'False FieldName (Selection VALID)))
-> MergeMap TRUE FieldName (Selection RAW)
-> FragmentValidator s (SelectionContent VALID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet (TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE IMPLEMENTABLE VALID
typeContent = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName] -> FieldsDefinition OUT s -> CondTypeContent OBJECT a s
DataObject {[TypeName]
FieldsDefinition OUT VALID
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT VALID
objectImplements :: [TypeName]
objectFields :: FieldsDefinition OUT VALID
..}, Maybe Description
Directives VALID
TypeName
typeDirectives :: Directives VALID
typeDescription :: Maybe Description
typeDirectives :: Directives VALID
typeName :: TypeName
typeDescription :: Maybe Description
typeName :: TypeName
..})
      -- TODO: Union Like Validation
      __validate DataInterface {FieldsDefinition OUT VALID
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT VALID
..} =
        (Fragment RAW -> FragmentValidator s (SelectionSet VALID))
-> (TypeDefinition IMPLEMENTABLE VALID
    -> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID))
-> TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW
-> FragmentValidator s (SelectionContent VALID)
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)
forall (s :: Stage).
ValidateFragmentSelection s =>
Fragment RAW -> FragmentValidator s (SelectionSet VALID)
validateFragmentSelection
          TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
forall (s :: Stage).
ValidateFragmentSelection s =>
TypeDefinition IMPLEMENTABLE VALID
-> SelectionSet RAW -> FragmentValidator s (SelectionSet VALID)
validateSelectionSet
          (TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE IMPLEMENTABLE VALID
typeContent = DataInterface :: forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> CondTypeContent IMPLEMENTABLE a s
DataInterface {FieldsDefinition OUT VALID
interfaceFields :: FieldsDefinition OUT VALID
interfaceFields :: FieldsDefinition OUT VALID
..}, Maybe Description
Directives VALID
TypeName
typeDirectives :: Directives VALID
typeDescription :: Maybe Description
typeDirectives :: Directives VALID
typeName :: TypeName
typeDescription :: Maybe Description
typeName :: TypeName
..})
      __validate TypeContent TRUE OUT VALID
_ =
        FragmentValidator s (SelectionContent VALID)
-> MergeMap TRUE FieldName (Selection RAW)
-> FragmentValidator s (SelectionContent VALID)
forall a b. a -> b -> a
const
          (FragmentValidator s (SelectionContent VALID)
 -> MergeMap TRUE FieldName (Selection RAW)
 -> FragmentValidator s (SelectionContent VALID))
-> FragmentValidator s (SelectionContent VALID)
-> MergeMap TRUE FieldName (Selection RAW)
-> FragmentValidator s (SelectionContent VALID)
forall a b. (a -> b) -> a -> b
$ GQLError -> FragmentValidator s (SelectionContent VALID)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
          (GQLError -> FragmentValidator s (SelectionContent VALID))
-> GQLError -> FragmentValidator s (SelectionContent VALID)
forall a b. (a -> b) -> a -> b
$ Ref FieldName -> TypeDefinition OUT VALID -> GQLError
forall (s :: TypeCategory).
Ref FieldName -> TypeDefinition s VALID -> GQLError
hasNoSubfields
            Ref FieldName
currentSelectionRef
            TypeDefinition OUT VALID
typeDef