{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | GraphQL validator.
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)

-- | Validates a document and returns a list of found errors. If the returned
-- list is empty, the document is valid.
document :: forall m
    . Schema m
    -> [Validation.Rule m]
    -> Full.Document
    -> Seq Validation.Error
document :: Schema m -> [Rule m] -> Document -> Seq Error
document Schema m
schema' [Rule m]
rules' 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 Definition -> RuleT m
rule) Validation m
_ Definition
definition' 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 m
rule Validation m
context (Full.ExecutableDefinition ExecutableDefinition
definition') 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 m
rule Validation m
context (Full.TypeSystemDefinition TypeSystemDefinition
typeSystemDefinition' Location
_) 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 m
rule Validation m
context (Full.TypeSystemExtension TypeSystemExtension
extension Location
_) 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 Validation m
context Rule m
rule = \case
    Full.SchemaExtension 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 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 Validation m
context Rule m
rule = \case
    Full.ScalarTypeExtension Name
_ 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 Name
_ ImplementsInterfaces []
_ [Directive]
directives' 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 Name
_ ImplementsInterfaces []
_ 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 Name
_ ImplementsInterfaces NonEmpty
_ -> Seq (RuleT m)
forall a. Monoid a => a
mempty
    Full.InterfaceTypeFieldsDefinitionExtension Name
_ [Directive]
directives' 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 Name
_ 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 Name
_ [Directive]
directives' UnionMemberTypes NonEmpty
_ ->
        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 Name
_ 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 Name
_ [Directive]
directives' 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 Name
_ 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 Name
_ [Directive]
directives' 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 Name
_ 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 Validation m
context Rule m
rule = \case
    Full.SchemaOperationExtension [Directive]
directives' NonEmpty OperationTypeDefinition
_ ->
        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 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 m
rule Validation m
context (Full.DefinitionOperation 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 m
rule Validation m
context (Full.DefinitionFragment 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 Validation m
context Rule m
rule = \case
    Full.SchemaDefinition [Directive]
directives' NonEmpty OperationTypeDefinition
_ ->
        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' ->
        Validation m -> ApplyRule m TypeDefinition
forall (m :: * -> *). Validation m -> ApplyRule m TypeDefinition
typeDefinition Validation m
context Rule m
rule TypeDefinition
typeDefinition'
    Full.DirectiveDefinition Description
_ Name
_ ArgumentsDefinition
arguments' NonEmpty DirectiveLocation
_ ->
        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 Validation m
context Rule m
rule = \case
    Full.ScalarTypeDefinition Description
_ Name
_ [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 Description
_ Name
_ ImplementsInterfaces []
_ [Directive]
directives' [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 Description
_ Name
_ [Directive]
directives' [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 Description
_ Name
_ [Directive]
directives' UnionMemberTypes []
_ ->
        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 Description
_ Name
_ [Directive]
directives' [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 Description
_ Name
_ [Directive]
directives' [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 Validation m
context Rule m
rule (Full.EnumValueDefinition Description
_ Name
_ [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 Validation m
context Rule m
rule (Full.FieldDefinition Description
_ Name
_ ArgumentsDefinition
arguments' Type
_ [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 Validation m
context Rule m
rule (Full.ArgumentsDefinition [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 Validation m
context Rule m
rule DirectiveLocation
directiveLocation InputValueDefinition
definition' =
    let Full.InputValueDefinition Description
_ Name
_ Type
_ Maybe (Node ConstValue)
_ [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 m
rule Validation m
context OperationDefinition
operation
    | Validation.OperationDefinitionRule 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 [VariableDefinition] -> RuleT m
variablesRule <- Rule m
rule
    , Full.OperationDefinition OperationType
_ Maybe Name
_ [VariableDefinition]
variables [Directive]
_ SelectionSet
_ Location
_ <- 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 SelectionSet
selections Location
_ <- 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 OperationType
Full.Query Maybe Name
_ [VariableDefinition]
_ [Directive]
directives' SelectionSet
selections Location
_  <- 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 OperationType
Full.Mutation Maybe Name
_ [VariableDefinition]
_ [Directive]
directives' SelectionSet
selections Location
_  <- 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 OperationType
Full.Subscription Maybe Name
_ [VariableDefinition]
_ [Directive]
directives' SelectionSet
selections Location
_  <- 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 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 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 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) = 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) = 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 Type m
_ = Maybe (Type m)
forall a. Maybe a
Nothing

variableDefinition :: forall m
    . Validation m
    -> ApplyRule m Full.VariableDefinition
variableDefinition :: Validation m -> ApplyRule m VariableDefinition
variableDefinition Validation m
context Rule m
rule (Full.VariableDefinition Name
_ Type
typeName Maybe (Node ConstValue)
value' Location
_)
    | Just 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 Validation m
_ Rule m
_ 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 Maybe Type -> Node Value -> RuleT m
_ Maybe Type -> Node ConstValue -> RuleT m
rule) Maybe Type
valueType = Maybe Type -> Node ConstValue -> Seq (RuleT m)
go Maybe Type
valueType
  where
    go :: Maybe Type -> Node ConstValue -> Seq (RuleT m)
go Maybe Type
inputObjectType value' :: Node ConstValue
value'@(Full.Node (Full.ConstObject [ObjectField ConstValue]
fields) Location
_)
        = (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 Maybe Type
listType value' :: Node ConstValue
value'@(Full.Node (Full.ConstList [ConstValue]
values) 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 Maybe Type
anotherValue 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 Maybe Type
inputObjectType Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node ConstValue
value', Name
Location
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
location :: Location
name :: Name
..} =
        Maybe Type -> Node ConstValue -> Seq (RuleT m)
go (Name -> Maybe Type -> Maybe Type
valueTypeByName Name
name Maybe Type
inputObjectType) Node ConstValue
value'
constValue Rule m
_ Maybe Type
_ = 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 Maybe Name
_ Type
inputFieldType' Maybe Value
_) = Type
inputFieldType'

valueTypeByName :: Full.Name -> Maybe In.Type -> Maybe In.Type
valueTypeByName :: Name -> Maybe Type -> Maybe Type
valueTypeByName Name
fieldName (Just( In.InputObjectBaseType InputObjectType
inputObjectType)) =
    let In.InputObjectType Name
_ Maybe Name
_ 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 Name
_ Maybe Type
_ = 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 FragmentDefinition -> RuleT m
rule) Validation m
_ 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 m
rule Validation m
context FragmentDefinition
definition'
    | Full.FragmentDefinition Name
_ Name
typeCondition [Directive]
directives' SelectionSet
selections Location
_ <- FragmentDefinition
definition'
    , Validation.FragmentRule FragmentDefinition -> RuleT m
definitionRule InlineFragment -> RuleT m
_ <- 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 Name
_ Name
typeCondition [Directive]
directives' SelectionSet
selections Location
_ <- 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 Name
typeCondition t Directive
directives' 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 Name
typeCondition 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 Validation m
context HashMap Name (Type m)
types' 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 Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType Selection
selection'
    | Validation.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' ->
                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' ->
                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' ->
                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 Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType Field
field' = Field -> Seq (RuleT m)
go Field
field'
  where
    go :: Field -> Seq (RuleT m)
go (Full.Field Maybe Name
_ Name
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_)
        | Validation.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 Maybe (Type m) -> Field -> RuleT m
argumentsRule Directive -> RuleT m
_  <- 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 Maybe Name
_ Type m
type' Arguments
_) = Type m
type'
    typeFieldArguments :: Field m -> Arguments
typeFieldArguments (Out.Field Maybe Name
_ Type m
_ Arguments
argumentTypes) = Arguments
argumentTypes
    applyToChildren :: Name -> Seq (RuleT m)
applyToChildren Name
fieldName =
        let Full.Field Maybe Name
_ Name
_ [Argument]
arguments' [Directive]
directives' SelectionSetOpt
selections Location
_ = 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 m
rule 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 Name
argumentName Node Value
_ Location
_) = 
       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 m
rule Maybe Argument
argumentType (Full.Argument Name
_ Node Value
value' Location
_) =
    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 Maybe Name
_ Type
valueType' Maybe Value
_) = Type
valueType'

