{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.Validation.Validator
( Validator (..),
SelectionValidator,
InputValidator,
BaseValidator,
runValidator,
Constraint (..),
setSelection,
inField,
inputMessagePrefix,
InputSource (..),
InputContext (..),
OperationContext (..),
renderInputPrefix,
Prop (..),
ScopeKind (..),
inputValueSource,
Scope (..),
setDirective,
startInput,
withContext,
renderField,
asksScope,
askVariables,
askFragments,
ValidatorContext (..),
FragmentValidator,
askTypeDefinitions,
withScope,
setPosition,
)
where
import Control.Monad.Except (MonadError (catchError, throwError))
import Control.Monad.Reader (asks)
import Data.Morpheus.Ext.Result
( GQLResult,
)
import Data.Morpheus.Types.Internal.AST
( ANY,
FieldDefinition (..),
FieldName,
Fragments,
IMPLEMENTABLE,
IN,
RAW,
Schema,
Stage,
TypeCategory,
TypeDefinition (..),
TypeName,
TypeRef (..),
VALID,
Variable (..),
VariableDefinitions,
intercalate,
typeDefinitions,
unpackName,
)
import Data.Morpheus.Types.Internal.AST.Error
import Data.Morpheus.Types.Internal.Config (Config (..))
import Data.Morpheus.Types.Internal.Validation.Scope
( Scope (..),
ScopeKind (..),
renderScope,
renderSection,
setDirective,
setPosition,
setSelection,
)
import Relude hiding
( Constraint,
asks,
get,
intercalate,
)
data Prop = Prop
{ Prop -> FieldName
propName :: FieldName,
Prop -> TypeName
propTypeName :: TypeName
}
deriving (Int -> Prop -> ShowS
[Prop] -> ShowS
Prop -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prop] -> ShowS
$cshowList :: [Prop] -> ShowS
show :: Prop -> String
$cshow :: Prop -> String
showsPrec :: Int -> Prop -> ShowS
$cshowsPrec :: Int -> Prop -> ShowS
Show)
type Path = [Prop]
renderPath :: Path -> GQLError
renderPath :: [Prop] -> GQLError
renderPath [] = GQLError
""
renderPath [Prop]
path = GQLError
"in field " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall (t1 :: NAME) (t2 :: NAME) (t3 :: NAME).
Name t1 -> [Name t2] -> Name t3
intercalate Name Any
"." forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> FieldName
propName [Prop]
path) forall a. Semigroup a => a -> a -> a
<> GQLError
": "
renderInputPrefix :: InputContext c -> GQLError
renderInputPrefix :: forall c. InputContext c -> GQLError
renderInputPrefix InputContext {[Prop]
inputPath :: forall ctx. InputContext ctx -> [Prop]
inputPath :: [Prop]
inputPath, InputSource
inputSource :: forall ctx. InputContext ctx -> InputSource
inputSource :: InputSource
inputSource} =
InputSource -> GQLError
renderSource InputSource
inputSource forall a. Semigroup a => a -> a -> a
<> [Prop] -> GQLError
renderPath [Prop]
inputPath
renderSource :: InputSource -> GQLError
renderSource :: InputSource -> GQLError
renderSource (SourceArgument FieldName
argumentName) =
GQLError
"Argument " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg FieldName
argumentName forall a. Semigroup a => a -> a -> a
<> GQLError
" got invalid value. "
renderSource (SourceVariable Variable {FieldName
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variableName :: FieldName
variableName} Bool
_) =
GQLError
"Variable " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (FieldName
"$" forall a. Semigroup a => a -> a -> a
<> FieldName
variableName) forall a. Semigroup a => a -> a -> a
<> GQLError
" got invalid value. "
renderSource SourceInputField {TypeName
sourceTypeName :: InputSource -> TypeName
sourceTypeName :: TypeName
sourceTypeName, FieldName
sourceFieldName :: InputSource -> FieldName
sourceFieldName :: FieldName
sourceFieldName, Maybe FieldName
sourceArgumentName :: InputSource -> Maybe FieldName
sourceArgumentName :: Maybe FieldName
sourceArgumentName} =
GQLError
"Field " forall a. Semigroup a => a -> a -> a
<> TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField TypeName
sourceTypeName FieldName
sourceFieldName Maybe FieldName
sourceArgumentName forall a. Semigroup a => a -> a -> a
<> GQLError
" got invalid default value. "
renderField :: TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField :: TypeName -> FieldName -> Maybe FieldName -> GQLError
renderField TypeName
tName FieldName
fName Maybe FieldName
arg =
forall a. Msg a => a -> GQLError
msg (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
tName forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
fName forall a. Semigroup a => a -> a -> a
<> forall {a} {t :: NAME}.
(Semigroup a, IsString a, NamePacking a) =>
Maybe (Name t) -> a
renderArg Maybe FieldName
arg :: Text)
where
renderArg :: Maybe (Name t) -> a
renderArg (Just Name t
argName) = a
"(" forall a. Semigroup a => a -> a -> a
<> forall a (t :: NAME). NamePacking a => Name t -> a
unpackName Name t
argName forall a. Semigroup a => a -> a -> a
<> a
":)"
renderArg Maybe (Name t)
Nothing = a
""
data OperationContext (s1 :: Stage) (s2 :: Stage) = OperationContext
{ forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Fragments s2
fragments :: Fragments s2,
forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> VariableDefinitions s1
variables :: VariableDefinitions s1,
forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Maybe FieldName
operationName :: Maybe FieldName
}
deriving (Int -> OperationContext s1 s2 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s1 :: Stage) (s2 :: Stage).
Int -> OperationContext s1 s2 -> ShowS
forall (s1 :: Stage) (s2 :: Stage).
[OperationContext s1 s2] -> ShowS
forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> String
showList :: [OperationContext s1 s2] -> ShowS
$cshowList :: forall (s1 :: Stage) (s2 :: Stage).
[OperationContext s1 s2] -> ShowS
show :: OperationContext s1 s2 -> String
$cshow :: forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> String
showsPrec :: Int -> OperationContext s1 s2 -> ShowS
$cshowsPrec :: forall (s1 :: Stage) (s2 :: Stage).
Int -> OperationContext s1 s2 -> ShowS
Show)
data InputContext ctx = InputContext
{ forall ctx. InputContext ctx -> InputSource
inputSource :: InputSource,
forall ctx. InputContext ctx -> [Prop]
inputPath :: [Prop],
forall ctx. InputContext ctx -> ctx
sourceContext :: ctx
}
deriving (Int -> InputContext ctx -> ShowS
forall ctx. Show ctx => Int -> InputContext ctx -> ShowS
forall ctx. Show ctx => [InputContext ctx] -> ShowS
forall ctx. Show ctx => InputContext ctx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputContext ctx] -> ShowS
$cshowList :: forall ctx. Show ctx => [InputContext ctx] -> ShowS
show :: InputContext ctx -> String
$cshow :: forall ctx. Show ctx => InputContext ctx -> String
showsPrec :: Int -> InputContext ctx -> ShowS
$cshowsPrec :: forall ctx. Show ctx => Int -> InputContext ctx -> ShowS
Show)
data InputSource
= SourceArgument FieldName
| SourceVariable
{ InputSource -> Variable RAW
sourceVariable :: Variable RAW,
InputSource -> Bool
isDefaultValue :: Bool
}
| SourceInputField
{ InputSource -> TypeName
sourceTypeName :: TypeName,
InputSource -> FieldName
sourceFieldName :: FieldName,
InputSource -> Maybe FieldName
sourceArgumentName :: Maybe FieldName
}
deriving (Int -> InputSource -> ShowS
[InputSource] -> ShowS
InputSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputSource] -> ShowS
$cshowList :: [InputSource] -> ShowS
show :: InputSource -> String
$cshow :: InputSource -> String
showsPrec :: Int -> InputSource -> ShowS
$cshowsPrec :: Int -> InputSource -> ShowS
Show)
data Constraint (a :: TypeCategory) where
IMPLEMENTABLE :: Constraint IMPLEMENTABLE
INPUT :: Constraint IN
inField :: FieldDefinition IN s -> InputValidator s c a -> InputValidator s c a
inField :: forall (s :: Stage) c a.
FieldDefinition IN s
-> InputValidator s c a -> InputValidator s c a
inField
FieldDefinition
{ FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName :: FieldName
fieldName,
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName}
} = forall c' c (s :: Stage) a.
(c' -> c) -> Validator s c a -> Validator s c' a
withContext InputContext c -> InputContext c
update
where
update :: InputContext c -> InputContext c
update
InputContext
{ inputPath :: forall ctx. InputContext ctx -> [Prop]
inputPath = [Prop]
old,
c
InputSource
sourceContext :: c
inputSource :: InputSource
sourceContext :: forall ctx. InputContext ctx -> ctx
inputSource :: forall ctx. InputContext ctx -> InputSource
..
} =
InputContext
{ inputPath :: [Prop]
inputPath = [Prop]
old forall a. Semigroup a => a -> a -> a
<> [FieldName -> TypeName -> Prop
Prop FieldName
fieldName TypeName
typeConName],
c
InputSource
sourceContext :: c
inputSource :: InputSource
sourceContext :: c
inputSource :: InputSource
..
}
inputValueSource :: MonadReader (ValidatorContext s (InputContext c)) m => m InputSource
inputValueSource :: forall (s :: Stage) c (m :: * -> *).
MonadReader (ValidatorContext s (InputContext c)) m =>
m InputSource
inputValueSource = forall (s :: Stage) c (m :: * -> *) a.
MonadReader (ValidatorContext s c) m =>
(c -> a) -> m a
asksLocal forall ctx. InputContext ctx -> InputSource
inputSource
asksScope :: MonadReader (ValidatorContext s ctx) m => (Scope -> a) -> m a
asksScope :: forall (s :: Stage) ctx (m :: * -> *) a.
MonadReader (ValidatorContext s ctx) m =>
(Scope -> a) -> m a
asksScope Scope -> a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Scope -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope)
askTypeDefinitions ::
MonadReader (ValidatorContext s ctx) m =>
m (HashMap TypeName (TypeDefinition ANY s))
askTypeDefinitions :: forall (s :: Stage) ctx (m :: * -> *).
MonadReader (ValidatorContext s ctx) m =>
m (HashMap TypeName (TypeDefinition ANY s))
askTypeDefinitions = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (s :: Stage).
Schema s -> HashMap TypeName (TypeDefinition ANY s)
typeDefinitions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
schema)
askVariables :: MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m => m (VariableDefinitions s2)
askVariables :: forall (s1 :: Stage) (s2 :: Stage) (s3 :: Stage) (m :: * -> *).
MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m =>
m (VariableDefinitions s2)
askVariables = forall (s :: Stage) c (m :: * -> *) a.
MonadReader (ValidatorContext s c) m =>
(c -> a) -> m a
asksLocal forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> VariableDefinitions s1
variables
askFragments :: MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m => m (Fragments s3)
askFragments :: forall (s1 :: Stage) (s2 :: Stage) (s3 :: Stage) (m :: * -> *).
MonadReader (ValidatorContext s1 (OperationContext s2 s3)) m =>
m (Fragments s3)
askFragments = forall (s :: Stage) c (m :: * -> *) a.
MonadReader (ValidatorContext s c) m =>
(c -> a) -> m a
asksLocal forall (s1 :: Stage) (s2 :: Stage).
OperationContext s1 s2 -> Fragments s2
fragments
runValidator :: Validator s ctx a -> Config -> Schema s -> Scope -> ctx -> GQLResult a
runValidator :: forall (s :: Stage) ctx a.
Validator s ctx a
-> Config -> Schema s -> Scope -> ctx -> GQLResult a
runValidator (Validator ReaderT (ValidatorContext s ctx) GQLResult a
x) Config
config Schema s
schema Scope
scope ctx
localContext =
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ValidatorContext s ctx) GQLResult a
x ValidatorContext {ctx
Schema s
Config
Scope
config :: Config
localContext :: ctx
localContext :: ctx
scope :: Scope
schema :: Schema s
config :: Config
schema :: Schema s
scope :: Scope
..}
withContext :: (c' -> c) -> Validator s c a -> Validator s c' a
withContext :: forall c' c (s :: Stage) a.
(c' -> c) -> Validator s c a -> Validator s c' a
withContext c' -> c
f = forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) GQLResult a -> Validator s ctx a
Validator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c' -> c
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx a.
Validator s ctx a -> ReaderT (ValidatorContext s ctx) GQLResult a
_runValidator
inputMessagePrefix :: InputValidator s ctx GQLError
inputMessagePrefix :: forall (s :: Stage) ctx. InputValidator s ctx GQLError
inputMessagePrefix =
forall c. InputContext c -> GQLError
renderInputPrefix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
localContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) GQLResult a -> Validator s ctx a
Validator forall r (m :: * -> *). MonadReader r m => m r
ask
startInput :: InputSource -> InputValidator s ctx a -> Validator s ctx a
startInput :: forall (s :: Stage) ctx a.
InputSource -> InputValidator s ctx a -> Validator s ctx a
startInput InputSource
inputSource = forall c' c (s :: Stage) a.
(c' -> c) -> Validator s c a -> Validator s c' a
withContext ctx -> InputContext ctx
update
where
update :: ctx -> InputContext ctx
update ctx
sourceContext =
InputContext
{ InputSource
inputSource :: InputSource
inputSource :: InputSource
inputSource,
inputPath :: [Prop]
inputPath = [],
ctx
sourceContext :: ctx
sourceContext :: ctx
sourceContext
}
data ValidatorContext (s :: Stage) (ctx :: Type) = ValidatorContext
{ forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope :: Scope,
forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
schema :: Schema s,
forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
localContext :: ctx,
forall (s :: Stage) ctx. ValidatorContext s ctx -> Config
config :: Config
}
deriving
( Int -> ValidatorContext s ctx -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage) ctx.
Show ctx =>
Int -> ValidatorContext s ctx -> ShowS
forall (s :: Stage) ctx.
Show ctx =>
[ValidatorContext s ctx] -> ShowS
forall (s :: Stage) ctx.
Show ctx =>
ValidatorContext s ctx -> String
showList :: [ValidatorContext s ctx] -> ShowS
$cshowList :: forall (s :: Stage) ctx.
Show ctx =>
[ValidatorContext s ctx] -> ShowS
show :: ValidatorContext s ctx -> String
$cshow :: forall (s :: Stage) ctx.
Show ctx =>
ValidatorContext s ctx -> String
showsPrec :: Int -> ValidatorContext s ctx -> ShowS
$cshowsPrec :: forall (s :: Stage) ctx.
Show ctx =>
Int -> ValidatorContext s ctx -> ShowS
Show,
forall a b. a -> ValidatorContext s b -> ValidatorContext s a
forall a b.
(a -> b) -> ValidatorContext s a -> ValidatorContext s b
forall (s :: Stage) a b.
a -> ValidatorContext s b -> ValidatorContext s a
forall (s :: Stage) a b.
(a -> b) -> ValidatorContext s a -> ValidatorContext s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ValidatorContext s b -> ValidatorContext s a
$c<$ :: forall (s :: Stage) a b.
a -> ValidatorContext s b -> ValidatorContext s a
fmap :: forall a b.
(a -> b) -> ValidatorContext s a -> ValidatorContext s b
$cfmap :: forall (s :: Stage) a b.
(a -> b) -> ValidatorContext s a -> ValidatorContext s b
Functor
)
newtype Validator s ctx a = Validator
{ forall (s :: Stage) ctx a.
Validator s ctx a -> ReaderT (ValidatorContext s ctx) GQLResult a
_runValidator ::
ReaderT
(ValidatorContext s ctx)
GQLResult
a
}
deriving newtype
( forall a b. a -> Validator s ctx b -> Validator s ctx a
forall a b. (a -> b) -> Validator s ctx a -> Validator s ctx b
forall (s :: Stage) ctx a b.
a -> Validator s ctx b -> Validator s ctx a
forall (s :: Stage) ctx a b.
(a -> b) -> Validator s ctx a -> Validator s ctx b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Validator s ctx b -> Validator s ctx a
$c<$ :: forall (s :: Stage) ctx a b.
a -> Validator s ctx b -> Validator s ctx a
fmap :: forall a b. (a -> b) -> Validator s ctx a -> Validator s ctx b
$cfmap :: forall (s :: Stage) ctx a b.
(a -> b) -> Validator s ctx a -> Validator s ctx b
Functor,
forall a. a -> Validator s ctx a
forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx a
forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
forall a b.
Validator s ctx (a -> b) -> Validator s ctx a -> Validator s ctx b
forall a b c.
(a -> b -> c)
-> Validator s ctx a -> Validator s ctx b -> Validator s ctx c
forall (s :: Stage) ctx. Functor (Validator s ctx)
forall (s :: Stage) ctx a. a -> Validator s ctx a
forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx a
forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
forall (s :: Stage) ctx a b.
Validator s ctx (a -> b) -> Validator s ctx a -> Validator s ctx b
forall (s :: Stage) ctx a b c.
(a -> b -> c)
-> Validator s ctx a -> Validator s ctx b -> Validator s ctx c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx a
$c<* :: forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx a
*> :: forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
$c*> :: forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
liftA2 :: forall a b c.
(a -> b -> c)
-> Validator s ctx a -> Validator s ctx b -> Validator s ctx c
$cliftA2 :: forall (s :: Stage) ctx a b c.
(a -> b -> c)
-> Validator s ctx a -> Validator s ctx b -> Validator s ctx c
<*> :: forall a b.
Validator s ctx (a -> b) -> Validator s ctx a -> Validator s ctx b
$c<*> :: forall (s :: Stage) ctx a b.
Validator s ctx (a -> b) -> Validator s ctx a -> Validator s ctx b
pure :: forall a. a -> Validator s ctx a
$cpure :: forall (s :: Stage) ctx a. a -> Validator s ctx a
Applicative,
forall a. a -> Validator s ctx a
forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
forall a b.
Validator s ctx a -> (a -> Validator s ctx b) -> Validator s ctx b
forall (s :: Stage) ctx. Applicative (Validator s ctx)
forall (s :: Stage) ctx a. a -> Validator s ctx a
forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
forall (s :: Stage) ctx a b.
Validator s ctx a -> (a -> Validator s ctx b) -> Validator s ctx b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Validator s ctx a
$creturn :: forall (s :: Stage) ctx a. a -> Validator s ctx a
>> :: forall a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
$c>> :: forall (s :: Stage) ctx a b.
Validator s ctx a -> Validator s ctx b -> Validator s ctx b
>>= :: forall a b.
Validator s ctx a -> (a -> Validator s ctx b) -> Validator s ctx b
$c>>= :: forall (s :: Stage) ctx a b.
Validator s ctx a -> (a -> Validator s ctx b) -> Validator s ctx b
Monad,
MonadReader (ValidatorContext s ctx)
)
data ValidationTarget
= Base
| Fragments
| Selections
type family ValidationStage (s :: ValidationTarget) where
ValidationStage 'Base = OperationContext RAW RAW
ValidationStage 'Fragments = OperationContext VALID RAW
ValidationStage 'Selections = OperationContext VALID VALID
type ValidatorM (s :: ValidationTarget) = Validator VALID (ValidationStage s)
type BaseValidator = ValidatorM 'Base
type FragmentValidator (s :: Stage) = Validator VALID (OperationContext VALID s)
type SelectionValidator = ValidatorM 'Selections
type InputValidator s ctx = Validator s (InputContext ctx)
withScope ::
(MonadReader (ValidatorContext s c) m) =>
(Scope -> Scope) ->
m b ->
m b
withScope :: forall (s :: Stage) c (m :: * -> *) b.
MonadReader (ValidatorContext s c) m =>
(Scope -> Scope) -> m b -> m b
withScope Scope -> Scope
f = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ValidatorContext {c
Schema s
Config
Scope
config :: Config
localContext :: c
schema :: Schema s
scope :: Scope
config :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Config
localContext :: forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
schema :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
..} -> ValidatorContext {scope :: Scope
scope = Scope -> Scope
f Scope
scope, c
Schema s
Config
config :: Config
localContext :: c
schema :: Schema s
config :: Config
localContext :: c
schema :: Schema s
..})
asksLocal :: MonadReader (ValidatorContext s c) m => (c -> a) -> m a
asksLocal :: forall (s :: Stage) c (m :: * -> *) a.
MonadReader (ValidatorContext s c) m =>
(c -> a) -> m a
asksLocal c -> a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (c -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
localContext)
instance MonadError GQLError (Validator s ctx) where
throwError :: forall a. GQLError -> Validator s ctx a
throwError GQLError
err = forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) GQLResult a -> Validator s ctx a
Validator forall a b. (a -> b) -> a -> b
$ do
ValidatorContext s ctx
ctx <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall (s :: Stage) ctx.
ValidatorContext s ctx -> GQLError -> GQLError
fromValidationError ValidatorContext s ctx
ctx GQLError
err)
catchError :: forall a.
Validator s ctx a
-> (GQLError -> Validator s ctx a) -> Validator s ctx a
catchError (Validator ReaderT (ValidatorContext s ctx) GQLResult a
x) GQLError -> Validator s ctx a
f = forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) GQLResult a -> Validator s ctx a
Validator (forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ReaderT (ValidatorContext s ctx) GQLResult a
x (forall (s :: Stage) ctx a.
Validator s ctx a -> ReaderT (ValidatorContext s ctx) GQLResult a
_runValidator forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Validator s ctx a
f))
fromValidationError :: ValidatorContext s ctx -> GQLError -> GQLError
fromValidationError :: forall (s :: Stage) ctx.
ValidatorContext s ctx -> GQLError -> GQLError
fromValidationError
context :: ValidatorContext s ctx
context@ValidatorContext
{ Config
config :: Config
config :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Config
config,
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope = Scope {Maybe Position
position :: Scope -> Maybe Position
position :: Maybe Position
position, [PropName]
path :: Scope -> [PropName]
path :: [PropName]
path}
}
GQLError
err
| GQLError -> Bool
isInternal GQLError
err Bool -> Bool -> Bool
|| Config -> Bool
debug Config
config =
( GQLError
err
forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage) ctx. ValidatorContext s ctx -> GQLError
renderContext ValidatorContext s ctx
context
forall (t :: * -> *).
Foldable t =>
GQLError -> t Position -> GQLError
`atPositions` Maybe Position
position
)
GQLError -> [PropName] -> GQLError
`withPath` [PropName]
path
| Bool
otherwise = GQLError
err
renderContext :: ValidatorContext s ctx -> GQLError
renderContext :: forall (s :: Stage) ctx. ValidatorContext s ctx -> GQLError
renderContext
ValidatorContext
{ Schema s
schema :: Schema s
schema :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Schema s
schema,
Scope
scope :: Scope
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope
} =
Scope -> GQLError
renderScope Scope
scope
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
"SchemaDefinition" Schema s
schema