{- 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' :: 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'

-- 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 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