{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.GraphQL.Validate
( Validation.Error(..)
, document
, module Language.GraphQL.Validate.Rules
) where
import Control.Monad (join)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (runReaderT)
import Data.Foldable (toList)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Sequence (Seq(..), (><), (|>))
import qualified Data.Sequence as Seq
import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation(..))
import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Internal as Type
import qualified Language.GraphQL.Type.In as In
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema (Schema)
import qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Validate.Rules
import Language.GraphQL.Validate.Validation (Validation(Validation))
import qualified Language.GraphQL.Validate.Validation as Validation
type ApplySelectionRule m a
= HashMap Full.Name (Schema.Type m)
-> Validation.Rule m
-> Maybe (Out.Type m)
-> a
-> Seq (Validation.RuleT m)
type ApplyRule m a = Validation.Rule m -> a -> Seq (Validation.RuleT m)
document :: forall m
. Schema m
-> [Validation.Rule m]
-> Full.Document
-> Seq Validation.Error
document :: Schema m -> [Rule m] -> Document -> Seq Error
document schema' :: Schema m
schema' rules' :: [Rule m]
rules' document' :: Document
document' =
ReaderT (Validation m) Seq Error -> Validation m -> Seq Error
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Validation m) Seq Error
reader Validation m
context
where
context :: Validation m
context = Validation :: forall (m :: * -> *). Document -> Schema m -> Validation m
Validation
{ ast :: Document
Validation.ast = Document
document'
, schema :: Schema m
Validation.schema = Schema m
schema'
}
reader :: ReaderT (Validation m) Seq Error
reader = do
Rule m
rule' <- Seq (Rule m) -> ReaderT (Validation m) Seq (Rule m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq (Rule m) -> ReaderT (Validation m) Seq (Rule m))
-> Seq (Rule m) -> ReaderT (Validation m) Seq (Rule m)
forall a b. (a -> b) -> a -> b
$ [Rule m] -> Seq (Rule m)
forall a. [a] -> Seq a
Seq.fromList [Rule m]
rules'
ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error))
-> Seq (ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq (ReaderT (Validation m) Seq Error)
forall a b. (a -> b) -> a -> b
$ (Definition
-> Seq (ReaderT (Validation m) Seq Error)
-> Seq (ReaderT (Validation m) Seq Error))
-> Seq (ReaderT (Validation m) Seq Error)
-> Document
-> Seq (ReaderT (Validation m) Seq Error)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Rule m
-> Validation m
-> Definition
-> Seq (ReaderT (Validation m) Seq Error)
-> Seq (ReaderT (Validation m) Seq Error)
forall (m :: * -> *).
Rule m
-> Validation m -> Definition -> Seq (RuleT m) -> Seq (RuleT m)
definition Rule m
rule' Validation m
context) Seq (ReaderT (Validation m) Seq Error)
forall a. Seq a
Seq.empty Document
document'
definition :: Validation.Rule m
-> Validation m
-> Full.Definition
-> Seq (Validation.RuleT m)
-> Seq (Validation.RuleT m)
definition :: Rule m
-> Validation m -> Definition -> Seq (RuleT m) -> Seq (RuleT m)
definition (Validation.DefinitionRule rule :: Definition -> RuleT m
rule) _ definition' :: Definition
definition' accumulator :: Seq (RuleT m)
accumulator =
Seq (RuleT m)
accumulator Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Definition -> RuleT m
rule Definition
definition'
definition rule :: Rule m
rule context :: Validation m
context (Full.ExecutableDefinition definition' :: ExecutableDefinition
definition') accumulator :: Seq (RuleT m)
accumulator =
Seq (RuleT m)
accumulator Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Rule m -> Validation m -> ExecutableDefinition -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Validation m -> ExecutableDefinition -> Seq (RuleT m)
executableDefinition Rule m
rule Validation m
context ExecutableDefinition
definition'
definition rule :: Rule m
rule context :: Validation m
context (Full.TypeSystemDefinition typeSystemDefinition' :: TypeSystemDefinition
typeSystemDefinition' _) accumulator :: Seq (RuleT m)
accumulator =
Seq (RuleT m)
accumulator Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m -> ApplyRule m TypeSystemDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m TypeSystemDefinition
typeSystemDefinition Validation m
context Rule m
rule TypeSystemDefinition
typeSystemDefinition'
definition rule :: Rule m
rule context :: Validation m
context (Full.TypeSystemExtension extension :: TypeSystemExtension
extension _) accumulator :: Seq (RuleT m)
accumulator =
Seq (RuleT m)
accumulator Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m -> ApplyRule m TypeSystemExtension
forall (m :: * -> *).
Validation m -> ApplyRule m TypeSystemExtension
typeSystemExtension Validation m
context Rule m
rule TypeSystemExtension
extension
typeSystemExtension :: forall m
. Validation m
-> ApplyRule m Full.TypeSystemExtension
typeSystemExtension :: Validation m -> ApplyRule m TypeSystemExtension
typeSystemExtension context :: Validation m
context rule :: Rule m
rule = \case
Full.SchemaExtension extension :: SchemaExtension
extension -> Validation m -> ApplyRule m SchemaExtension
forall (m :: * -> *). Validation m -> ApplyRule m SchemaExtension
schemaExtension Validation m
context Rule m
rule SchemaExtension
extension
Full.TypeExtension extension :: TypeExtension
extension -> Validation m -> ApplyRule m TypeExtension
forall (m :: * -> *). Validation m -> ApplyRule m TypeExtension
typeExtension Validation m
context Rule m
rule TypeExtension
extension
typeExtension :: forall m. Validation m -> ApplyRule m Full.TypeExtension
typeExtension :: Validation m -> ApplyRule m TypeExtension
typeExtension context :: Validation m
context rule :: Rule m
rule = \case
Full.ScalarTypeExtension _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
scalarLocation NonEmpty Directive
directives'
Full.ObjectTypeFieldsDefinitionExtension _ _ directives' :: [Directive]
directives' fields :: NonEmpty FieldDefinition
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
objectLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (FieldDefinition -> Seq (RuleT m))
-> NonEmpty FieldDefinition -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m FieldDefinition
forall (m :: * -> *). Validation m -> ApplyRule m FieldDefinition
fieldDefinition Validation m
context Rule m
rule) NonEmpty FieldDefinition
fields
Full.ObjectTypeDirectivesExtension _ _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
objectLocation NonEmpty Directive
directives'
Full.ObjectTypeImplementsInterfacesExtension _ _ -> Seq (RuleT m)
forall a. Monoid a => a
mempty
Full.InterfaceTypeFieldsDefinitionExtension _ directives' :: [Directive]
directives' fields :: NonEmpty FieldDefinition
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
interfaceLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (FieldDefinition -> Seq (RuleT m))
-> NonEmpty FieldDefinition -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m FieldDefinition
forall (m :: * -> *). Validation m -> ApplyRule m FieldDefinition
fieldDefinition Validation m
context Rule m
rule) NonEmpty FieldDefinition
fields
Full.InterfaceTypeDirectivesExtension _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
interfaceLocation NonEmpty Directive
directives'
Full.UnionTypeUnionMemberTypesExtension _ directives' :: [Directive]
directives' _ ->
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
unionLocation [Directive]
directives'
Full.UnionTypeDirectivesExtension _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
unionLocation NonEmpty Directive
directives'
Full.EnumTypeEnumValuesDefinitionExtension _ directives' :: [Directive]
directives' values :: NonEmpty EnumValueDefinition
values
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
enumLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (EnumValueDefinition -> Seq (RuleT m))
-> NonEmpty EnumValueDefinition -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m EnumValueDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m EnumValueDefinition
enumValueDefinition Validation m
context Rule m
rule) NonEmpty EnumValueDefinition
values
Full.EnumTypeDirectivesExtension _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
enumLocation NonEmpty Directive
directives'
Full.InputObjectTypeInputFieldsDefinitionExtension _ directives' :: [Directive]
directives' fields :: NonEmpty InputValueDefinition
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
inputObjectLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (InputValueDefinition -> Seq (RuleT m))
-> NonEmpty InputValueDefinition -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap InputValueDefinition -> Seq (RuleT m)
forEachInputFieldDefinition NonEmpty InputValueDefinition
fields
Full.InputObjectTypeDirectivesExtension _ directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
inputObjectLocation NonEmpty Directive
directives'
where
forEachInputFieldDefinition :: InputValueDefinition -> Seq (RuleT m)
forEachInputFieldDefinition =
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
forall (m :: * -> *).
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
inputValueDefinition Validation m
context Rule m
rule DirectiveLocation
inputFieldDefinitionLocation
schemaExtension :: forall m. Validation m -> ApplyRule m Full.SchemaExtension
schemaExtension :: Validation m -> ApplyRule m SchemaExtension
schemaExtension context :: Validation m
context rule :: Rule m
rule = \case
Full.SchemaOperationExtension directives' :: [Directive]
directives' _ ->
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
schemaLocation [Directive]
directives'
Full.SchemaDirectivesExtension directives' :: NonEmpty Directive
directives' ->
Validation m
-> Rule m
-> DirectiveLocation
-> NonEmpty Directive
-> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
schemaLocation NonEmpty Directive
directives'
schemaLocation :: DirectiveLocation
schemaLocation :: DirectiveLocation
schemaLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Schema
interfaceLocation :: DirectiveLocation
interfaceLocation :: DirectiveLocation
interfaceLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Interface
objectLocation :: DirectiveLocation
objectLocation :: DirectiveLocation
objectLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Object
unionLocation :: DirectiveLocation
unionLocation :: DirectiveLocation
unionLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Union
enumLocation :: DirectiveLocation
enumLocation :: DirectiveLocation
enumLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Enum
inputObjectLocation :: DirectiveLocation
inputObjectLocation :: DirectiveLocation
inputObjectLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.InputObject
scalarLocation :: DirectiveLocation
scalarLocation :: DirectiveLocation
scalarLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.Scalar
enumValueLocation :: DirectiveLocation
enumValueLocation :: DirectiveLocation
enumValueLocation = TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.EnumValue
fieldDefinitionLocation :: DirectiveLocation
fieldDefinitionLocation :: DirectiveLocation
fieldDefinitionLocation =
TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.FieldDefinition
inputFieldDefinitionLocation :: DirectiveLocation
inputFieldDefinitionLocation :: DirectiveLocation
inputFieldDefinitionLocation =
TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.InputFieldDefinition
argumentDefinitionLocation :: DirectiveLocation
argumentDefinitionLocation :: DirectiveLocation
argumentDefinitionLocation =
TypeSystemDirectiveLocation -> DirectiveLocation
TypeSystemDirectiveLocation TypeSystemDirectiveLocation
DirectiveLocation.ArgumentDefinition
queryLocation :: DirectiveLocation
queryLocation :: DirectiveLocation
queryLocation = ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.Query
mutationLocation :: DirectiveLocation
mutationLocation :: DirectiveLocation
mutationLocation = ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.Mutation
subscriptionLocation :: DirectiveLocation
subscriptionLocation :: DirectiveLocation
subscriptionLocation =
ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.Subscription
fieldLocation :: DirectiveLocation
fieldLocation :: DirectiveLocation
fieldLocation = ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.Field
fragmentDefinitionLocation :: DirectiveLocation
fragmentDefinitionLocation :: DirectiveLocation
fragmentDefinitionLocation =
ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.FragmentDefinition
fragmentSpreadLocation :: DirectiveLocation
fragmentSpreadLocation :: DirectiveLocation
fragmentSpreadLocation =
ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.FragmentSpread
inlineFragmentLocation :: DirectiveLocation
inlineFragmentLocation :: DirectiveLocation
inlineFragmentLocation =
ExecutableDirectiveLocation -> DirectiveLocation
ExecutableDirectiveLocation ExecutableDirectiveLocation
DirectiveLocation.InlineFragment
executableDefinition :: forall m
. Validation.Rule m
-> Validation m
-> Full.ExecutableDefinition
-> Seq (Validation.RuleT m)
executableDefinition :: Rule m -> Validation m -> ExecutableDefinition -> Seq (RuleT m)
executableDefinition rule :: Rule m
rule context :: Validation m
context (Full.DefinitionOperation operation :: OperationDefinition
operation) =
Rule m -> Validation m -> OperationDefinition -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Validation m -> OperationDefinition -> Seq (RuleT m)
operationDefinition Rule m
rule Validation m
context OperationDefinition
operation
executableDefinition rule :: Rule m
rule context :: Validation m
context (Full.DefinitionFragment fragment :: FragmentDefinition
fragment) =
Rule m -> Validation m -> FragmentDefinition -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Validation m -> FragmentDefinition -> Seq (RuleT m)
fragmentDefinition Rule m
rule Validation m
context FragmentDefinition
fragment
typeSystemDefinition :: forall m
. Validation m
-> ApplyRule m Full.TypeSystemDefinition
typeSystemDefinition :: Validation m -> ApplyRule m TypeSystemDefinition
typeSystemDefinition context :: Validation m
context rule :: Rule m
rule = \case
Full.SchemaDefinition directives' :: [Directive]
directives' _ ->
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
schemaLocation [Directive]
directives'
Full.TypeDefinition typeDefinition' :: TypeDefinition
typeDefinition' ->
Validation m -> ApplyRule m TypeDefinition
forall (m :: * -> *). Validation m -> ApplyRule m TypeDefinition
typeDefinition Validation m
context Rule m
rule TypeDefinition
typeDefinition'
Full.DirectiveDefinition _ _ arguments' :: ArgumentsDefinition
arguments' _ ->
Validation m -> ApplyRule m ArgumentsDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m ArgumentsDefinition
argumentsDefinition Validation m
context Rule m
rule ArgumentsDefinition
arguments'
typeDefinition :: forall m. Validation m -> ApplyRule m Full.TypeDefinition
typeDefinition :: Validation m -> ApplyRule m TypeDefinition
typeDefinition context :: Validation m
context rule :: Rule m
rule = \case
Full.ScalarTypeDefinition _ _ directives' :: [Directive]
directives' ->
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
scalarLocation [Directive]
directives'
Full.ObjectTypeDefinition _ _ _ directives' :: [Directive]
directives' fields :: [FieldDefinition]
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
objectLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (FieldDefinition -> Seq (RuleT m))
-> [FieldDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m FieldDefinition
forall (m :: * -> *). Validation m -> ApplyRule m FieldDefinition
fieldDefinition Validation m
context Rule m
rule) [FieldDefinition]
fields
Full.InterfaceTypeDefinition _ _ directives' :: [Directive]
directives' fields :: [FieldDefinition]
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
interfaceLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (FieldDefinition -> Seq (RuleT m))
-> [FieldDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m FieldDefinition
forall (m :: * -> *). Validation m -> ApplyRule m FieldDefinition
fieldDefinition Validation m
context Rule m
rule) [FieldDefinition]
fields
Full.UnionTypeDefinition _ _ directives' :: [Directive]
directives' _ ->
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
unionLocation [Directive]
directives'
Full.EnumTypeDefinition _ _ directives' :: [Directive]
directives' values :: [EnumValueDefinition]
values
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
enumLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< (EnumValueDefinition -> Seq (RuleT m))
-> [EnumValueDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m EnumValueDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m EnumValueDefinition
enumValueDefinition Validation m
context Rule m
rule) [EnumValueDefinition]
values
Full.InputObjectTypeDefinition _ _ directives' :: [Directive]
directives' fields :: [InputValueDefinition]
fields
-> Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
inputObjectLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Semigroup a => a -> a -> a
<> (InputValueDefinition -> Seq (RuleT m))
-> [InputValueDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap InputValueDefinition -> Seq (RuleT m)
forEachInputFieldDefinition [InputValueDefinition]
fields
where
forEachInputFieldDefinition :: InputValueDefinition -> Seq (RuleT m)
forEachInputFieldDefinition =
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
forall (m :: * -> *).
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
inputValueDefinition Validation m
context Rule m
rule DirectiveLocation
inputFieldDefinitionLocation
enumValueDefinition :: forall m
. Validation m
-> ApplyRule m Full.EnumValueDefinition
enumValueDefinition :: Validation m -> ApplyRule m EnumValueDefinition
enumValueDefinition context :: Validation m
context rule :: Rule m
rule (Full.EnumValueDefinition _ _ directives' :: [Directive]
directives') =
Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
enumValueLocation [Directive]
directives'
fieldDefinition :: forall m. Validation m -> ApplyRule m Full.FieldDefinition
fieldDefinition :: Validation m -> ApplyRule m FieldDefinition
fieldDefinition context :: Validation m
context rule :: Rule m
rule (Full.FieldDefinition _ _ arguments' :: ArgumentsDefinition
arguments' _ directives' :: [Directive]
directives')
= Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
fieldDefinitionLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m -> ApplyRule m ArgumentsDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m ArgumentsDefinition
argumentsDefinition Validation m
context Rule m
rule ArgumentsDefinition
arguments'
argumentsDefinition :: forall m
. Validation m
-> ApplyRule m Full.ArgumentsDefinition
argumentsDefinition :: Validation m -> ApplyRule m ArgumentsDefinition
argumentsDefinition context :: Validation m
context rule :: Rule m
rule (Full.ArgumentsDefinition definitions :: [InputValueDefinition]
definitions) =
(InputValueDefinition -> Seq (RuleT m))
-> [InputValueDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap InputValueDefinition -> Seq (RuleT m)
forEachArgument [InputValueDefinition]
definitions
where
forEachArgument :: InputValueDefinition -> Seq (RuleT m)
forEachArgument =
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
forall (m :: * -> *).
Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
inputValueDefinition Validation m
context Rule m
rule DirectiveLocation
argumentDefinitionLocation
inputValueDefinition :: forall m
. Validation m
-> Validation.Rule m
-> DirectiveLocation
-> Full.InputValueDefinition
-> Seq (Validation.RuleT m)
inputValueDefinition :: Validation m
-> Rule m
-> DirectiveLocation
-> InputValueDefinition
-> Seq (RuleT m)
inputValueDefinition context :: Validation m
context rule :: Rule m
rule directiveLocation :: DirectiveLocation
directiveLocation definition' :: InputValueDefinition
definition' =
let Full.InputValueDefinition _ _ _ _ directives' :: [Directive]
directives' = InputValueDefinition
definition'
in Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
directiveLocation [Directive]
directives'
operationDefinition :: forall m
. Validation.Rule m
-> Validation m
-> Full.OperationDefinition
-> Seq (Validation.RuleT m)
operationDefinition :: Rule m -> Validation m -> OperationDefinition -> Seq (RuleT m)
operationDefinition rule :: Rule m
rule context :: Validation m
context operation :: OperationDefinition
operation
| Validation.OperationDefinitionRule operationRule :: OperationDefinition -> RuleT m
operationRule <- Rule m
rule =
RuleT m -> Seq (RuleT m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleT m -> Seq (RuleT m)) -> RuleT m -> Seq (RuleT m)
forall a b. (a -> b) -> a -> b
$ OperationDefinition -> RuleT m
operationRule OperationDefinition
operation
| Validation.VariablesRule variablesRule :: [VariableDefinition] -> RuleT m
variablesRule <- Rule m
rule
, Full.OperationDefinition _ _ variables :: [VariableDefinition]
variables _ _ _ <- OperationDefinition
operation =
(VariableDefinition -> Seq (RuleT m))
-> [VariableDefinition] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m VariableDefinition
forall (m :: * -> *).
Validation m -> ApplyRule m VariableDefinition
variableDefinition Validation m
context Rule m
rule) [VariableDefinition]
variables Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> [VariableDefinition] -> RuleT m
variablesRule [VariableDefinition]
variables
| Full.SelectionSet selections :: SelectionSet
selections _ <- OperationDefinition
operation =
Validation m -> ApplySelectionRule m SelectionSet
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
queryRoot SelectionSet
selections
| Full.OperationDefinition Full.Query _ _ directives' :: [Directive]
directives' selections :: SelectionSet
selections _ <- OperationDefinition
operation
= Validation m -> ApplySelectionRule m SelectionSet
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
queryRoot SelectionSet
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
queryLocation [Directive]
directives'
| Full.OperationDefinition Full.Mutation _ _ directives' :: [Directive]
directives' selections :: SelectionSet
selections _ <- OperationDefinition
operation =
let root :: Maybe (Type m)
root = ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType m -> Type m) -> Maybe (ObjectType m) -> Maybe (Type m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema'
in Validation m -> ApplySelectionRule m SelectionSet
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
root SelectionSet
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
mutationLocation [Directive]
directives'
| Full.OperationDefinition Full.Subscription _ _ directives' :: [Directive]
directives' selections :: SelectionSet
selections _ <- OperationDefinition
operation =
let root :: Maybe (Type m)
root = ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType m -> Type m) -> Maybe (ObjectType m) -> Maybe (Type m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema'
in Validation m -> ApplySelectionRule m SelectionSet
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
root SelectionSet
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
subscriptionLocation [Directive]
directives'
where
schema' :: Schema m
schema' = Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
Validation.schema Validation m
context
queryRoot :: Maybe (Type m)
queryRoot = Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType (ObjectType m -> Type m) -> ObjectType m -> Type m
forall a b. (a -> b) -> a -> b
$ Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
types' :: HashMap Name (Type m)
types' = Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types Schema m
schema'
typeToOut :: forall m. Schema.Type m -> Maybe (Out.Type m)
typeToOut :: Type m -> Maybe (Type m)
typeToOut (Schema.ObjectType objectType :: ObjectType m
objectType) =
Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Out.NamedObjectType ObjectType m
objectType
typeToOut (Schema.InterfaceType interfaceType :: InterfaceType m
interfaceType) =
Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ InterfaceType m -> Type m
forall (m :: * -> *). InterfaceType m -> Type m
Out.NamedInterfaceType InterfaceType m
interfaceType
typeToOut (Schema.UnionType unionType :: UnionType m
unionType) = Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ UnionType m -> Type m
forall (m :: * -> *). UnionType m -> Type m
Out.NamedUnionType UnionType m
unionType
typeToOut (Schema.EnumType enumType :: EnumType
enumType) = Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ EnumType -> Type m
forall (m :: * -> *). EnumType -> Type m
Out.NamedEnumType EnumType
enumType
typeToOut (Schema.ScalarType scalarType :: ScalarType
scalarType) = Type m -> Maybe (Type m)
forall a. a -> Maybe a
Just (Type m -> Maybe (Type m)) -> Type m -> Maybe (Type m)
forall a b. (a -> b) -> a -> b
$ ScalarType -> Type m
forall (m :: * -> *). ScalarType -> Type m
Out.NamedScalarType ScalarType
scalarType
typeToOut _ = Maybe (Type m)
forall a. Maybe a
Nothing
variableDefinition :: forall m
. Validation m
-> ApplyRule m Full.VariableDefinition
variableDefinition :: Validation m -> ApplyRule m VariableDefinition
variableDefinition context :: Validation m
context rule :: Rule m
rule (Full.VariableDefinition _ typeName :: Type
typeName value' :: Maybe (Node ConstValue)
value' _)
| Just defaultValue' :: Node ConstValue
defaultValue' <- Maybe (Node ConstValue)
value'
, HashMap Name (Type m)
types <- Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types (Schema m -> HashMap Name (Type m))
-> Schema m -> HashMap Name (Type m)
forall a b. (a -> b) -> a -> b
$ Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
Validation.schema Validation m
context
, Maybe Type
variableType <- Type -> HashMap Name (Type m) -> Maybe Type
forall (m :: * -> *). Type -> HashMap Name (Type m) -> Maybe Type
Type.lookupInputType Type
typeName HashMap Name (Type m)
types =
Rule m -> Maybe Type -> Node ConstValue -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Maybe Type -> Node ConstValue -> Seq (RuleT m)
constValue Rule m
rule Maybe Type
variableType Node ConstValue
defaultValue'
variableDefinition _ _ _ = Seq (RuleT m)
forall a. Monoid a => a
mempty
constValue :: forall m
. Validation.Rule m
-> Maybe In.Type
-> Full.Node Full.ConstValue
-> Seq (Validation.RuleT m)
constValue :: Rule m -> Maybe Type -> Node ConstValue -> Seq (RuleT m)
constValue (Validation.ValueRule _ rule :: Maybe Type -> Node ConstValue -> RuleT m
rule) valueType :: Maybe Type
valueType = Maybe Type -> Node ConstValue -> Seq (RuleT m)
go Maybe Type
valueType
where
go :: Maybe Type -> Node ConstValue -> Seq (RuleT m)
go inputObjectType :: Maybe Type
inputObjectType value' :: Node ConstValue
value'@(Full.Node (Full.ConstObject fields :: [ObjectField ConstValue]
fields) _)
= (ObjectField ConstValue -> Seq (RuleT m))
-> Seq (ObjectField ConstValue) -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Type -> ObjectField ConstValue -> Seq (RuleT m)
forEach Maybe Type
inputObjectType) ([ObjectField ConstValue] -> Seq (ObjectField ConstValue)
forall a. [a] -> Seq a
Seq.fromList [ObjectField ConstValue]
fields)
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe Type -> Node ConstValue -> RuleT m
rule Maybe Type
inputObjectType Node ConstValue
value'
go listType :: Maybe Type
listType value' :: Node ConstValue
value'@(Full.Node (Full.ConstList values :: [ConstValue]
values) location' :: Location
location')
= (Maybe Type -> Node ConstValue -> Seq (RuleT m))
-> Maybe Type -> [ConstValue] -> Location -> Seq (RuleT m)
forall a m.
(Maybe Type -> Node a -> Seq m)
-> Maybe Type -> [a] -> Location -> Seq m
embedListLocation Maybe Type -> Node ConstValue -> Seq (RuleT m)
go Maybe Type
listType [ConstValue]
values Location
location'
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe Type -> Node ConstValue -> RuleT m
rule Maybe Type
listType Node ConstValue
value'
go anotherValue :: Maybe Type
anotherValue value' :: Node ConstValue
value' = RuleT m -> Seq (RuleT m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleT m -> Seq (RuleT m)) -> RuleT m -> Seq (RuleT m)
forall a b. (a -> b) -> a -> b
$ Maybe Type -> Node ConstValue -> RuleT m
rule Maybe Type
anotherValue Node ConstValue
value'
forEach :: Maybe Type -> ObjectField ConstValue -> Seq (RuleT m)
forEach inputObjectType :: Maybe Type
inputObjectType Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', ..} =
Maybe Type -> Node ConstValue -> Seq (RuleT m)
go (Name -> Maybe Type -> Maybe Type
valueTypeByName Name
name Maybe Type
inputObjectType) Node ConstValue
value'
constValue _ _ = Seq (RuleT m) -> Node ConstValue -> Seq (RuleT m)
forall a b. a -> b -> a
const Seq (RuleT m)
forall a. Monoid a => a
mempty
inputFieldType :: In.InputField -> In.Type
inputFieldType :: InputField -> Type
inputFieldType (In.InputField _ inputFieldType' :: Type
inputFieldType' _) = Type
inputFieldType'
valueTypeByName :: Full.Name -> Maybe In.Type -> Maybe In.Type
valueTypeByName :: Name -> Maybe Type -> Maybe Type
valueTypeByName fieldName :: Name
fieldName (Just( In.InputObjectBaseType inputObjectType :: InputObjectType
inputObjectType)) =
let In.InputObjectType _ _ fieldTypes :: HashMap Name InputField
fieldTypes = InputObjectType
inputObjectType
in InputField -> Type
inputFieldType (InputField -> Type) -> Maybe InputField -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> HashMap Name InputField -> Maybe InputField
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
fieldName HashMap Name InputField
fieldTypes
valueTypeByName _ _ = Maybe Type
forall a. Maybe a
Nothing
fragmentDefinition :: forall m
. Validation.Rule m
-> Validation m
-> Full.FragmentDefinition
-> Seq (Validation.RuleT m)
fragmentDefinition :: Rule m -> Validation m -> FragmentDefinition -> Seq (RuleT m)
fragmentDefinition (Validation.FragmentDefinitionRule rule :: FragmentDefinition -> RuleT m
rule) _ definition' :: FragmentDefinition
definition' =
RuleT m -> Seq (RuleT m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleT m -> Seq (RuleT m)) -> RuleT m -> Seq (RuleT m)
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> RuleT m
rule FragmentDefinition
definition'
fragmentDefinition rule :: Rule m
rule context :: Validation m
context definition' :: FragmentDefinition
definition'
| Full.FragmentDefinition _ typeCondition :: Name
typeCondition directives' :: [Directive]
directives' selections :: SelectionSet
selections _ <- FragmentDefinition
definition'
, Validation.FragmentRule definitionRule :: FragmentDefinition -> RuleT m
definitionRule _ <- Rule m
rule
= Name -> [Directive] -> SelectionSet -> Seq (RuleT m)
forall (t :: * -> *) (t :: * -> *).
(Traversable t, Traversable t) =>
Name -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren Name
typeCondition [Directive]
directives' SelectionSet
selections
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> FragmentDefinition -> RuleT m
definitionRule FragmentDefinition
definition'
| Full.FragmentDefinition _ typeCondition :: Name
typeCondition directives' :: [Directive]
directives' selections :: SelectionSet
selections _ <- FragmentDefinition
definition'
= Name -> [Directive] -> SelectionSet -> Seq (RuleT m)
forall (t :: * -> *) (t :: * -> *).
(Traversable t, Traversable t) =>
Name -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren Name
typeCondition [Directive]
directives' SelectionSet
selections
where
types' :: HashMap Name (Type m)
types' = Schema m -> HashMap Name (Type m)
forall (m :: * -> *). Schema m -> HashMap Name (Type m)
Schema.types (Schema m -> HashMap Name (Type m))
-> Schema m -> HashMap Name (Type m)
forall a b. (a -> b) -> a -> b
$ Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
Validation.schema Validation m
context
applyToChildren :: Name -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren typeCondition :: Name
typeCondition directives' :: t Directive
directives' selections :: t Selection
selections
= Validation m -> ApplySelectionRule m (t Selection)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule (Name -> Maybe (Type m)
lookupType' Name
typeCondition) t Selection
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
fragmentDefinitionLocation t Directive
directives'
lookupType' :: Name -> Maybe (Type m)
lookupType' = (Name -> HashMap Name (Type m) -> Maybe (Type m))
-> HashMap Name (Type m) -> Name -> Maybe (Type m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> HashMap Name (Type m) -> Maybe (Type m)
forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (Type m)
lookupType HashMap Name (Type m)
types'
lookupType :: forall m
. Full.TypeCondition
-> HashMap Full.Name (Schema.Type m)
-> Maybe (Out.Type m)
lookupType :: Name -> HashMap Name (Type m) -> Maybe (Type m)
lookupType typeCondition :: Name
typeCondition types' :: HashMap Name (Type m)
types' = Name -> HashMap Name (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
typeCondition HashMap Name (Type m)
types'
Maybe (Type m) -> (Type m -> Maybe (Type m)) -> Maybe (Type m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Type m -> Maybe (Type m)
forall (m :: * -> *). Type m -> Maybe (Type m)
typeToOut
selectionSet :: Traversable t
=> forall m
. Validation m
-> ApplySelectionRule m (t Full.Selection)
selectionSet :: forall (m :: * -> *).
Validation m -> ApplySelectionRule m (t Selection)
selectionSet context :: Validation m
context types' :: HashMap Name (Type m)
types' rule :: Rule m
rule = (Selection -> Seq (RuleT m)) -> t Selection -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Selection -> Seq (RuleT m)) -> t Selection -> Seq (RuleT m))
-> (Maybe (Type m) -> Selection -> Seq (RuleT m))
-> Maybe (Type m)
-> t Selection
-> Seq (RuleT m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> ApplySelectionRule m Selection
forall (m :: * -> *).
Validation m -> ApplySelectionRule m Selection
selection Validation m
context HashMap Name (Type m)
types' Rule m
rule
selection :: forall m. Validation m -> ApplySelectionRule m Full.Selection
selection :: Validation m -> ApplySelectionRule m Selection
selection context :: Validation m
context types' :: HashMap Name (Type m)
types' rule :: Rule m
rule objectType :: Maybe (Type m)
objectType selection' :: Selection
selection'
| Validation.SelectionRule selectionRule :: Maybe (Type m) -> Selection -> RuleT m
selectionRule <- Rule m
rule =
Seq (RuleT m)
applyToChildren Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe (Type m) -> Selection -> RuleT m
selectionRule Maybe (Type m)
objectType Selection
selection'
| Bool
otherwise = Seq (RuleT m)
applyToChildren
where
applyToChildren :: Seq (RuleT m)
applyToChildren =
case Selection
selection' of
Full.FieldSelection field' :: Field
field' ->
Validation m -> ApplySelectionRule m Field
forall (m :: * -> *). Validation m -> ApplySelectionRule m Field
field Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType Field
field'
Full.InlineFragmentSelection inlineFragment' :: InlineFragment
inlineFragment' ->
Validation m -> ApplySelectionRule m InlineFragment
forall (m :: * -> *).
Validation m -> ApplySelectionRule m InlineFragment
inlineFragment Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType InlineFragment
inlineFragment'
Full.FragmentSpreadSelection fragmentSpread' :: FragmentSpread
fragmentSpread' ->
Validation m -> ApplyRule m FragmentSpread
forall (m :: * -> *). Validation m -> ApplyRule m FragmentSpread
fragmentSpread Validation m
context Rule m
rule FragmentSpread
fragmentSpread'
field :: forall m. Validation m -> ApplySelectionRule m Full.Field
field :: Validation m -> ApplySelectionRule m Field
field context :: Validation m
context types' :: HashMap Name (Type m)
types' rule :: Rule m
rule objectType :: Maybe (Type m)
objectType field' :: Field
field' = Field -> Seq (RuleT m)
go Field
field'
where
go :: Field -> Seq (RuleT m)
go (Full.Field _ fieldName :: Name
fieldName _ _ _ _)
| Validation.FieldRule fieldRule :: Maybe (Type m) -> Field -> RuleT m
fieldRule <- Rule m
rule =
Name -> Seq (RuleT m)
applyToChildren Name
fieldName Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe (Type m) -> Field -> RuleT m
fieldRule Maybe (Type m)
objectType Field
field'
| Validation.ArgumentsRule argumentsRule :: Maybe (Type m) -> Field -> RuleT m
argumentsRule _ <- Rule m
rule =
Name -> Seq (RuleT m)
applyToChildren Name
fieldName Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe (Type m) -> Field -> RuleT m
argumentsRule Maybe (Type m)
objectType Field
field'
| Bool
otherwise = Name -> Seq (RuleT m)
applyToChildren Name
fieldName
typeFieldType :: Field m -> Type m
typeFieldType (Out.Field _ type' :: Type m
type' _) = Type m
type'
typeFieldArguments :: Field m -> Arguments
typeFieldArguments (Out.Field _ _ argumentTypes :: Arguments
argumentTypes) = Arguments
argumentTypes
applyToChildren :: Name -> Seq (RuleT m)
applyToChildren fieldName :: Name
fieldName =
let Full.Field _ _ arguments' :: [Argument]
arguments' directives' :: [Directive]
directives' selections :: SelectionSetOpt
selections _ = Field
field'
typeField :: Maybe (Field m)
typeField = Maybe (Type m)
objectType Maybe (Type m) -> (Type m -> Maybe (Field m)) -> Maybe (Field m)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> Type m -> Maybe (Field m)
forall (a :: * -> *). Name -> Type a -> Maybe (Field a)
Type.lookupTypeField Name
fieldName
argumentTypes :: Arguments
argumentTypes = Arguments -> (Field m -> Arguments) -> Maybe (Field m) -> Arguments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Arguments
forall a. Monoid a => a
mempty Field m -> Arguments
forall (m :: * -> *). Field m -> Arguments
typeFieldArguments Maybe (Field m)
typeField
in Validation m -> ApplySelectionRule m SelectionSetOpt
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule (Field m -> Type m
forall (m :: * -> *). Field m -> Type m
typeFieldType (Field m -> Type m) -> Maybe (Field m) -> Maybe (Type m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Field m)
typeField) SelectionSetOpt
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
fieldLocation [Directive]
directives'
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Rule m -> Arguments -> [Argument] -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Arguments -> [Argument] -> Seq (RuleT m)
arguments Rule m
rule Arguments
argumentTypes [Argument]
arguments'
arguments :: forall m
. Validation.Rule m
-> In.Arguments
-> [Full.Argument]
-> Seq (Validation.RuleT m)
arguments :: Rule m -> Arguments -> [Argument] -> Seq (RuleT m)
arguments rule :: Rule m
rule argumentTypes :: Arguments
argumentTypes = (Argument -> Seq (RuleT m)) -> Seq Argument -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Argument -> Seq (RuleT m)
forEach (Seq Argument -> Seq (RuleT m))
-> ([Argument] -> Seq Argument) -> [Argument] -> Seq (RuleT m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Argument] -> Seq Argument
forall a. [a] -> Seq a
Seq.fromList
where
forEach :: Argument -> Seq (RuleT m)
forEach argument' :: Argument
argument'@(Full.Argument argumentName :: Name
argumentName _ _) =
let argumentType :: Maybe Argument
argumentType = Name -> Arguments -> Maybe Argument
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
argumentName Arguments
argumentTypes
in Rule m -> Maybe Argument -> Argument -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Maybe Argument -> Argument -> Seq (RuleT m)
argument Rule m
rule Maybe Argument
argumentType Argument
argument'
argument :: forall m
. Validation.Rule m
-> Maybe In.Argument
-> Full.Argument
-> Seq (Validation.RuleT m)
argument :: Rule m -> Maybe Argument -> Argument -> Seq (RuleT m)
argument rule :: Rule m
rule argumentType :: Maybe Argument
argumentType (Full.Argument _ value' :: Node Value
value' _) =
Rule m -> Maybe Type -> Node Value -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Maybe Type -> Node Value -> Seq (RuleT m)
value Rule m
rule (Argument -> Type
valueType (Argument -> Type) -> Maybe Argument -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Argument
argumentType) Node Value
value'
where
valueType :: Argument -> Type
valueType (In.Argument _ valueType' :: Type
valueType' _) = Type
valueType'
embedListLocation :: forall a m
. (Maybe In.Type -> Full.Node a -> Seq m)
-> Maybe In.Type
-> [a]
-> Full.Location
-> Seq m
embedListLocation :: (Maybe Type -> Node a -> Seq m)
-> Maybe Type -> [a] -> Location -> Seq m
embedListLocation go :: Maybe Type -> Node a -> Seq m
go listType :: Maybe Type
listType values :: [a]
values location' :: Location
location'
= (Node a -> Seq m) -> Seq (Node a) -> Seq m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Type -> Node a -> Seq m
go (Maybe Type -> Node a -> Seq m) -> Maybe Type -> Node a -> Seq m
forall a b. (a -> b) -> a -> b
$ Maybe Type -> Maybe Type
valueTypeFromList Maybe Type
listType)
(Seq (Node a) -> Seq m) -> Seq (Node a) -> Seq m
forall a b. (a -> b) -> a -> b
$ (a -> Location -> Node a) -> Location -> a -> Node a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Location -> Node a
forall a. a -> Location -> Node a
Full.Node Location
location' (a -> Node a) -> Seq a -> Seq (Node a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
values
where
valueTypeFromList :: Maybe Type -> Maybe Type
valueTypeFromList (Just (In.ListBaseType baseType :: Type
baseType)) = Type -> Maybe Type
forall a. a -> Maybe a
Just Type
baseType
valueTypeFromList _ = Maybe Type
forall a. Maybe a
Nothing
value :: forall m
. Validation.Rule m
-> Maybe In.Type
-> Full.Node Full.Value
-> Seq (Validation.RuleT m)
value :: Rule m -> Maybe Type -> Node Value -> Seq (RuleT m)
value (Validation.ValueRule rule :: Maybe Type -> Node Value -> RuleT m
rule _) valueType :: Maybe Type
valueType = Maybe Type -> Node Value -> Seq (RuleT m)
go Maybe Type
valueType
where
go :: Maybe Type -> Node Value -> Seq (RuleT m)
go inputObjectType :: Maybe Type
inputObjectType value' :: Node Value
value'@(Full.Node (Full.Object fields :: [ObjectField Value]
fields) _)
= (ObjectField Value -> Seq (RuleT m))
-> Seq (ObjectField Value) -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Type -> ObjectField Value -> Seq (RuleT m)
forEach Maybe Type
inputObjectType) ([ObjectField Value] -> Seq (ObjectField Value)
forall a. [a] -> Seq a
Seq.fromList [ObjectField Value]
fields)
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe Type -> Node Value -> RuleT m
rule Maybe Type
inputObjectType Node Value
value'
go listType :: Maybe Type
listType value' :: Node Value
value'@(Full.Node (Full.List values :: [Value]
values) location' :: Location
location')
= (Maybe Type -> Node Value -> Seq (RuleT m))
-> Maybe Type -> [Value] -> Location -> Seq (RuleT m)
forall a m.
(Maybe Type -> Node a -> Seq m)
-> Maybe Type -> [a] -> Location -> Seq m
embedListLocation Maybe Type -> Node Value -> Seq (RuleT m)
go Maybe Type
listType [Value]
values Location
location'
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> Maybe Type -> Node Value -> RuleT m
rule Maybe Type
listType Node Value
value'
go anotherValue :: Maybe Type
anotherValue value' :: Node Value
value' = RuleT m -> Seq (RuleT m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleT m -> Seq (RuleT m)) -> RuleT m -> Seq (RuleT m)
forall a b. (a -> b) -> a -> b
$ Maybe Type -> Node Value -> RuleT m
rule Maybe Type
anotherValue Node Value
value'
forEach :: Maybe Type -> ObjectField Value -> Seq (RuleT m)
forEach inputObjectType :: Maybe Type
inputObjectType Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node Value
value', ..} =
Maybe Type -> Node Value -> Seq (RuleT m)
go (Name -> Maybe Type -> Maybe Type
valueTypeByName Name
name Maybe Type
inputObjectType) Node Value
value'
value _ _ = Seq (RuleT m) -> Node Value -> Seq (RuleT m)
forall a b. a -> b -> a
const Seq (RuleT m)
forall a. Monoid a => a
mempty
inlineFragment :: forall m
. Validation m
-> ApplySelectionRule m Full.InlineFragment
inlineFragment :: Validation m -> ApplySelectionRule m InlineFragment
inlineFragment context :: Validation m
context types' :: HashMap Name (Type m)
types' rule :: Rule m
rule objectType :: Maybe (Type m)
objectType inlineFragment' :: InlineFragment
inlineFragment' =
InlineFragment -> Seq (RuleT m)
go InlineFragment
inlineFragment'
where
go :: InlineFragment -> Seq (RuleT m)
go (Full.InlineFragment optionalType :: Maybe Name
optionalType directives' :: [Directive]
directives' selections :: SelectionSet
selections _)
| Validation.FragmentRule _ fragmentRule :: InlineFragment -> RuleT m
fragmentRule <- Rule m
rule
= Maybe (Type m) -> [Directive] -> SelectionSet -> Seq (RuleT m)
forall (t :: * -> *) (t :: * -> *).
(Traversable t, Traversable t) =>
Maybe (Type m) -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren (Maybe Name -> Maybe (Type m)
refineTarget Maybe Name
optionalType) [Directive]
directives' SelectionSet
selections
Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> InlineFragment -> RuleT m
fragmentRule InlineFragment
inlineFragment'
| Bool
otherwise = Maybe (Type m) -> [Directive] -> SelectionSet -> Seq (RuleT m)
forall (t :: * -> *) (t :: * -> *).
(Traversable t, Traversable t) =>
Maybe (Type m) -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren (Maybe Name -> Maybe (Type m)
refineTarget Maybe Name
optionalType) [Directive]
directives' SelectionSet
selections
refineTarget :: Maybe Name -> Maybe (Type m)
refineTarget (Just typeCondition :: Name
typeCondition) = Name -> HashMap Name (Type m) -> Maybe (Type m)
forall (m :: * -> *).
Name -> HashMap Name (Type m) -> Maybe (Type m)
lookupType Name
typeCondition HashMap Name (Type m)
types'
refineTarget Nothing = Maybe (Type m)
objectType
applyToChildren :: Maybe (Type m) -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren objectType' :: Maybe (Type m)
objectType' directives' :: t Directive
directives' selections :: t Selection
selections
= Validation m -> ApplySelectionRule m (t Selection)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m -> ApplySelectionRule m (t Selection)
selectionSet Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType' t Selection
selections
Seq (RuleT m) -> Seq (RuleT m) -> Seq (RuleT m)
forall a. Seq a -> Seq a -> Seq a
>< Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
inlineFragmentLocation t Directive
directives'
fragmentSpread :: forall m. Validation m -> ApplyRule m Full.FragmentSpread
fragmentSpread :: Validation m -> ApplyRule m FragmentSpread
fragmentSpread context :: Validation m
context rule :: Rule m
rule fragmentSpread' :: FragmentSpread
fragmentSpread'@(Full.FragmentSpread _ directives' :: [Directive]
directives' _)
| Validation.FragmentSpreadRule fragmentRule :: FragmentSpread -> RuleT m
fragmentRule <- Rule m
rule =
Seq (RuleT m)
applyToChildren Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> FragmentSpread -> RuleT m
fragmentRule FragmentSpread
fragmentSpread'
| Bool
otherwise = Seq (RuleT m)
applyToChildren
where
applyToChildren :: Seq (RuleT m)
applyToChildren = Validation m
-> Rule m -> DirectiveLocation -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) (m :: * -> *).
Traversable t =>
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives Validation m
context Rule m
rule DirectiveLocation
fragmentSpreadLocation [Directive]
directives'
directives :: Traversable t
=> forall m
. Validation m
-> Validation.Rule m
-> DirectiveLocation
-> t Full.Directive
-> Seq (Validation.RuleT m)
directives :: forall (m :: * -> *).
Validation m
-> Rule m -> DirectiveLocation -> t Directive -> Seq (RuleT m)
directives context :: Validation m
context rule :: Rule m
rule directiveLocation :: DirectiveLocation
directiveLocation directives' :: t Directive
directives'
| Validation.DirectivesRule directivesRule :: DirectiveLocation -> [Directive] -> RuleT m
directivesRule <- Rule m
rule =
Seq (RuleT m)
applyToChildren Seq (RuleT m) -> RuleT m -> Seq (RuleT m)
forall a. Seq a -> a -> Seq a
|> DirectiveLocation -> [Directive] -> RuleT m
directivesRule DirectiveLocation
directiveLocation [Directive]
directiveList
| Bool
otherwise = Seq (RuleT m)
applyToChildren
where
directiveList :: [Directive]
directiveList = t Directive -> [Directive]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Directive
directives'
applyToChildren :: Seq (RuleT m)
applyToChildren = (Directive -> Seq (RuleT m)) -> [Directive] -> Seq (RuleT m)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Validation m -> ApplyRule m Directive
forall (m :: * -> *). Validation m -> ApplyRule m Directive
directive Validation m
context Rule m
rule) [Directive]
directiveList
directive :: forall m. Validation m -> ApplyRule m Full.Directive
directive :: Validation m -> ApplyRule m Directive
directive _ (Validation.ArgumentsRule _ argumentsRule :: Directive -> RuleT m
argumentsRule) directive' :: Directive
directive' =
RuleT m -> Seq (RuleT m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RuleT m -> Seq (RuleT m)) -> RuleT m -> Seq (RuleT m)
forall a b. (a -> b) -> a -> b
$ Directive -> RuleT m
argumentsRule Directive
directive'
directive context :: Validation m
context rule :: Rule m
rule (Full.Directive directiveName :: Name
directiveName arguments' :: [Argument]
arguments' _) =
let argumentTypes :: Arguments
argumentTypes = Arguments
-> (Directive -> Arguments) -> Maybe Directive -> Arguments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Arguments
forall k v. HashMap k v
HashMap.empty Directive -> Arguments
directiveArguments
(Maybe Directive -> Arguments) -> Maybe Directive -> Arguments
forall a b. (a -> b) -> a -> b
$ Name -> HashMap Name Directive -> Maybe Directive
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
directiveName
(HashMap Name Directive -> Maybe Directive)
-> HashMap Name Directive -> Maybe Directive
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Name Directive
forall (m :: * -> *). Schema m -> HashMap Name Directive
Schema.directives
(Schema m -> HashMap Name Directive)
-> Schema m -> HashMap Name Directive
forall a b. (a -> b) -> a -> b
$ Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
Validation.schema Validation m
context
in Rule m -> Arguments -> [Argument] -> Seq (RuleT m)
forall (m :: * -> *).
Rule m -> Arguments -> [Argument] -> Seq (RuleT m)
arguments Rule m
rule Arguments
argumentTypes [Argument]
arguments'
where
directiveArguments :: Directive -> Arguments
directiveArguments (Schema.Directive _ _ argumentTypes :: Arguments
argumentTypes) = Arguments
argumentTypes