{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Validation.Internal.Value
( validateInputByTypeRef,
validateInputByType,
ValidateWithDefault,
)
where
import Control.Monad.Except (throwError)
import Data.Morpheus.Error.Input (typeViolation)
import Data.Morpheus.Error.Variable (incompatibleVariableType)
import Data.Morpheus.Internal.Utils
( singleton,
)
import Data.Morpheus.Types.Internal.AST
( CONST,
DataEnumValue (..),
FieldDefinition (..),
FieldName,
FieldsDefinition,
GQLError,
IN,
Object,
ObjectEntry (..),
Ref (..),
ScalarDefinition (..),
ScalarValue (..),
TRUE,
TypeContent (..),
TypeDefinition (..),
TypeName,
TypeRef (..),
TypeWrapper (..),
Typed (..),
UnionMember (..),
UnionTypeDefinition,
VALID,
ValidValue,
Value (..),
Variable (..),
VariableContent (..),
atPositions,
isNullable,
isSubtype,
mkMaybeType,
mkTypeRef,
msg,
packName,
toCategory,
typed,
unitFieldName,
unitTypeName,
untyped,
)
import Data.Morpheus.Types.Internal.Validation
( askType,
askTypeMember,
constraintInputUnion,
selectKnown,
selectWithDefaultValue,
)
import Data.Morpheus.Types.Internal.Validation.Scope (setType)
import Data.Morpheus.Types.Internal.Validation.Validator
import Relude
violation ::
Maybe GQLError ->
Value s ->
InputValidator schemaS ctx a
violation :: forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation Maybe GQLError
message Value s
value = do
Scope
{ Maybe Position
position :: Scope -> Maybe Position
position :: Maybe Position
position,
TypeName
currentTypeName :: Scope -> TypeName
currentTypeName :: TypeName
currentTypeName,
TypeWrapper
currentTypeWrappers :: Scope -> TypeWrapper
currentTypeWrappers :: TypeWrapper
currentTypeWrappers
} <-
forall (s :: Stage) ctx (m :: * -> *) a.
MonadReader (ValidatorContext s ctx) m =>
(Scope -> a) -> m a
asksScope forall a. a -> a
id
GQLError
prefix <- forall (s :: Stage) ctx. InputValidator s ctx GQLError
inputMessagePrefix
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
( GQLError
prefix
forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). TypeRef -> Value s -> GQLError
typeViolation
(TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
currentTypeName TypeWrapper
currentTypeWrappers)
Value s
value
forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe GQLError
"" (GQLError
" " forall a. Semigroup a => a -> a -> a
<>) Maybe GQLError
message
)
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
checkTypeCompatibility ::
TypeRef ->
Ref FieldName ->
Variable VALID ->
InputValidator schemaS ctx ValidValue
checkTypeCompatibility :: forall (schemaS :: Stage) ctx.
TypeRef
-> Ref FieldName
-> Variable VALID
-> InputValidator schemaS ctx ValidValue
checkTypeCompatibility TypeRef
valueType Ref FieldName
ref var :: Variable VALID
var@Variable {variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue = ValidVariableValue ValidValue
value, TypeRef
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableType :: TypeRef
variableType}
| TypeRef
variableType forall t. Subtyping t => t -> t -> Bool
`isSubtype` TypeRef
valueType = forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
value
| Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall (s :: Stage).
Ref FieldName -> Variable s -> TypeRef -> GQLError
incompatibleVariableType Ref FieldName
ref Variable VALID
var TypeRef
valueType
validateInputByTypeRef ::
ValidateWithDefault c schemaS s =>
Typed IN schemaS TypeRef ->
Value s ->
Validator schemaS (InputContext c) (Value VALID)
validateInputByTypeRef :: forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
Typed IN schemaS TypeRef
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateInputByTypeRef
Typed IN schemaS TypeRef
ref
Value s
value = do
TypeDefinition IN schemaS
inputTypeDef <- forall (m :: * -> *) c (cat :: TypeCategory) (s :: Stage) ctx.
Constraints m c cat s ctx =>
Typed cat s TypeRef -> m (TypeDefinition cat s)
askType Typed IN schemaS TypeRef
ref
forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType
(forall a b (c :: TypeCategory) (s :: Stage).
(a -> b) -> Typed c s a -> b
untyped TypeRef -> TypeWrapper
typeWrappers Typed IN schemaS TypeRef
ref)
TypeDefinition IN schemaS
inputTypeDef
Value s
value
validateValueByField ::
ValidateWithDefault c schemaS s =>
FieldDefinition IN schemaS ->
Value s ->
Validator schemaS (InputContext c) (Value VALID)
validateValueByField :: forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
FieldDefinition IN schemaS
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateValueByField FieldDefinition IN schemaS
field =
forall (s :: Stage) c a.
FieldDefinition IN s
-> InputValidator s c a -> InputValidator s c a
inField FieldDefinition IN schemaS
field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
Typed IN schemaS TypeRef
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateInputByTypeRef
(forall (a :: TypeCategory -> Stage -> *) (c :: TypeCategory)
(s :: Stage) b.
(a c s -> b) -> a c s -> Typed c s b
typed forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType FieldDefinition IN schemaS
field)
validateInputByType ::
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper ->
TypeDefinition IN schemaS ->
Value valueS ->
InputValidator schemaS ctx ValidValue
validateInputByType :: forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType TypeWrapper
tyWrappers TypeDefinition IN schemaS
typeDef =
forall (s :: Stage) c (m :: * -> *) b.
MonadReader (ValidatorContext s c) m =>
(Scope -> Scope) -> m b -> m b
withScope (forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> TypeWrapper -> Scope -> Scope
setType TypeDefinition IN schemaS
typeDef TypeWrapper
tyWrappers) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateWrapped TypeWrapper
tyWrappers TypeDefinition IN schemaS
typeDef
validateWrapped ::
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper ->
TypeDefinition IN schemaS ->
Value valueS ->
InputValidator schemaS ctx ValidValue
validateWrapped :: forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateWrapped TypeWrapper
wrappers TypeDefinition IN schemaS
_ (ResolvedVariable Ref FieldName
ref Variable VALID
variable) = do
TypeName
typeName <- forall (s :: Stage) ctx (m :: * -> *) a.
MonadReader (ValidatorContext s ctx) m =>
(Scope -> a) -> m a
asksScope Scope -> TypeName
currentTypeName
forall (schemaS :: Stage) ctx.
TypeRef
-> Ref FieldName
-> Variable VALID
-> InputValidator schemaS ctx ValidValue
checkTypeCompatibility (TypeName -> TypeWrapper -> TypeRef
TypeRef TypeName
typeName TypeWrapper
wrappers) Ref FieldName
ref Variable VALID
variable
validateWrapped TypeWrapper
wrappers TypeDefinition IN schemaS
_ Value valueS
Null
| forall a. Nullable a => a -> Bool
isNullable TypeWrapper
wrappers = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (stage :: Stage). Value stage
Null
| Bool
otherwise = forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing forall (stage :: Stage). Value stage
Null
validateWrapped (TypeList TypeWrapper
wrappers Bool
_) TypeDefinition IN schemaS
tyCont (List [Value valueS]
list) =
forall (stage :: Stage). [Value stage] -> Value stage
List 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 ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType TypeWrapper
wrappers TypeDefinition IN schemaS
tyCont) [Value valueS]
list
validateWrapped (TypeList TypeWrapper
wrappers Bool
_) TypeDefinition IN schemaS
tyCont Value valueS
singleElem =
forall (stage :: Stage). [Value stage] -> Value stage
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType TypeWrapper
wrappers TypeDefinition IN schemaS
tyCont Value valueS
singleElem
validateWrapped BaseType {} TypeDefinition {TypeContent TRUE IN schemaS
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE IN schemaS
typeContent} Value valueS
entryValue =
forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeContent TRUE IN schemaS
-> Value valueS -> InputValidator schemaS ctx ValidValue
validateUnwrapped TypeContent TRUE IN schemaS
typeContent Value valueS
entryValue
validateUnwrapped ::
ValidateWithDefault ctx schemaS valueS =>
TypeContent TRUE IN schemaS ->
Value valueS ->
InputValidator schemaS ctx ValidValue
validateUnwrapped :: forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeContent TRUE IN schemaS
-> Value valueS -> InputValidator schemaS ctx ValidValue
validateUnwrapped (DataInputObject FieldsDefinition IN schemaS
parentFields) (Object Object valueS
fields) =
forall (stage :: Stage). Object stage -> Value stage
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
FieldsDefinition IN schemaS
-> Object valueS -> InputValidator schemaS ctx (Object VALID)
validateInputObject FieldsDefinition IN schemaS
parentFields Object valueS
fields
validateUnwrapped (DataInputUnion UnionTypeDefinition IN schemaS
inputUnion) (Object Object valueS
rawFields) =
forall ctx (schemaS :: Stage) (s :: Stage).
ValidateWithDefault ctx schemaS s =>
UnionTypeDefinition IN schemaS
-> Object s -> InputValidator schemaS ctx ValidValue
validateInputUnion UnionTypeDefinition IN schemaS
inputUnion Object valueS
rawFields
validateUnwrapped (DataEnum DataEnum schemaS
tags) Value valueS
value =
forall (s :: Stage) (valueS :: Stage) (schemaS :: Stage) c.
[DataEnumValue s]
-> Value valueS -> InputValidator schemaS c ValidValue
validateEnum DataEnum schemaS
tags Value valueS
value
validateUnwrapped (DataScalar ScalarDefinition
dataScalar) Value valueS
value =
forall (s :: Stage) (schemaS :: Stage) ctx.
ScalarDefinition
-> Value s -> InputValidator schemaS ctx ValidValue
validateScalar ScalarDefinition
dataScalar Value valueS
value
validateUnwrapped TypeContent TRUE IN schemaS
_ Value valueS
value = forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value valueS
value
validateInputUnion ::
ValidateWithDefault ctx schemaS s =>
UnionTypeDefinition IN schemaS ->
Object s ->
InputValidator schemaS ctx (Value VALID)
validateInputUnion :: forall ctx (schemaS :: Stage) (s :: Stage).
ValidateWithDefault ctx schemaS s =>
UnionTypeDefinition IN schemaS
-> Object s -> InputValidator schemaS ctx ValidValue
validateInputUnion UnionTypeDefinition IN schemaS
inputUnion Object s
rawFields =
case forall (stage :: Stage) (schemaStage :: Stage).
UnionTypeDefinition IN schemaStage
-> Object stage
-> Either GQLError (UnionMember IN schemaStage, Value stage)
constraintInputUnion UnionTypeDefinition IN schemaS
inputUnion Object s
rawFields of
Left GQLError
message -> forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Msg a => a -> GQLError
msg GQLError
message) (forall (stage :: Stage). Object stage -> Value stage
Object Object s
rawFields)
Right (UnionMember IN schemaS
name, Value s
value) -> forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
UnionMember IN schemaS
-> Value valueS -> InputValidator schemaS ctx ValidValue
validateInputUnionMember UnionMember IN schemaS
name Value s
value
validateInputUnionMember ::
ValidateWithDefault ctx schemaS valueS =>
UnionMember IN schemaS ->
Value valueS ->
InputValidator schemaS ctx (Value VALID)
validateInputUnionMember :: forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
UnionMember IN schemaS
-> Value valueS -> InputValidator schemaS ctx ValidValue
validateInputUnionMember UnionMember IN schemaS
member Value valueS
value = do
TypeDefinition IN schemaS
inputDef <- Validator schemaS (InputContext ctx) (TypeDefinition IN schemaS)
askDef
forall (s' :: Stage) (s :: Stage).
UnionMember IN s' -> Value s -> Value s
mkInputUnionValue UnionMember IN schemaS
member forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
TypeWrapper
-> TypeDefinition IN schemaS
-> Value valueS
-> InputValidator schemaS ctx ValidValue
validateInputByType TypeWrapper
mkMaybeType TypeDefinition IN schemaS
inputDef Value valueS
value
where
askDef :: Validator schemaS (InputContext ctx) (TypeDefinition IN schemaS)
askDef
| forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Bool
nullary UnionMember IN schemaS
member = forall (m :: * -> *) c (cat :: TypeCategory) (s :: Stage) ctx.
Constraints m c cat s ctx =>
Typed cat s TypeRef -> m (TypeDefinition cat s)
askType (forall (cat :: TypeCategory) (s :: Stage) a. a -> Typed cat s a
Typed forall a b. (a -> b) -> a -> b
$ TypeName -> TypeRef
mkTypeRef TypeName
unitTypeName)
| Bool
otherwise = forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) c (cat :: TypeCategory) (s :: Stage) ctx.
Constraints m c cat s ctx =>
UnionMember cat s -> m (TypeDefinition (ToOBJECT cat) s)
askTypeMember UnionMember IN schemaS
member
mkInputUnionValue :: UnionMember IN s' -> Value s -> Value s
mkInputUnionValue :: forall (s' :: Stage) (s :: Stage).
UnionMember IN s' -> Value s -> Value s
mkInputUnionValue
UnionMember
{ TypeName
memberName :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName :: TypeName
memberName,
Bool
nullary :: Bool
nullary :: forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> Bool
nullary
} = forall (stage :: Stage). Object stage -> Value stage
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton FieldName
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value s -> Value s
packNullary
where
key :: FieldName
key = coerce :: forall a b. Coercible a b => a -> b
coerce TypeName
memberName
packNullary :: Value s -> Value s
packNullary
| Bool
nullary = forall (stage :: Stage). Object stage -> Value stage
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (m :: * -> *) a. IsMap k m => k -> a -> m a
singleton FieldName
unitFieldName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
unitFieldName
| Bool
otherwise = forall a. a -> a
id
validateInputObject ::
ValidateWithDefault ctx schemaS valueS =>
FieldsDefinition IN schemaS ->
Object valueS ->
InputValidator schemaS ctx (Object VALID)
validateInputObject :: forall ctx (schemaS :: Stage) (valueS :: Stage).
ValidateWithDefault ctx schemaS valueS =>
FieldsDefinition IN schemaS
-> Object valueS -> InputValidator schemaS ctx (Object VALID)
validateInputObject FieldsDefinition IN schemaS
fieldsDef Object valueS
object =
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (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` FieldsDefinition IN schemaS
fieldsDef) Object valueS
object
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
Object s
-> FieldDefinition IN schemaS
-> Validator schemaS (InputContext c) (ObjectEntry VALID)
validateWithDefault Object valueS
object) FieldsDefinition IN schemaS
fieldsDef
class ValidateWithDefault c schemaS s where
validateWithDefault ::
Object s ->
FieldDefinition IN schemaS ->
Validator schemaS (InputContext c) (ObjectEntry VALID)
instance ValidateWithDefault c VALID s where
validateWithDefault :: Object s
-> FieldDefinition IN VALID
-> Validator VALID (InputContext c) (ObjectEntry VALID)
validateWithDefault Object s
object fieldDef :: FieldDefinition IN VALID
fieldDef@FieldDefinition {FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName :: FieldName
fieldName} =
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
fieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ctx (c :: * -> *) (s :: Stage) validValue a.
(IsMap FieldName c, MissingRequired (c a) ctx) =>
(Value s -> Validator s ctx validValue)
-> (a -> Validator s ctx validValue)
-> FieldDefinition IN s
-> c a
-> Validator s ctx validValue
selectWithDefaultValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
FieldDefinition IN schemaS
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateValueByField FieldDefinition IN VALID
fieldDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). ObjectEntry s -> Value s
entryValue)
FieldDefinition IN VALID
fieldDef
Object s
object
instance ValidateWithDefault c CONST s where
validateWithDefault :: Object s
-> FieldDefinition IN 'CONST
-> Validator 'CONST (InputContext c) (ObjectEntry VALID)
validateWithDefault Object s
object fieldDef :: FieldDefinition IN 'CONST
fieldDef@FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName} =
forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry FieldName
fieldName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ctx (c :: * -> *) (s :: Stage) validValue a.
(IsMap FieldName c, MissingRequired (c a) ctx) =>
(Value s -> Validator s ctx validValue)
-> (a -> Validator s ctx validValue)
-> FieldDefinition IN s
-> c a
-> Validator s ctx validValue
selectWithDefaultValue
(forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
FieldDefinition IN schemaS
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateValueByField FieldDefinition IN 'CONST
fieldDef)
(forall c (schemaS :: Stage) (s :: Stage).
ValidateWithDefault c schemaS s =>
FieldDefinition IN schemaS
-> Value s -> Validator schemaS (InputContext c) ValidValue
validateValueByField FieldDefinition IN 'CONST
fieldDef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). ObjectEntry s -> Value s
entryValue)
FieldDefinition IN 'CONST
fieldDef
Object s
object
validateScalar ::
ScalarDefinition ->
Value s ->
InputValidator schemaS ctx ValidValue
validateScalar :: forall (s :: Stage) (schemaS :: Stage) ctx.
ScalarDefinition
-> Value s -> InputValidator schemaS ctx ValidValue
validateScalar ScalarDefinition {ValidValue -> Either Token ValidValue
validateValue :: ScalarDefinition -> ValidValue -> Either Token ValidValue
validateValue :: ValidValue -> Either Token ValidValue
validateValue} Value s
value = do
TypeName
typeName <- forall (s :: Stage) ctx (m :: * -> *) a.
MonadReader (ValidatorContext s ctx) m =>
(Scope -> a) -> m a
asksScope Scope -> TypeName
currentTypeName
ValidValue
scalarValue <- forall (s :: Stage) (schemaS :: Stage) ctx.
TypeName -> Value s -> InputValidator schemaS ctx ValidValue
toScalar TypeName
typeName Value s
value
case ValidValue -> Either Token ValidValue
validateValue ValidValue
scalarValue of
Right ValidValue
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
scalarValue
Left Token
"" -> forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value s
value
Left Token
message -> forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Msg a => a -> GQLError
msg Token
message) Value s
value
where
toScalar :: TypeName -> Value s -> InputValidator schemaS ctx ValidValue
toScalar :: forall (s :: Stage) (schemaS :: Stage) ctx.
TypeName -> Value s -> InputValidator schemaS ctx ValidValue
toScalar TypeName
typeName (Scalar ScalarValue
x) | TypeName -> ScalarValue -> Bool
isValidDefault TypeName
typeName ScalarValue
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (stage :: Stage). ScalarValue -> Value stage
Scalar ScalarValue
x)
toScalar TypeName
_ Value s
_ = forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value s
value
isValidDefault :: TypeName -> ScalarValue -> Bool
isValidDefault :: TypeName -> ScalarValue -> Bool
isValidDefault TypeName
"Boolean" = ScalarValue -> Bool
isBoolean
isValidDefault TypeName
"String" = ScalarValue -> Bool
isString
isValidDefault TypeName
"Float" = forall a. [a -> Bool] -> a -> Bool
oneOf [ScalarValue -> Bool
isFloat, ScalarValue -> Bool
isInt]
isValidDefault TypeName
"Int" = ScalarValue -> Bool
isInt
isValidDefault TypeName
"ID" = forall a. [a -> Bool] -> a -> Bool
oneOf [ScalarValue -> Bool
isInt, ScalarValue -> Bool
isFloat, ScalarValue -> Bool
isString]
isValidDefault TypeName
_ = forall a b. a -> b -> a
const Bool
True
oneOf :: [a -> Bool] -> a -> Bool
oneOf :: forall a. [a -> Bool] -> a -> Bool
oneOf [a -> Bool]
ls a
v = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a
v forall a b. a -> (a -> b) -> b
&) [a -> Bool]
ls
isBoolean :: ScalarValue -> Bool
isBoolean :: ScalarValue -> Bool
isBoolean Boolean {} = Bool
True
isBoolean ScalarValue
_ = Bool
False
isString :: ScalarValue -> Bool
isString :: ScalarValue -> Bool
isString String {} = Bool
True
isString ScalarValue
_ = Bool
False
isFloat :: ScalarValue -> Bool
isFloat :: ScalarValue -> Bool
isFloat Float {} = Bool
True
isFloat ScalarValue
_ = Bool
False
isInt :: ScalarValue -> Bool
isInt :: ScalarValue -> Bool
isInt Int {} = Bool
True
isInt ScalarValue
_ = Bool
False
isVariableValue :: InputValidator schemaS c Bool
isVariableValue :: forall (schemaS :: Stage) c. InputValidator schemaS c Bool
isVariableValue =
\case
SourceVariable {Bool
isDefaultValue :: InputSource -> Bool
isDefaultValue :: Bool
isDefaultValue} -> Bool -> Bool
not Bool
isDefaultValue
InputSource
_ -> Bool
False
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage) c (m :: * -> *).
MonadReader (ValidatorContext s (InputContext c)) m =>
m InputSource
inputValueSource
validateEnum ::
[DataEnumValue s] ->
Value valueS ->
InputValidator schemaS c ValidValue
validateEnum :: forall (s :: Stage) (valueS :: Stage) (schemaS :: Stage) c.
[DataEnumValue s]
-> Value valueS -> InputValidator schemaS c ValidValue
validateEnum [DataEnumValue s]
enumValues value :: Value valueS
value@(Scalar (String Token
enumValue))
| forall a (t :: NAME). NamePacking a => a -> Name t
packName Token
enumValue forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [TypeName]
tags = do
Bool
isFromVariable <- forall (schemaS :: Stage) c. InputValidator schemaS c Bool
isVariableValue
if Bool
isFromVariable
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (stage :: Stage). TypeName -> Value stage
Enum (forall a (t :: NAME). NamePacking a => a -> Name t
packName Token
enumValue))
else forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value valueS
value
where
tags :: [TypeName]
tags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage). DataEnumValue s -> TypeName
enumName [DataEnumValue s]
enumValues
validateEnum [DataEnumValue s]
enumValues value :: Value valueS
value@(Enum TypeName
enumValue)
| TypeName
enumValue forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [TypeName]
tags = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (stage :: Stage). TypeName -> Value stage
Enum TypeName
enumValue)
| Bool
otherwise = forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value valueS
value
where
tags :: [TypeName]
tags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Stage). DataEnumValue s -> TypeName
enumName [DataEnumValue s]
enumValues
validateEnum [DataEnumValue s]
_ Value valueS
value = forall (s :: Stage) (schemaS :: Stage) ctx a.
Maybe GQLError -> Value s -> InputValidator schemaS ctx a
violation forall a. Maybe a
Nothing Value valueS
value