-- valueTypeFromList :: Maybe In.Type -> Maybe In.Type
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 Maybe Type -> Node a -> Seq m
go Maybe Type
listType [a]
values 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 Type
baseType)) = Type -> Maybe Type
forall a. a -> Maybe a
Just Type
baseType
    valueTypeFromList Maybe Type
_ = 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 Maybe Type -> Node Value -> RuleT m
rule Maybe Type -> Node ConstValue -> RuleT m
_) Maybe Type
valueType = Maybe Type -> Node Value -> Seq (RuleT m)
go Maybe Type
valueType
  where
    go :: Maybe Type -> Node Value -> Seq (RuleT m)
go Maybe Type
inputObjectType value' :: Node Value
value'@(Full.Node (Full.Object [ObjectField Value]
fields) Location
_)
        = (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 Maybe Type
listType value' :: Node Value
value'@(Full.Node (Full.List [Value]
values) 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 Maybe Type
anotherValue 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 Maybe Type
inputObjectType Full.ObjectField{$sel:value:ObjectField :: forall a. ObjectField a -> Node a
value = Node Value
value', Name
Location
location :: Location
name :: Name
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:name:ObjectField :: forall a. ObjectField a -> Name
..} =
        Maybe Type -> Node Value -> Seq (RuleT m)
go (Name -> Maybe Type -> Maybe Type
valueTypeByName Name
name Maybe Type
inputObjectType) Node Value
value'
value Rule m
_ Maybe Type
_ = 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 Validation m
context HashMap Name (Type m)
types' Rule m
rule Maybe (Type m)
objectType InlineFragment
inlineFragment' =
    InlineFragment -> Seq (RuleT m)
go InlineFragment
inlineFragment'
  where
    go :: InlineFragment -> Seq (RuleT m)
go (Full.InlineFragment Maybe Name
optionalType [Directive]
directives' SelectionSet
selections Location
_)
        | Validation.FragmentRule FragmentDefinition -> RuleT m
_ 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 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 Maybe Name
Nothing = Maybe (Type m)
objectType
    applyToChildren :: Maybe (Type m) -> t Directive -> t Selection -> Seq (RuleT m)
applyToChildren Maybe (Type m)
objectType' t Directive
directives' 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 Validation m
context Rule m
rule fragmentSpread' :: FragmentSpread
fragmentSpread'@(Full.FragmentSpread Name
_ [Directive]
directives' Location
_)
    | Validation.FragmentSpreadRule 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 Validation m
context Rule m
rule DirectiveLocation
directiveLocation t Directive
directives'
    | Validation.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 m
_ (Validation.ArgumentsRule Maybe (Type m) -> Field -> RuleT m
_ Directive -> RuleT m
argumentsRule) 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 Validation m
context Rule m
rule (Full.Directive Name
directiveName [Argument]
arguments' Location
_) =
    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 Maybe Name
_ [DirectiveLocation]
_ Arguments
argumentTypes) = Arguments
argumentTypes