{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Validation.Query.Variable
  ( resolveOperationVariables,
  )
where

import Control.Monad.Except (throwError)
import Data.Mergeable
import Data.Morpheus.Error.Variable (uninitializedVariable)
import Data.Morpheus.Internal.Utils
  ( selectOr,
  )
import Data.Morpheus.Types.Internal.AST
  ( Argument (..),
    DefaultValue,
    Directive (..),
    FieldName,
    Fragment (..),
    IN,
    ObjectEntry (..),
    Operation (..),
    Position,
    RAW,
    RawValue,
    Ref (..),
    ResolvedValue,
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeDefinition,
    TypeRef (..),
    VALID,
    ValidValue,
    Value (..),
    Variable (..),
    VariableContent (..),
    VariableDefinitions,
    Variables,
    isNullable,
  )
import Data.Morpheus.Types.Internal.Config
  ( Config (..),
    VALIDATION_MODE (..),
  )
import Data.Morpheus.Types.Internal.Validation
  ( BaseValidator,
    Constraint (..),
    InputSource (..),
    askFragments,
    askTypeDefinitions,
    checkUnused,
    constraint,
    selectKnown,
    setPosition,
    startInput,
    withScope,
  )
import Data.Morpheus.Validation.Internal.Value
  ( validateInputByType,
  )
import Relude

class ExploreRefs a where
  exploreRefs :: a -> [Ref FieldName]

instance ExploreRefs RawValue where
  exploreRefs :: RawValue -> [Ref FieldName]
exploreRefs (VariableValue Ref FieldName
ref) = [Ref FieldName
ref]
  exploreRefs (Object Object RAW
fields) = (ObjectEntry RAW -> [Ref FieldName])
-> Object RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RawValue -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs (RawValue -> [Ref FieldName])
-> (ObjectEntry RAW -> RawValue)
-> ObjectEntry RAW
-> [Ref FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectEntry RAW -> RawValue
forall (s :: Stage). ObjectEntry s -> Value s
entryValue) Object RAW
fields
  exploreRefs (List [RawValue]
ls) = (RawValue -> [Ref FieldName]) -> [RawValue] -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RawValue -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs [RawValue]
ls
  exploreRefs RawValue
_ = []

instance ExploreRefs (Directive RAW) where
  exploreRefs :: Directive RAW -> [Ref FieldName]
exploreRefs Directive {Arguments RAW
directiveArgs :: Arguments RAW
directiveArgs :: forall (s :: Stage). Directive s -> Arguments s
directiveArgs} = (Argument RAW -> [Ref FieldName])
-> Arguments RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Argument RAW -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs Arguments RAW
directiveArgs

instance ExploreRefs (Argument RAW) where
  exploreRefs :: Argument RAW -> [Ref FieldName]
exploreRefs = RawValue -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs (RawValue -> [Ref FieldName])
-> (Argument RAW -> RawValue) -> Argument RAW -> [Ref FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument RAW -> RawValue
forall (valid :: Stage). Argument valid -> Value valid
argumentValue

mapSelection :: (Selection RAW -> BaseValidator [b]) -> SelectionSet RAW -> BaseValidator [b]
mapSelection :: forall b.
(Selection RAW -> BaseValidator [b])
-> SelectionSet RAW -> BaseValidator [b]
mapSelection Selection RAW -> BaseValidator [b]
f = (MergeMap 'True FieldName [b] -> [b])
-> Validator
     VALID (OperationContext RAW RAW) (MergeMap 'True FieldName [b])
-> Validator VALID (OperationContext RAW RAW) [b]
forall a b.
(a -> b)
-> Validator VALID (OperationContext RAW RAW) a
-> Validator VALID (OperationContext RAW RAW) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MergeMap 'True FieldName [b] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Validator
   VALID (OperationContext RAW RAW) (MergeMap 'True FieldName [b])
 -> Validator VALID (OperationContext RAW RAW) [b])
-> (MergeMap 'True FieldName (Selection RAW)
    -> Validator
         VALID (OperationContext RAW RAW) (MergeMap 'True FieldName [b]))
-> MergeMap 'True FieldName (Selection RAW)
-> Validator VALID (OperationContext RAW RAW) [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selection RAW -> Validator VALID (OperationContext RAW RAW) [b])
-> MergeMap 'True FieldName (Selection RAW)
-> Validator
     VALID (OperationContext RAW RAW) (MergeMap 'True FieldName [b])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> MergeMap 'True FieldName a -> f (MergeMap 'True FieldName b)
traverse Selection RAW -> BaseValidator [b]
Selection RAW -> Validator VALID (OperationContext RAW RAW) [b]
f

allVariableRefs :: [SelectionSet RAW] -> BaseValidator (HashMap FieldName [Position])
allVariableRefs :: [SelectionSet RAW] -> BaseValidator (HashMap FieldName [Position])
allVariableRefs = [(FieldName, [Position])]
-> Validator
     VALID (OperationContext RAW RAW) (HashMap FieldName [Position])
forall k (m :: * -> *) v.
(Eq k, Hashable k, Monad m, Semigroup v) =>
[(k, v)] -> m (HashMap k v)
collect ([(FieldName, [Position])]
 -> Validator
      VALID (OperationContext RAW RAW) (HashMap FieldName [Position]))
-> ([MergeMap 'True FieldName (Selection RAW)]
    -> Validator
         VALID (OperationContext RAW RAW) [(FieldName, [Position])])
-> [MergeMap 'True FieldName (Selection RAW)]
-> Validator
     VALID (OperationContext RAW RAW) (HashMap FieldName [Position])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ([[Ref FieldName]] -> [(FieldName, [Position])])
-> Validator VALID (OperationContext RAW RAW) [[Ref FieldName]]
-> Validator
     VALID (OperationContext RAW RAW) [(FieldName, [Position])]
forall a b.
(a -> b)
-> Validator VALID (OperationContext RAW RAW) a
-> Validator VALID (OperationContext RAW RAW) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ref FieldName -> (FieldName, [Position]))
-> [Ref FieldName] -> [(FieldName, [Position])]
forall a b. (a -> b) -> [a] -> [b]
map Ref FieldName -> (FieldName, [Position])
forall {a}. Ref a -> (a, [Position])
toEntry ([Ref FieldName] -> [(FieldName, [Position])])
-> ([[Ref FieldName]] -> [Ref FieldName])
-> [[Ref FieldName]]
-> [(FieldName, [Position])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Ref FieldName]] -> [Ref FieldName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (Validator VALID (OperationContext RAW RAW) [[Ref FieldName]]
 -> Validator
      VALID (OperationContext RAW RAW) [(FieldName, [Position])])
-> ([MergeMap 'True FieldName (Selection RAW)]
    -> Validator VALID (OperationContext RAW RAW) [[Ref FieldName]])
-> [MergeMap 'True FieldName (Selection RAW)]
-> Validator
     VALID (OperationContext RAW RAW) [(FieldName, [Position])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MergeMap 'True FieldName (Selection RAW)
 -> Validator VALID (OperationContext RAW RAW) [Ref FieldName])
-> [MergeMap 'True FieldName (Selection RAW)]
-> Validator VALID (OperationContext RAW RAW) [[Ref FieldName]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Selection RAW -> BaseValidator [Ref FieldName])
-> SelectionSet RAW -> BaseValidator [Ref FieldName]
forall b.
(Selection RAW -> BaseValidator [b])
-> SelectionSet RAW -> BaseValidator [b]
mapSelection Selection RAW -> BaseValidator [Ref FieldName]
searchRefs)
  where
    toEntry :: Ref a -> (a, [Position])
toEntry (Ref a
x Position
y) = (a
x, [Position
y])
    exploreSelectionContent :: SelectionContent RAW -> BaseValidator [Ref FieldName]
    exploreSelectionContent :: SelectionContent RAW -> BaseValidator [Ref FieldName]
exploreSelectionContent SelectionContent RAW
SelectionField = [Ref FieldName]
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall a. a -> Validator VALID (OperationContext RAW RAW) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    exploreSelectionContent (SelectionSet SelectionSet RAW
selSet) = (Selection RAW -> BaseValidator [Ref FieldName])
-> SelectionSet RAW -> BaseValidator [Ref FieldName]
forall b.
(Selection RAW -> BaseValidator [b])
-> SelectionSet RAW -> BaseValidator [b]
mapSelection Selection RAW -> BaseValidator [Ref FieldName]
searchRefs SelectionSet RAW
selSet
    ---------------------------------------
    searchRefs :: Selection RAW -> BaseValidator [Ref FieldName]
    searchRefs :: Selection RAW -> BaseValidator [Ref FieldName]
searchRefs Selection {Arguments RAW
selectionArguments :: Arguments RAW
selectionArguments :: forall (s :: Stage). Selection s -> Arguments s
selectionArguments, Directives RAW
selectionDirectives :: Directives RAW
selectionDirectives :: forall (s :: Stage). Selection s -> Directives s
selectionDirectives, SelectionContent RAW
selectionContent :: SelectionContent RAW
selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent} =
      (([Ref FieldName]
directiveRefs [Ref FieldName] -> [Ref FieldName] -> [Ref FieldName]
forall a. Semigroup a => a -> a -> a
<> [Ref FieldName]
argumentRefs) [Ref FieldName] -> [Ref FieldName] -> [Ref FieldName]
forall a. Semigroup a => a -> a -> a
<>) ([Ref FieldName] -> [Ref FieldName])
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionContent RAW -> BaseValidator [Ref FieldName]
exploreSelectionContent SelectionContent RAW
selectionContent
      where
        directiveRefs :: [Ref FieldName]
directiveRefs = (Directive RAW -> [Ref FieldName])
-> Directives RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Directive RAW -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs Directives RAW
selectionDirectives
        argumentRefs :: [Ref FieldName]
argumentRefs = (Argument RAW -> [Ref FieldName])
-> Arguments RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Argument RAW -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs Arguments RAW
selectionArguments
    searchRefs (InlineFragment Fragment {SelectionSet RAW
fragmentSelection :: SelectionSet RAW
fragmentSelection :: forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentSelection, Directives RAW
fragmentDirectives :: Directives RAW
fragmentDirectives :: forall (stage :: Stage). Fragment stage -> Directives stage
fragmentDirectives}) =
      ((Directive RAW -> [Ref FieldName])
-> Directives RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Directive RAW -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs Directives RAW
fragmentDirectives [Ref FieldName] -> [Ref FieldName] -> [Ref FieldName]
forall a. Semigroup a => a -> a -> a
<>)
        ([Ref FieldName] -> [Ref FieldName])
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection RAW -> BaseValidator [Ref FieldName])
-> SelectionSet RAW -> BaseValidator [Ref FieldName]
forall b.
(Selection RAW -> BaseValidator [b])
-> SelectionSet RAW -> BaseValidator [b]
mapSelection Selection RAW -> BaseValidator [Ref FieldName]
searchRefs SelectionSet RAW
fragmentSelection
    searchRefs (Spread Directives RAW
directives Ref (Name 'FRAGMENT)
reference) =
      ((Directive RAW -> [Ref FieldName])
-> Directives RAW -> [Ref FieldName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Directive RAW -> [Ref FieldName]
forall a. ExploreRefs a => a -> [Ref FieldName]
exploreRefs Directives RAW
directives [Ref FieldName] -> [Ref FieldName] -> [Ref FieldName]
forall a. Semigroup a => a -> a -> a
<>)
        ([Ref FieldName] -> [Ref FieldName])
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Validator VALID (OperationContext RAW RAW) (Fragments RAW)
forall (s1 :: Stage) (s2 :: Stage) (s3 :: Stage) (m :: * -> *).
MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m =>
m (Fragments s3)
askFragments
                Validator VALID (OperationContext RAW RAW) (Fragments RAW)
-> (Fragments RAW
    -> Validator VALID (OperationContext RAW RAW) (Fragment RAW))
-> Validator VALID (OperationContext RAW RAW) (Fragment RAW)
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> (a -> Validator VALID (OperationContext RAW RAW) b)
-> Validator VALID (OperationContext RAW RAW) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref (Name 'FRAGMENT)
-> Fragments RAW
-> Validator VALID (OperationContext RAW RAW) (Fragment RAW)
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 (Name 'FRAGMENT)
reference
                Validator VALID (OperationContext RAW RAW) (Fragment RAW)
-> (Fragment RAW
    -> Validator VALID (OperationContext RAW RAW) [Ref FieldName])
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> (a -> Validator VALID (OperationContext RAW RAW) b)
-> Validator VALID (OperationContext RAW RAW) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Selection RAW -> BaseValidator [Ref FieldName])
-> SelectionSet RAW -> BaseValidator [Ref FieldName]
forall b.
(Selection RAW -> BaseValidator [b])
-> SelectionSet RAW -> BaseValidator [b]
mapSelection Selection RAW -> BaseValidator [Ref FieldName]
searchRefs
                  (MergeMap 'True FieldName (Selection RAW)
 -> Validator VALID (OperationContext RAW RAW) [Ref FieldName])
-> (Fragment RAW -> MergeMap 'True FieldName (Selection RAW))
-> Fragment RAW
-> Validator VALID (OperationContext RAW RAW) [Ref FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fragment RAW -> MergeMap 'True FieldName (Selection RAW)
Fragment RAW -> SelectionSet RAW
forall (stage :: Stage). Fragment stage -> SelectionSet stage
fragmentSelection
            )

resolveOperationVariables ::
  Config ->
  Variables ->
  Operation RAW ->
  BaseValidator (VariableDefinitions VALID)
resolveOperationVariables :: Config
-> Variables
-> Operation RAW
-> BaseValidator (VariableDefinitions VALID)
resolveOperationVariables
  Config {VALIDATION_MODE
validationMode :: VALIDATION_MODE
validationMode :: Config -> VALIDATION_MODE
validationMode}
  Variables
root
  Operation
    { SelectionSet RAW
operationSelection :: SelectionSet RAW
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection,
      VariableDefinitions RAW
operationArguments :: VariableDefinitions RAW
operationArguments :: forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments
    } =
    BaseValidator ()
Validator VALID (OperationContext RAW RAW) ()
checkUnusedVariables
      Validator VALID (OperationContext RAW RAW) ()
-> Validator
     VALID (OperationContext RAW RAW) (VariableDefinitions VALID)
-> Validator
     VALID (OperationContext RAW RAW) (VariableDefinitions VALID)
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> Validator VALID (OperationContext RAW RAW) b
-> Validator VALID (OperationContext RAW RAW) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Variable RAW
 -> Validator VALID (OperationContext RAW RAW) (Variable VALID))
-> VariableDefinitions RAW
-> Validator
     VALID (OperationContext RAW RAW) (VariableDefinitions VALID)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> OrdMap FieldName a -> f (OrdMap FieldName b)
traverse (Variables
-> VALIDATION_MODE
-> Variable RAW
-> BaseValidator (Variable VALID)
lookupAndValidateValueOnBody Variables
root VALIDATION_MODE
validationMode) VariableDefinitions RAW
operationArguments
    where
      checkUnusedVariables :: BaseValidator ()
      checkUnusedVariables :: BaseValidator ()
checkUnusedVariables = do
        HashMap FieldName [Position]
uses <- [SelectionSet RAW] -> BaseValidator (HashMap FieldName [Position])
allVariableRefs [SelectionSet RAW
operationSelection]
        HashMap FieldName [Position]
-> [Variable RAW] -> Validator VALID (OperationContext RAW RAW) ()
forall k b (c :: * -> *) (t :: * -> *) a (s :: Stage) (s1 :: Stage)
       (s2 :: Stage).
(KeyOf k b, IsMap k c, Unused b, Foldable t) =>
c a -> t b -> Validator s (OperationContext s1 s2) ()
checkUnused HashMap FieldName [Position]
uses (VariableDefinitions RAW -> [Variable RAW]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList VariableDefinitions RAW
operationArguments)

lookupAndValidateValueOnBody ::
  Variables ->
  VALIDATION_MODE ->
  Variable RAW ->
  BaseValidator (Variable VALID)
lookupAndValidateValueOnBody :: Variables
-> VALIDATION_MODE
-> Variable RAW
-> BaseValidator (Variable VALID)
lookupAndValidateValueOnBody
  Variables
bodyVariables
  VALIDATION_MODE
validationMode
  var :: Variable RAW
var@Variable
    { FieldName
variableName :: FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName,
      variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType = variableType :: TypeRef
variableType@TypeRef {TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers, TypeName
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeConName},
      Position
variablePosition :: Position
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variablePosition,
      variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = DefaultValue Maybe ResolvedValue
defaultValue
    } =
    (Scope -> Scope)
-> BaseValidator (Variable VALID) -> BaseValidator (Variable VALID)
forall (s :: Stage) c (m :: * -> *) b.
MonadReader (ValidatorContext s c) m =>
(Scope -> Scope) -> m b -> m b
withScope (Position -> Scope -> Scope
setPosition Position
variablePosition) (BaseValidator (Variable VALID) -> BaseValidator (Variable VALID))
-> BaseValidator (Variable VALID) -> BaseValidator (Variable VALID)
forall a b. (a -> b) -> a -> b
$
      ValidValue -> Variable VALID
toVariable
        (ValidValue -> Variable VALID)
-> Validator VALID (OperationContext RAW RAW) ValidValue
-> Validator VALID (OperationContext RAW RAW) (Variable VALID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Validator
  VALID
  (OperationContext RAW RAW)
  (HashMap TypeName (TypeDefinition ANY VALID))
forall (s :: Stage) ctx (m :: * -> *).
MonadReader (ValidatorContext s ctx) m =>
m (HashMap TypeName (TypeDefinition ANY s))
askTypeDefinitions
                Validator
  VALID
  (OperationContext RAW RAW)
  (HashMap TypeName (TypeDefinition ANY VALID))
-> (HashMap TypeName (TypeDefinition ANY VALID)
    -> Validator
         VALID (OperationContext RAW RAW) (TypeDefinition ANY VALID))
-> Validator
     VALID (OperationContext RAW RAW) (TypeDefinition ANY VALID)
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> (a -> Validator VALID (OperationContext RAW RAW) b)
-> Validator VALID (OperationContext RAW RAW) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ref TypeName
-> HashMap TypeName (TypeDefinition ANY VALID)
-> Validator
     VALID (OperationContext RAW RAW) (TypeDefinition ANY VALID)
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 (TypeName -> Position -> Ref TypeName
forall name. name -> Position -> Ref name
Ref TypeName
typeConName Position
variablePosition)
                Validator
  VALID (OperationContext RAW RAW) (TypeDefinition ANY VALID)
-> (TypeDefinition ANY VALID
    -> Validator
         VALID (OperationContext RAW RAW) (TypeDefinition 'IN VALID))
-> Validator
     VALID (OperationContext RAW RAW) (TypeDefinition 'IN VALID)
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> (a -> Validator VALID (OperationContext RAW RAW) b)
-> Validator VALID (OperationContext RAW RAW) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Constraint 'IN
-> Variable RAW
-> TypeDefinition ANY VALID
-> Validator
     VALID (OperationContext RAW RAW) (TypeDefinition 'IN VALID)
forall (k :: TypeCategory) inp (s :: Stage) ctx.
KindViolation k inp =>
Constraint k
-> inp
-> TypeDefinition ANY s
-> Validator s ctx (TypeDefinition k s)
constraint Constraint 'IN
INPUT Variable RAW
var
                Validator
  VALID (OperationContext RAW RAW) (TypeDefinition 'IN VALID)
-> (TypeDefinition 'IN VALID
    -> Validator VALID (OperationContext RAW RAW) ValidValue)
-> Validator VALID (OperationContext RAW RAW) ValidValue
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> (a -> Validator VALID (OperationContext RAW RAW) b)
-> Validator VALID (OperationContext RAW RAW) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ResolvedValue
-> Maybe ResolvedValue
-> TypeDefinition 'IN VALID
-> BaseValidator ValidValue
checkType Maybe ResolvedValue
getVariable Maybe ResolvedValue
defaultValue
            )
    where
      toVariable :: ValidValue -> Variable VALID
toVariable ValidValue
x = Variable RAW
var {variableValue = ValidVariableValue x}
      getVariable :: Maybe ResolvedValue
      getVariable :: Maybe ResolvedValue
getVariable = Maybe ResolvedValue
-> (ResolvedValue -> Maybe ResolvedValue)
-> FieldName
-> Variables
-> Maybe ResolvedValue
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr Maybe ResolvedValue
forall a. Maybe a
Nothing ResolvedValue -> Maybe ResolvedValue
forall a. a -> Maybe a
Just FieldName
variableName Variables
bodyVariables
      ------------------------------------------------------------------
      -- checkType ::
      checkType ::
        Maybe ResolvedValue ->
        DefaultValue ->
        TypeDefinition IN VALID ->
        BaseValidator ValidValue
      checkType :: Maybe ResolvedValue
-> Maybe ResolvedValue
-> TypeDefinition 'IN VALID
-> BaseValidator ValidValue
checkType (Just ResolvedValue
variable) Maybe ResolvedValue
Nothing TypeDefinition 'IN VALID
varType = TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varType Bool
False ResolvedValue
variable
      checkType (Just ResolvedValue
variable) (Just ResolvedValue
defValue) TypeDefinition 'IN VALID
varType =
        TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varType Bool
True ResolvedValue
defValue Validator VALID (OperationContext RAW RAW) ValidValue
-> Validator VALID (OperationContext RAW RAW) ValidValue
-> Validator VALID (OperationContext RAW RAW) ValidValue
forall a b.
Validator VALID (OperationContext RAW RAW) a
-> Validator VALID (OperationContext RAW RAW) b
-> Validator VALID (OperationContext RAW RAW) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varType Bool
False ResolvedValue
variable
      checkType Maybe ResolvedValue
Nothing (Just ResolvedValue
defValue) TypeDefinition 'IN VALID
varType = TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varType Bool
True ResolvedValue
defValue
      checkType Maybe ResolvedValue
Nothing Maybe ResolvedValue
Nothing TypeDefinition 'IN VALID
varType
        | VALIDATION_MODE
validationMode VALIDATION_MODE -> VALIDATION_MODE -> Bool
forall a. Eq a => a -> a -> Bool
/= VALIDATION_MODE
WITHOUT_VARIABLES Bool -> Bool -> Bool
&& Bool -> Bool
not (TypeRef -> Bool
forall a. Nullable a => a -> Bool
isNullable TypeRef
variableType) =
            GQLError -> BaseValidator ValidValue
forall a. GQLError -> Validator VALID (ValidationStage 'Base) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> BaseValidator ValidValue)
-> GQLError -> BaseValidator ValidValue
forall a b. (a -> b) -> a -> b
$ Variable RAW -> GQLError
forall (s :: Stage). Variable s -> GQLError
uninitializedVariable Variable RAW
var
        | Bool
otherwise =
            BaseValidator ValidValue
returnNull
        where
          returnNull :: BaseValidator ValidValue
          returnNull :: BaseValidator ValidValue
returnNull = Validator VALID (OperationContext RAW RAW) ValidValue
-> (ResolvedValue
    -> Validator VALID (OperationContext RAW RAW) ValidValue)
-> FieldName
-> Variables
-> Validator VALID (OperationContext RAW RAW) ValidValue
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr (ValidValue -> Validator VALID (OperationContext RAW RAW) ValidValue
forall a. a -> Validator VALID (OperationContext RAW RAW) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
forall (stage :: Stage). Value stage
Null) (TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varType Bool
False) FieldName
variableName Variables
bodyVariables
      -----------------------------------------------------------------------------------------------
      validator :: TypeDefinition IN VALID -> Bool -> ResolvedValue -> BaseValidator ValidValue
      validator :: TypeDefinition 'IN VALID
-> Bool -> ResolvedValue -> BaseValidator ValidValue
validator TypeDefinition 'IN VALID
varTypeDef Bool
isDefaultValue ResolvedValue
varValue =
        InputSource
-> InputValidator VALID (OperationContext RAW RAW) ValidValue
-> Validator VALID (OperationContext RAW RAW) ValidValue
forall (s :: Stage) ctx a.
InputSource -> InputValidator s ctx a -> Validator s ctx a
startInput
          (Variable RAW -> Bool -> InputSource
SourceVariable Variable RAW
var Bool
isDefaultValue)
          ( TypeWrapper
-> TypeDefinition 'IN VALID
-> ResolvedValue
-> InputValidator VALID (OperationContext RAW RAW) ValidValue
forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition 'IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType
              TypeWrapper
typeWrappers
              TypeDefinition 'IN VALID
varTypeDef
              ResolvedValue
varValue
          )