{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Language.GraphQL.Validate.Rules
( directivesInValidLocationsRule
, executableDefinitionsRule
, fieldsOnCorrectTypeRule
, fragmentsOnCompositeTypesRule
, fragmentSpreadTargetDefinedRule
, fragmentSpreadTypeExistenceRule
, loneAnonymousOperationRule
, knownArgumentNamesRule
, knownDirectiveNamesRule
, knownInputFieldNamesRule
, noFragmentCyclesRule
, noUndefinedVariablesRule
, noUnusedFragmentsRule
, noUnusedVariablesRule
, overlappingFieldsCanBeMergedRule
, possibleFragmentSpreadsRule
, providedRequiredInputFieldsRule
, providedRequiredArgumentsRule
, scalarLeafsRule
, singleFieldSubscriptionsRule
, specifiedRules
, uniqueArgumentNamesRule
, uniqueDirectiveNamesRule
, uniqueFragmentNamesRule
, uniqueInputFieldNamesRule
, uniqueOperationNamesRule
, uniqueVariableNamesRule
, valuesOfCorrectTypeRule
, variablesInAllowedPositionRule
, variablesAreInputTypesRule
) where
import Control.Monad ((>=>), foldM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
import Data.Bifunctor (first)
import Data.Foldable (find, fold, foldl', toList)
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.List (groupBy, sortBy, sortOn)
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord (comparing)
import Data.Sequence (Seq(..), (|>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Records (HasField(..))
import qualified Language.GraphQL.AST.Document as Full
import qualified Language.GraphQL.Type.Definition as Definition
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 qualified Language.GraphQL.Type.Schema as Schema
import Language.GraphQL.Validate.Validation
type ValidationState m a =
StateT (HashSet Full.Name) (ReaderT (Validation m) Seq) a
specifiedRules :: forall m. [Rule m]
specifiedRules :: forall (m :: * -> *). [Rule m]
specifiedRules =
[ Rule m
forall (m :: * -> *). Rule m
executableDefinitionsRule
, Rule m
forall (m :: * -> *). Rule m
singleFieldSubscriptionsRule
, Rule m
forall (m :: * -> *). Rule m
loneAnonymousOperationRule
, Rule m
forall (m :: * -> *). Rule m
uniqueOperationNamesRule
, Rule m
forall (m :: * -> *). Rule m
fieldsOnCorrectTypeRule
, Rule m
forall (m :: * -> *). Rule m
scalarLeafsRule
, Rule m
forall (m :: * -> *). Rule m
overlappingFieldsCanBeMergedRule
, Rule m
forall (m :: * -> *). Rule m
knownArgumentNamesRule
, Rule m
forall (m :: * -> *). Rule m
uniqueArgumentNamesRule
, Rule m
forall (m :: * -> *). Rule m
providedRequiredArgumentsRule
, Rule m
forall (m :: * -> *). Rule m
uniqueFragmentNamesRule
, Rule m
forall (m :: * -> *). Rule m
fragmentSpreadTypeExistenceRule
, Rule m
forall (m :: * -> *). Rule m
fragmentsOnCompositeTypesRule
, Rule m
forall (m :: * -> *). Rule m
noUnusedFragmentsRule
, Rule m
forall (m :: * -> *). Rule m
fragmentSpreadTargetDefinedRule
, Rule m
forall (m :: * -> *). Rule m
noFragmentCyclesRule
, Rule m
forall (m :: * -> *). Rule m
possibleFragmentSpreadsRule
, Rule m
forall (m :: * -> *). Rule m
valuesOfCorrectTypeRule
, Rule m
forall (m :: * -> *). Rule m
knownInputFieldNamesRule
, Rule m
forall (m :: * -> *). Rule m
uniqueInputFieldNamesRule
, Rule m
forall (m :: * -> *). Rule m
providedRequiredInputFieldsRule
, Rule m
forall (m :: * -> *). Rule m
knownDirectiveNamesRule
, Rule m
forall (m :: * -> *). Rule m
directivesInValidLocationsRule
, Rule m
forall (m :: * -> *). Rule m
uniqueDirectiveNamesRule
, Rule m
forall (m :: * -> *). Rule m
uniqueVariableNamesRule
, Rule m
forall (m :: * -> *). Rule m
variablesAreInputTypesRule
, Rule m
forall (m :: * -> *). Rule m
noUndefinedVariablesRule
, Rule m
forall (m :: * -> *). Rule m
noUnusedVariablesRule
, Rule m
forall (m :: * -> *). Rule m
variablesInAllowedPositionRule
]
executableDefinitionsRule :: forall m. Rule m
executableDefinitionsRule :: forall (m :: * -> *). Rule m
executableDefinitionsRule = (Definition -> RuleT m) -> Rule m
forall (m :: * -> *). (Definition -> RuleT m) -> Rule m
DefinitionRule ((Definition -> RuleT m) -> Rule m)
-> (Definition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.ExecutableDefinition ExecutableDefinition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Full.TypeSystemDefinition TypeSystemDefinition
_ Location
location' -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
location'
Full.TypeSystemExtension TypeSystemExtension
_ Location
location' -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
location'
where
error' :: Location -> Error
error' Location
location' = Error
{ message :: String
message =
String
"Definition must be OperationDefinition or FragmentDefinition."
, locations :: [Location]
locations = [Location
location']
}
singleFieldSubscriptionsRule :: forall m. Rule m
singleFieldSubscriptionsRule :: forall (m :: * -> *). Rule m
singleFieldSubscriptionsRule = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.OperationDefinition OperationType
Full.Subscription Maybe Text
name' [VariableDefinition]
_ [Directive]
_ SelectionSet
rootFields Location
location' -> do
HashSet Text
groupedFieldSet <- StateT (HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
-> HashSet Text -> ReaderT (Validation m) Seq (HashSet Text)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall {m :: * -> *}.
SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFields SelectionSet
rootFields) HashSet Text
forall a. HashSet a
HashSet.empty
case HashSet Text -> Int
forall a. HashSet a -> Int
HashSet.size HashSet Text
groupedFieldSet of
Int
1 -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Int
_
| Just Text
name <- Maybe Text
name' -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Subscription \""
, Text -> String
Text.unpack Text
name
, String
"\" must select only one top level field."
]
, locations :: [Location]
locations = [Location
location']
}
| Bool
otherwise -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = String
errorMessage
, locations :: [Location]
locations = [Location
location']
}
OperationDefinition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
errorMessage :: String
errorMessage =
String
"Anonymous Subscription must select only one top level field."
collectFields :: SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFields = (HashSet Text
-> Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text))
-> HashSet Text
-> SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashSet Text
-> Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forEach HashSet Text
forall a. HashSet a
HashSet.empty
forEach :: HashSet Text
-> Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forEach HashSet Text
accumulator = \case
Full.FieldSelection Field
fieldSelection -> HashSet Text
-> Field
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall {f :: * -> *}.
Applicative f =>
HashSet Text -> Field -> f (HashSet Text)
forField HashSet Text
accumulator Field
fieldSelection
Full.FragmentSpreadSelection FragmentSpread
fragmentSelection ->
HashSet Text
-> FragmentSpread
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forSpread HashSet Text
accumulator FragmentSpread
fragmentSelection
Full.InlineFragmentSelection InlineFragment
fragmentSelection ->
HashSet Text
-> InlineFragment
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forInline HashSet Text
accumulator InlineFragment
fragmentSelection
forField :: HashSet Text -> Field -> f (HashSet Text)
forField HashSet Text
accumulator (Full.Field Maybe Text
alias Text
name [Argument]
_ [Directive]
directives' SelectionSetOpt
_ Location
_)
| (Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = HashSet Text -> f (HashSet Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
| Just Text
aliasedName <- Maybe Text
alias = HashSet Text -> f (HashSet Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(HashSet Text -> f (HashSet Text))
-> HashSet Text -> f (HashSet Text)
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
aliasedName HashSet Text
accumulator
| Bool
otherwise = HashSet Text -> f (HashSet Text)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashSet Text -> f (HashSet Text))
-> HashSet Text -> f (HashSet Text)
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
name HashSet Text
accumulator
forSpread :: HashSet Text
-> FragmentSpread
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forSpread HashSet Text
accumulator (Full.FragmentSpread Text
fragmentName [Directive]
directives' Location
_)
| (Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
| Bool
otherwise = do
Bool
inVisitetFragments <- (HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool)
-> (HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName
if Bool
inVisitetFragments
then HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
else Text
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFromSpread Text
fragmentName HashSet Text
accumulator
forInline :: HashSet Text
-> InlineFragment
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forInline HashSet Text
accumulator (Full.InlineFragment Maybe Text
maybeType [Directive]
directives' SelectionSet
selections Location
_)
| (Directive -> Bool) -> [Directive] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
| Just Text
typeCondition <- Maybe Text
maybeType =
Text
-> SelectionSet
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFromFragment Text
typeCondition SelectionSet
selections HashSet Text
accumulator
| Bool
otherwise = HashSet Text -> HashSet Text -> HashSet Text
forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet Text
accumulator
(HashSet Text -> HashSet Text)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFields SelectionSet
selections
skip :: Directive -> Bool
skip (Full.Directive Text
"skip" [Full.Argument Text
"if" (Full.Node Value
argumentValue Location
_) Location
_] Location
_) =
Bool -> Value
Full.Boolean Bool
True Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
argumentValue
skip (Full.Directive Text
"include" [Full.Argument Text
"if" (Full.Node Value
argumentValue Location
_) Location
_] Location
_) =
Bool -> Value
Full.Boolean Bool
False Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
argumentValue
skip Directive
_ = Bool
False
collectFromFragment :: Text
-> SelectionSet
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFromFragment Text
typeCondition SelectionSet
selectionSet HashSet Text
accumulator = do
HashMap Text (Type m)
types' <- ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (Type m)))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
Schema m
schema' <- ReaderT (Validation m) Seq (Schema m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Schema m)
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Schema m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Schema m))
-> ReaderT (Validation m) Seq (Schema m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Schema m)
forall a b. (a -> b) -> a -> b
$ (Validation m -> Schema m) -> ReaderT (Validation m) Seq (Schema m)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
Just CompositeType m
compositeType
| Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema'
, Bool
True <- CompositeType m -> ObjectType m -> Bool
forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
Type.doesFragmentTypeApply CompositeType m
compositeType ObjectType m
objectType ->
HashSet Text -> HashSet Text -> HashSet Text
forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet Text
accumulator (HashSet Text -> HashSet Text)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFields SelectionSet
selectionSet
| Bool
otherwise -> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
collectFromSpread :: Text
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFromSpread Text
fragmentName HashSet Text
accumulator = do
(HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ())
-> (HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ()
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName
Document
ast' <- ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document)
-> ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall a b. (a -> b) -> a -> b
$ (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
Just (Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
selectionSet Location
_) ->
Text
-> SelectionSet
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFromFragment Text
typeCondition SelectionSet
selectionSet HashSet Text
accumulator
loneAnonymousOperationRule :: forall m. Rule m
loneAnonymousOperationRule :: forall (m :: * -> *). Rule m
loneAnonymousOperationRule = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
_ Location
thisLocation -> Location -> RuleT m
forall {m :: * -> *}. Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation
Full.OperationDefinition OperationType
_ Maybe Text
Nothing [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
Location -> RuleT m
forall {m :: * -> *}. Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation
OperationDefinition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
check :: Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation = (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
ReaderT (Validation m) Seq Document
-> (Document -> ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq Error
forall a b.
ReaderT (Validation m) Seq a
-> (a -> ReaderT (Validation m) Seq b)
-> ReaderT (Validation m) Seq b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> ReaderT (Validation m) Seq Error)
-> (Document -> Seq Error)
-> Document
-> ReaderT (Validation m) Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definition -> Seq Error -> Seq Error)
-> Seq Error -> Document -> Seq Error
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Location -> Definition -> Seq Error -> Seq Error
filterAnonymousOperations Location
thisLocation) Seq Error
forall a. Monoid a => a
mempty
filterAnonymousOperations :: Location -> Definition -> Seq Error -> Seq Error
filterAnonymousOperations Location
thisLocation Definition
definition Seq Error
Empty
| (Definition -> Maybe OperationDefinition
viewOperation -> Just OperationDefinition
operationDefinition) <- Definition
definition =
Location -> OperationDefinition -> Seq Error
forall {f :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Location -> OperationDefinition -> f Error
compareAnonymousOperations Location
thisLocation OperationDefinition
operationDefinition
filterAnonymousOperations Location
_ Definition
_ Seq Error
accumulator = Seq Error
accumulator
compareAnonymousOperations :: Location -> OperationDefinition -> f Error
compareAnonymousOperations Location
thisLocation = \case
Full.OperationDefinition OperationType
_ Maybe Text
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thatLocation
| Location
thisLocation Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
/= Location
thatLocation -> Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> f Error) -> Error -> f Error
forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
thisLocation
Full.SelectionSet SelectionSet
_ Location
thatLocation
| Location
thisLocation Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
/= Location
thatLocation -> Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> f Error) -> Error -> f Error
forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
thisLocation
OperationDefinition
_ -> f Error
forall a. Monoid a => a
mempty
error' :: Location -> Error
error' Location
location' = Error
{ message :: String
message =
String
"This anonymous operation must be the only defined operation."
, locations :: [Location]
locations = [Location
location']
}
uniqueOperationNamesRule :: forall m. Rule m
uniqueOperationNamesRule :: forall (m :: * -> *). Rule m
uniqueOperationNamesRule = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.OperationDefinition OperationType
_ (Just Text
thisName) [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
(Definition -> [Location] -> [Location])
-> Location -> String -> RuleT m
forall (m :: * -> *).
(Definition -> [Location] -> [Location])
-> Location -> String -> RuleT m
findDuplicates (Text -> Definition -> [Location] -> [Location]
filterByName Text
thisName) Location
thisLocation (Text -> String
error' Text
thisName)
OperationDefinition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
error' :: Text -> String
error' Text
operationName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"There can be only one operation named \""
, Text -> String
Text.unpack Text
operationName
, String
"\"."
]
filterByName :: Text -> Definition -> [Location] -> [Location]
filterByName Text
thisName Definition
definition' [Location]
accumulator
| (Definition -> Maybe OperationDefinition
viewOperation -> Just OperationDefinition
operationDefinition) <- Definition
definition'
, Full.OperationDefinition OperationType
_ (Just Text
thatName) [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thatLocation <- OperationDefinition
operationDefinition
, Text
thisName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
thatName = Location
thatLocation Location -> [Location] -> [Location]
forall a. a -> [a] -> [a]
: [Location]
accumulator
| Bool
otherwise = [Location]
accumulator
findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
-> Full.Location
-> String
-> RuleT m
findDuplicates :: forall (m :: * -> *).
(Definition -> [Location] -> [Location])
-> Location -> String -> RuleT m
findDuplicates Definition -> [Location] -> [Location]
filterByName Location
thisLocation String
errorMessage = do
Document
ast' <- (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
let locations' :: [Location]
locations' = (Definition -> [Location] -> [Location])
-> [Location] -> Document -> [Location]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> [Location] -> [Location]
filterByName [] Document
ast'
if [Location] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Location]
locations' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& [Location] -> Location
forall a. HasCallStack => [a] -> a
head [Location]
locations' Location -> Location -> Bool
forall a. Eq a => a -> a -> Bool
== Location
thisLocation
then Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ [Location] -> Error
error' [Location]
locations'
else Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
error' :: [Location] -> Error
error' [Location]
locations' = Error
{ message :: String
message = String
errorMessage
, locations :: [Location]
locations = [Location]
locations'
}
viewOperation :: Full.Definition -> Maybe Full.OperationDefinition
viewOperation :: Definition -> Maybe OperationDefinition
viewOperation Definition
definition
| Full.ExecutableDefinition ExecutableDefinition
executableDefinition <- Definition
definition
, Full.DefinitionOperation OperationDefinition
operationDefinition <- ExecutableDefinition
executableDefinition =
OperationDefinition -> Maybe OperationDefinition
forall a. a -> Maybe a
Just OperationDefinition
operationDefinition
viewOperation Definition
_ = Maybe OperationDefinition
forall a. Maybe a
Nothing
viewFragment :: Full.Definition -> Maybe Full.FragmentDefinition
viewFragment :: Definition -> Maybe FragmentDefinition
viewFragment Definition
definition
| Full.ExecutableDefinition ExecutableDefinition
executableDefinition <- Definition
definition
, Full.DefinitionFragment FragmentDefinition
fragmentDefinition <- ExecutableDefinition
executableDefinition =
FragmentDefinition -> Maybe FragmentDefinition
forall a. a -> Maybe a
Just FragmentDefinition
fragmentDefinition
viewFragment Definition
_ = Maybe FragmentDefinition
forall a. Maybe a
Nothing
uniqueFragmentNamesRule :: forall m. Rule m
uniqueFragmentNamesRule :: forall (m :: * -> *). Rule m
uniqueFragmentNamesRule = (FragmentDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule ((FragmentDefinition -> RuleT m) -> Rule m)
-> (FragmentDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentDefinition Text
thisName Text
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
(Definition -> [Location] -> [Location])
-> Location -> String -> RuleT m
forall (m :: * -> *).
(Definition -> [Location] -> [Location])
-> Location -> String -> RuleT m
findDuplicates (Text -> Definition -> [Location] -> [Location]
filterByName Text
thisName) Location
thisLocation (Text -> String
error' Text
thisName)
where
error' :: Text -> String
error' Text
fragmentName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"There can be only one fragment named \""
, Text -> String
Text.unpack Text
fragmentName
, String
"\"."
]
filterByName :: Text -> Definition -> [Location] -> [Location]
filterByName Text
thisName Definition
definition [Location]
accumulator
| Just FragmentDefinition
fragmentDefinition <- Definition -> Maybe FragmentDefinition
viewFragment Definition
definition
, Full.FragmentDefinition Text
thatName Text
_ [Directive]
_ SelectionSet
_ Location
thatLocation <- FragmentDefinition
fragmentDefinition
, Text
thisName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
thatName = Location
thatLocation Location -> [Location] -> [Location]
forall a. a -> [a] -> [a]
: [Location]
accumulator
| Bool
otherwise = [Location]
accumulator
fragmentSpreadTargetDefinedRule :: forall m. Rule m
fragmentSpreadTargetDefinedRule :: forall (m :: * -> *). Rule m
fragmentSpreadTargetDefinedRule = (FragmentSpread -> RuleT m) -> Rule m
forall (m :: * -> *). (FragmentSpread -> RuleT m) -> Rule m
FragmentSpreadRule ((FragmentSpread -> RuleT m) -> Rule m)
-> (FragmentSpread -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentSpread Text
fragmentName [Directive]
_ Location
location' -> do
Document
ast' <- (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
case (Definition -> Bool) -> Document -> Maybe Definition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Definition -> Bool
isSpreadTarget Text
fragmentName) Document
ast' of
Maybe Definition
Nothing -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
error' Text
fragmentName
, locations :: [Location]
locations = [Location
location']
}
Just Definition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
error' :: Text -> String
error' Text
fragmentName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment target \""
, Text -> String
Text.unpack Text
fragmentName
, String
"\" is undefined."
]
isSpreadTarget :: Text -> Full.Definition -> Bool
isSpreadTarget :: Text -> Definition -> Bool
isSpreadTarget Text
thisName (Definition -> Maybe FragmentDefinition
viewFragment -> Just FragmentDefinition
fragmentDefinition)
| Full.FragmentDefinition Text
thatName Text
_ [Directive]
_ SelectionSet
_ Location
_ <- FragmentDefinition
fragmentDefinition
, Text
thisName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
thatName = Bool
True
isSpreadTarget Text
_ Definition
_ = Bool
False
fragmentSpreadTypeExistenceRule :: forall m. Rule m
fragmentSpreadTypeExistenceRule :: forall (m :: * -> *). Rule m
fragmentSpreadTypeExistenceRule = (Maybe (Type m) -> Selection -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Selection -> RuleT m) -> Rule m
SelectionRule ((Maybe (Type m) -> Selection -> RuleT m) -> Rule m)
-> (Maybe (Type m) -> Selection -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ (Selection -> RuleT m) -> Maybe (Type m) -> Selection -> RuleT m
forall a b. a -> b -> a
const ((Selection -> RuleT m) -> Maybe (Type m) -> Selection -> RuleT m)
-> (Selection -> RuleT m) -> Maybe (Type m) -> Selection -> RuleT m
forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentSpreadSelection FragmentSpread
fragmentSelection
| Full.FragmentSpread Text
fragmentName [Directive]
_ Location
location' <- FragmentSpread
fragmentSelection -> do
HashMap Text (Type m)
types' <- (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
Text
typeCondition <- Text -> ReaderT (Validation m) Seq Text
forall (m1 :: * -> *). Text -> ReaderT (Validation m1) Seq Text
findSpreadTarget Text
fragmentName
case Text -> HashMap Text (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
typeCondition HashMap Text (Type m)
types' of
Maybe (Type m)
Nothing -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> Text -> String
spreadError Text
fragmentName Text
typeCondition
, locations :: [Location]
locations = [Location
location']
}
Just Type m
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Full.InlineFragmentSelection InlineFragment
fragmentSelection
| Full.InlineFragment Maybe Text
maybeType [Directive]
_ SelectionSet
_ Location
location' <- InlineFragment
fragmentSelection
, Just Text
typeCondition <- Maybe Text
maybeType -> do
HashMap Text (Type m)
types' <- (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Text -> HashMap Text (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
typeCondition HashMap Text (Type m)
types' of
Maybe (Type m)
Nothing -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
inlineError Text
typeCondition
, locations :: [Location]
locations = [Location
location']
}
Just Type m
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Selection
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
spreadError :: Text -> Text -> String
spreadError Text
fragmentName Text
typeCondition = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment \""
, Text -> String
Text.unpack Text
fragmentName
, String
"\" is specified on type \""
, Text -> String
Text.unpack Text
typeCondition
, String
"\" which doesn't exist in the schema."
]
inlineError :: Text -> String
inlineError Text
typeCondition = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Inline fragment is specified on type \""
, Text -> String
Text.unpack Text
typeCondition
, String
"\" which doesn't exist in the schema."
]
maybeToSeq :: forall a. Maybe a -> Seq a
maybeToSeq :: forall a. Maybe a -> Seq a
maybeToSeq (Just a
x) = a -> Seq a
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
maybeToSeq Maybe a
Nothing = Seq a
forall a. Monoid a => a
mempty
fragmentsOnCompositeTypesRule :: forall m. Rule m
fragmentsOnCompositeTypesRule :: forall (m :: * -> *). Rule m
fragmentsOnCompositeTypesRule = (FragmentDefinition -> RuleT m)
-> (InlineFragment -> RuleT m) -> Rule m
forall (m :: * -> *).
(FragmentDefinition -> RuleT m)
-> (InlineFragment -> RuleT m) -> Rule m
FragmentRule FragmentDefinition -> RuleT m
forall {m :: * -> *}.
FragmentDefinition -> ReaderT (Validation m) Seq Error
definitionRule InlineFragment -> RuleT m
forall {m :: * -> *}.
InlineFragment -> ReaderT (Validation m) Seq Error
inlineRule
where
inlineRule :: InlineFragment -> ReaderT (Validation m) Seq Error
inlineRule (Full.InlineFragment (Just Text
typeCondition) [Directive]
_ SelectionSet
_ Location
location') =
Text -> Location -> ReaderT (Validation m) Seq Error
forall {m :: * -> *}.
Text -> Location -> ReaderT (Validation m) Seq Error
check Text
typeCondition Location
location'
inlineRule InlineFragment
_ = Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
definitionRule :: FragmentDefinition -> ReaderT (Validation m) Seq Error
definitionRule (Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
_ Location
location') =
Text -> Location -> ReaderT (Validation m) Seq Error
forall {m :: * -> *}.
Text -> Location -> ReaderT (Validation m) Seq Error
check Text
typeCondition Location
location'
check :: Text -> Location -> ReaderT (Validation m) Seq Error
check Text
typeCondition Location
location' = do
HashMap Text (Type m)
types' <- (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
Type m
_ <- Seq (Type m) -> ReaderT (Validation m) Seq (Type m)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq (Type m) -> ReaderT (Validation m) Seq (Type m))
-> Seq (Type m) -> ReaderT (Validation m) Seq (Type m)
forall a b. (a -> b) -> a -> b
$ Maybe (Type m) -> Seq (Type m)
forall a. Maybe a -> Seq a
maybeToSeq (Maybe (Type m) -> Seq (Type m)) -> Maybe (Type m) -> Seq (Type m)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text (Type m) -> Maybe (Type m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
typeCondition HashMap Text (Type m)
types'
case Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
errorMessage Text
typeCondition
, locations :: [Location]
locations = [Location
location']
}
Just CompositeType m
_ -> Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
errorMessage :: Text -> String
errorMessage Text
typeCondition = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment cannot condition on non composite type \""
, Text -> String
Text.unpack Text
typeCondition,
String
"\"."
]
noUnusedFragmentsRule :: forall m. Rule m
noUnusedFragmentsRule :: forall (m :: * -> *). Rule m
noUnusedFragmentsRule = (FragmentDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule ((FragmentDefinition -> RuleT m) -> Rule m)
-> (FragmentDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \FragmentDefinition
fragment -> do
let Full.FragmentDefinition Text
fragmentName Text
_ [Directive]
_ SelectionSet
_ Location
location' = FragmentDefinition
fragment
in (Seq Text -> Seq Error)
-> ReaderT (Validation m) Seq Text -> RuleT m
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Text -> Location -> Seq Text -> Seq Error
forall {t :: * -> *} {f :: * -> *}.
(Foldable t, Monoid (f Error), Applicative f) =>
Text -> Location -> t Text -> f Error
checkFragmentName Text
fragmentName Location
location')
(ReaderT (Validation m) Seq Text -> RuleT m)
-> ReaderT (Validation m) Seq Text -> RuleT m
forall a b. (a -> b) -> a -> b
$ (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
ReaderT (Validation m) Seq Document
-> (Document -> ReaderT (Validation m) Seq Text)
-> ReaderT (Validation m) Seq Text
forall a b.
ReaderT (Validation m) Seq a
-> (a -> ReaderT (Validation m) Seq b)
-> ReaderT (Validation m) Seq b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
-> HashSet Text -> ReaderT (Validation m) Seq Text)
-> HashSet Text
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
-> ReaderT (Validation m) Seq Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
-> HashSet Text -> ReaderT (Validation m) Seq Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HashSet Text
forall a. HashSet a
HashSet.empty
(StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
-> ReaderT (Validation m) Seq Text)
-> (Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text)
-> Document
-> ReaderT (Validation m) Seq Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text)
-> SelectionSetOpt
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
forall a (m :: * -> *).
(Selection -> ValidationState m a)
-> SelectionSetOpt -> ValidationState m a
forall (t :: * -> *) a (m :: * -> *).
Foldable t =>
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
filterSelections Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
forall {t :: (* -> *) -> * -> *} {t :: (* -> *) -> * -> *}
{m :: * -> *}.
(MonadTrans t, MonadTrans t, Monad m, Monad (t m),
Monoid (m Text)) =>
Selection -> t (t m) Text
evaluateSelection
(SelectionSetOpt
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text)
-> (Document -> SelectionSetOpt)
-> Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Definition -> SelectionSetOpt) -> Document -> SelectionSetOpt
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Definition -> SelectionSetOpt
definitionSelections
where
checkFragmentName :: Text -> Location -> t Text -> f Error
checkFragmentName Text
fragmentName Location
location' t Text
elements
| Text
fragmentName Text -> t Text -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
elements = f Error
forall a. Monoid a => a
mempty
| Bool
otherwise = Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> f Error) -> Error -> f Error
forall a b. (a -> b) -> a -> b
$ Text -> Location -> Error
makeError Text
fragmentName Location
location'
makeError :: Text -> Location -> Error
makeError Text
fragName Location
location' = Error
{ message :: String
message = Text -> String
errorMessage Text
fragName
, locations :: [Location]
locations = [Location
location']
}
errorMessage :: Text -> String
errorMessage Text
fragName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment \""
, Text -> String
Text.unpack Text
fragName
, String
"\" is never used."
]
evaluateSelection :: Selection -> t (t m) Text
evaluateSelection Selection
selection
| Full.FragmentSpreadSelection FragmentSpread
spreadSelection <- Selection
selection
, Full.FragmentSpread Text
spreadName [Directive]
_ Location
_ <- FragmentSpread
spreadSelection =
t m Text -> t (t m) Text
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t m Text -> t (t m) Text) -> t m Text -> t (t m) Text
forall a b. (a -> b) -> a -> b
$ Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
spreadName
evaluateSelection Selection
_ = t m Text -> t (t m) Text
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t m Text -> t (t m) Text) -> t m Text -> t (t m) Text
forall a b. (a -> b) -> a -> b
$ m Text -> t m Text
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Text
forall a. Monoid a => a
mempty
definitionSelections :: Full.Definition -> Full.SelectionSetOpt
definitionSelections :: Definition -> SelectionSetOpt
definitionSelections (Definition -> Maybe OperationDefinition
viewOperation -> Just OperationDefinition
operation)
| Full.OperationDefinition OperationType
_ Maybe Text
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
selections Location
_ <- OperationDefinition
operation =
SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
| Full.SelectionSet SelectionSet
selections Location
_ <- OperationDefinition
operation = SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
definitionSelections (Definition -> Maybe FragmentDefinition
viewFragment -> Just FragmentDefinition
fragment)
| Full.FragmentDefinition Text
_ Text
_ [Directive]
_ SelectionSet
selections Location
_ <- FragmentDefinition
fragment = SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
definitionSelections Definition
_ = []
filterSelections :: Foldable t
=> forall a m
. (Full.Selection -> ValidationState m a)
-> t Full.Selection
-> ValidationState m a
filterSelections :: forall (t :: * -> *) a (m :: * -> *).
Foldable t =>
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
filterSelections Selection -> ValidationState m a
applyFilter t Selection
selections
= (ReaderT (Validation m) Seq Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Selection
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Selection)
-> (Seq Selection -> ReaderT (Validation m) Seq Selection)
-> Seq Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Selection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Selection -> ReaderT (Validation m) Seq Selection
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (SelectionSetOpt -> Seq Selection
forall a. [a] -> Seq a
Seq.fromList (SelectionSetOpt -> Seq Selection)
-> SelectionSetOpt -> Seq Selection
forall a b. (a -> b) -> a -> b
$ (Selection -> SelectionSetOpt -> SelectionSetOpt)
-> SelectionSetOpt -> t Selection -> SelectionSetOpt
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Selection -> SelectionSetOpt -> SelectionSetOpt
evaluateSelection SelectionSetOpt
forall a. Monoid a => a
mempty t Selection
selections)
StateT (HashSet Text) (ReaderT (Validation m) Seq) Selection
-> (Selection -> ValidationState m a) -> ValidationState m a
forall a b.
StateT (HashSet Text) (ReaderT (Validation m) Seq) a
-> (a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) b)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Selection -> ValidationState m a
applyFilter
where
evaluateSelection :: Selection -> SelectionSetOpt -> SelectionSetOpt
evaluateSelection Selection
selection SelectionSetOpt
accumulator
| Full.FragmentSpreadSelection{} <- Selection
selection = Selection
selection Selection -> SelectionSetOpt -> SelectionSetOpt
forall a. a -> [a] -> [a]
: SelectionSetOpt
accumulator
| Full.FieldSelection Field
fieldSelection <- Selection
selection
, Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
subselections Location
_ <- Field
fieldSelection =
Selection
selection Selection -> SelectionSetOpt -> SelectionSetOpt
forall a. a -> [a] -> [a]
: (Selection -> SelectionSetOpt -> SelectionSetOpt)
-> SelectionSetOpt -> SelectionSetOpt -> SelectionSetOpt
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Selection -> SelectionSetOpt -> SelectionSetOpt
evaluateSelection SelectionSetOpt
accumulator SelectionSetOpt
subselections
| Full.InlineFragmentSelection InlineFragment
inlineSelection <- Selection
selection
, Full.InlineFragment Maybe Text
_ [Directive]
_ SelectionSet
subselections Location
_ <- InlineFragment
inlineSelection =
Selection
selection Selection -> SelectionSetOpt -> SelectionSetOpt
forall a. a -> [a] -> [a]
: (Selection -> SelectionSetOpt -> SelectionSetOpt)
-> SelectionSetOpt -> SelectionSet -> SelectionSetOpt
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Selection -> SelectionSetOpt -> SelectionSetOpt
evaluateSelection SelectionSetOpt
accumulator SelectionSet
subselections
noFragmentCyclesRule :: forall m. Rule m
noFragmentCyclesRule :: forall (m :: * -> *). Rule m
noFragmentCyclesRule = (FragmentDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule ((FragmentDefinition -> RuleT m) -> Rule m)
-> (FragmentDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentDefinition Text
fragmentName Text
_ [Directive]
_ SelectionSet
selections Location
location' -> do
HashMap Text Int
state <- StateT (Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
-> (Int, Text) -> ReaderT (Validation m) Seq (HashMap Text Int)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (SelectionSet
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (t :: * -> *).
Traversable t =>
t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectCycles SelectionSet
selections) (Int
0, Text
fragmentName)
let spreadPath :: [Text]
spreadPath = (Text, Int) -> Text
forall a b. (a, b) -> a
fst ((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Int) -> Int) -> (Text, Int) -> (Text, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Text, Int) -> Int
forall a b. (a, b) -> b
snd) (HashMap Text Int -> [(Text, Int)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Int
state)
case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
spreadPath of
Text
x : [Text]
_ | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fragmentName -> Error -> RuleT m
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> RuleT m) -> Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Cannot spread fragment \""
, Text -> String
Text.unpack Text
fragmentName
, String
"\" within itself (via "
, Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
" -> " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
fragmentName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
spreadPath
, String
")."
]
, locations :: [Location]
locations = [Location
location']
}
[Text]
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
collectCycles :: Traversable t
=> t Full.Selection
-> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)
collectCycles :: forall (t :: * -> *).
Traversable t =>
t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectCycles = (HashMap Text Int
-> Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int))
-> HashMap Text Int
-> t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashMap Text Int
-> Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forEach HashMap Text Int
forall k v. HashMap k v
HashMap.empty
forEach :: HashMap Text Int
-> Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forEach HashMap Text Int
accumulator = \case
Full.FieldSelection Field
fieldSelection -> HashMap Text Int
-> Field
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forField HashMap Text Int
accumulator Field
fieldSelection
Full.InlineFragmentSelection InlineFragment
fragmentSelection ->
HashMap Text Int
-> InlineFragment
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forInline HashMap Text Int
accumulator InlineFragment
fragmentSelection
Full.FragmentSpreadSelection FragmentSpread
fragmentSelection ->
HashMap Text Int
-> FragmentSpread
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forSpread HashMap Text Int
accumulator FragmentSpread
fragmentSelection
forSpread :: HashMap Text Int
-> FragmentSpread
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forSpread HashMap Text Int
accumulator (Full.FragmentSpread Text
fragmentName [Directive]
_ Location
_) = do
Text
firstFragmentName <- ((Int, Text) -> Text)
-> StateT (Int, Text) (ReaderT (Validation m) Seq) Text
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Int, Text) -> Text
forall a b. (a, b) -> b
snd
((Int, Text) -> (Int, Text))
-> StateT (Int, Text) (ReaderT (Validation m) Seq) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (((Int, Text) -> (Int, Text))
-> StateT (Int, Text) (ReaderT (Validation m) Seq) ())
-> ((Int, Text) -> (Int, Text))
-> StateT (Int, Text) (ReaderT (Validation m) Seq) ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> (Int, Text) -> (Int, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Int
lastIndex <- ((Int, Text) -> Int)
-> StateT (Int, Text) (ReaderT (Validation m) Seq) Int
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Int, Text) -> Int
forall a b. (a, b) -> a
fst
let newAccumulator :: HashMap Text Int
newAccumulator = Text -> Int -> HashMap Text Int -> HashMap Text Int
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
fragmentName Int
lastIndex HashMap Text Int
accumulator
let inVisitetFragment :: Bool
inVisitetFragment = Text -> HashMap Text Int -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
fragmentName HashMap Text Int
accumulator
if Text
fragmentName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
firstFragmentName Bool -> Bool -> Bool
|| Bool
inVisitetFragment
then HashMap Text Int
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall a. a -> StateT (Int, Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Int
newAccumulator
else Text
-> HashMap Text Int
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectFromSpread Text
fragmentName HashMap Text Int
newAccumulator
forInline :: HashMap Text Int
-> InlineFragment
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forInline HashMap Text Int
accumulator (Full.InlineFragment Maybe Text
_ [Directive]
_ SelectionSet
selections Location
_) =
(HashMap Text Int
accumulator HashMap Text Int -> HashMap Text Int -> HashMap Text Int
forall a. Semigroup a => a -> a -> a
<>) (HashMap Text Int -> HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (t :: * -> *).
Traversable t =>
t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectCycles SelectionSet
selections
forField :: HashMap Text Int
-> Field
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forField HashMap Text Int
accumulator (Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
selections Location
_) =
(HashMap Text Int
accumulator HashMap Text Int -> HashMap Text Int -> HashMap Text Int
forall a. Semigroup a => a -> a -> a
<>) (HashMap Text Int -> HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSetOpt
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (t :: * -> *).
Traversable t =>
t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectCycles SelectionSetOpt
selections
collectFromSpread :: Text
-> HashMap Text Int
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectFromSpread Text
fragmentName HashMap Text Int
accumulator = do
Document
ast' <- ReaderT (Validation m) Seq Document
-> StateT (Int, Text) (ReaderT (Validation m) Seq) Document
forall (m :: * -> *) a. Monad m => m a -> StateT (Int, Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq Document
-> StateT (Int, Text) (ReaderT (Validation m) Seq) Document)
-> ReaderT (Validation m) Seq Document
-> StateT (Int, Text) (ReaderT (Validation m) Seq) Document
forall a b. (a -> b) -> a -> b
$ (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> HashMap Text Int
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall a. a -> StateT (Int, Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text Int
accumulator
Just (Full.FragmentDefinition Text
_ Text
_ [Directive]
_ SelectionSet
selections Location
_) ->
(HashMap Text Int
accumulator HashMap Text Int -> HashMap Text Int -> HashMap Text Int
forall a. Semigroup a => a -> a -> a
<>) (HashMap Text Int -> HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionSet
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
forall (t :: * -> *).
Traversable t =>
t Selection
-> StateT
(Int, Text) (ReaderT (Validation m) Seq) (HashMap Text Int)
collectCycles SelectionSet
selections
findFragmentDefinition :: Text
-> NonEmpty Full.Definition
-> Maybe Full.FragmentDefinition
findFragmentDefinition :: Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName = (Definition
-> Maybe FragmentDefinition -> Maybe FragmentDefinition)
-> Maybe FragmentDefinition -> Document -> Maybe FragmentDefinition
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> Maybe FragmentDefinition -> Maybe FragmentDefinition
compareDefinition Maybe FragmentDefinition
forall a. Maybe a
Nothing
where
compareDefinition :: Definition -> Maybe FragmentDefinition -> Maybe FragmentDefinition
compareDefinition (Full.ExecutableDefinition ExecutableDefinition
executableDefinition) Maybe FragmentDefinition
Nothing
| Full.DefinitionFragment FragmentDefinition
fragmentDefinition <- ExecutableDefinition
executableDefinition
, Full.FragmentDefinition Text
anotherName Text
_ [Directive]
_ SelectionSet
_ Location
_ <- FragmentDefinition
fragmentDefinition
, Text
anotherName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fragmentName = FragmentDefinition -> Maybe FragmentDefinition
forall a. a -> Maybe a
Just FragmentDefinition
fragmentDefinition
compareDefinition Definition
_ Maybe FragmentDefinition
accumulator = Maybe FragmentDefinition
accumulator
uniqueArgumentNamesRule :: forall m. Rule m
uniqueArgumentNamesRule :: forall (m :: * -> *). Rule m
uniqueArgumentNamesRule = (Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule Maybe (Type m) -> Field -> RuleT m
forall {t :: (* -> *) -> * -> *} {p}.
MonadTrans t =>
p -> Field -> t Seq Error
fieldRule Directive -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Directive -> t Seq Error
directiveRule
where
fieldRule :: p -> Field -> t Seq Error
fieldRule p
_ (Full.Field Maybe Text
_ Text
_ [Argument]
arguments [Directive]
_ SelectionSetOpt
_ Location
_) =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ (Argument -> (Text, Location)) -> String -> [Argument] -> Seq Error
forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates Argument -> (Text, Location)
extract String
"argument" [Argument]
arguments
directiveRule :: Directive -> t Seq Error
directiveRule (Full.Directive Text
_ [Argument]
arguments Location
_) =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ (Argument -> (Text, Location)) -> String -> [Argument] -> Seq Error
forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates Argument -> (Text, Location)
extract String
"argument" [Argument]
arguments
extract :: Argument -> (Text, Location)
extract (Full.Argument Text
argumentName Node Value
_ Location
location') = (Text
argumentName, Location
location')
uniqueDirectiveNamesRule :: forall m. Rule m
uniqueDirectiveNamesRule :: forall (m :: * -> *). Rule m
uniqueDirectiveNamesRule = (DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule
((DirectiveLocation -> [Directive] -> RuleT m) -> Rule m)
-> (DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ ([Directive] -> RuleT m)
-> DirectiveLocation -> [Directive] -> RuleT m
forall a b. a -> b -> a
const (([Directive] -> RuleT m)
-> DirectiveLocation -> [Directive] -> RuleT m)
-> ([Directive] -> RuleT m)
-> DirectiveLocation
-> [Directive]
-> RuleT m
forall a b. (a -> b) -> a -> b
$ Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> RuleT m)
-> ([Directive] -> Seq Error) -> [Directive] -> RuleT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Directive -> (Text, Location))
-> String -> [Directive] -> Seq Error
forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates Directive -> (Text, Location)
extract String
"directive"
where
extract :: Directive -> (Text, Location)
extract (Full.Directive Text
directiveName [Argument]
_ Location
location') =
(Text
directiveName, Location
location')
groupSorted :: forall a. (a -> Text) -> [a] -> [[a]]
groupSorted :: forall a. (a -> Text) -> [a] -> [[a]]
groupSorted a -> Text
getName = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
equalByName ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn a -> Text
getName
where
equalByName :: a -> a -> Bool
equalByName a
lhs a
rhs = a -> Text
getName a
lhs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Text
getName a
rhs
filterDuplicates :: forall a
. (a -> (Text, Full.Location))
-> String
-> [a]
-> Seq Error
filterDuplicates :: forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates a -> (Text, Location)
extract String
nodeType = [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList
([Error] -> Seq Error) -> ([a] -> [Error]) -> [a] -> Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Error) -> [[a]] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Error
makeError
([[a]] -> [Error]) -> ([a] -> [[a]]) -> [a] -> [Error]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [[a]]
forall a. (a -> Text) -> [a] -> [[a]]
groupSorted a -> Text
getName
where
getName :: a -> Text
getName = (Text, Location) -> Text
forall a b. (a, b) -> a
fst ((Text, Location) -> Text) -> (a -> (Text, Location)) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Text, Location)
extract
makeError :: [a] -> Error
makeError [a]
directives' = Error
{ message :: String
message = a -> String
makeMessage (a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
directives'
, locations :: [Location]
locations = (Text, Location) -> Location
forall a b. (a, b) -> b
snd ((Text, Location) -> Location)
-> (a -> (Text, Location)) -> a -> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Text, Location)
extract (a -> Location) -> [a] -> [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
directives'
}
makeMessage :: a -> String
makeMessage a
directive = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"There can be only one "
, String
nodeType
, String
" named \""
, Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text, Location) -> Text
forall a b. (a, b) -> a
fst ((Text, Location) -> Text) -> (Text, Location) -> Text
forall a b. (a -> b) -> a -> b
$ a -> (Text, Location)
extract a
directive
, String
"\"."
]
uniqueVariableNamesRule :: forall m. Rule m
uniqueVariableNamesRule :: forall (m :: * -> *). Rule m
uniqueVariableNamesRule = ([VariableDefinition] -> RuleT m) -> Rule m
forall (m :: * -> *). ([VariableDefinition] -> RuleT m) -> Rule m
VariablesRule
(([VariableDefinition] -> RuleT m) -> Rule m)
-> ([VariableDefinition] -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> RuleT m)
-> ([VariableDefinition] -> Seq Error)
-> [VariableDefinition]
-> RuleT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VariableDefinition -> (Text, Location))
-> String -> [VariableDefinition] -> Seq Error
forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates VariableDefinition -> (Text, Location)
extract String
"variable"
where
extract :: VariableDefinition -> (Text, Location)
extract (Full.VariableDefinition Text
variableName Type
_ Maybe (Node ConstValue)
_ Location
location') =
(Text
variableName, Location
location')
variablesAreInputTypesRule :: forall m. Rule m
variablesAreInputTypesRule :: forall (m :: * -> *). Rule m
variablesAreInputTypesRule = ([VariableDefinition] -> RuleT m) -> Rule m
forall (m :: * -> *). ([VariableDefinition] -> RuleT m) -> Rule m
VariablesRule
(([VariableDefinition] -> RuleT m) -> Rule m)
-> ([VariableDefinition] -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ ((VariableDefinition -> RuleT m)
-> Seq VariableDefinition -> ReaderT (Validation m) Seq (Seq Error)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse VariableDefinition -> RuleT m
forall {m :: * -> *} {m :: * -> *}.
(Monad m, Monoid (m Error)) =>
VariableDefinition -> ReaderT (Validation m) m Error
check (Seq VariableDefinition -> ReaderT (Validation m) Seq (Seq Error))
-> ([VariableDefinition] -> Seq VariableDefinition)
-> [VariableDefinition]
-> ReaderT (Validation m) Seq (Seq Error)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VariableDefinition] -> Seq VariableDefinition
forall a. [a] -> Seq a
Seq.fromList) ([VariableDefinition] -> ReaderT (Validation m) Seq (Seq Error))
-> (Seq Error -> RuleT m) -> [VariableDefinition] -> RuleT m
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
where
check :: VariableDefinition -> ReaderT (Validation m) m Error
check (Full.VariableDefinition Text
name Type
typeName Maybe (Node ConstValue)
_ Location
location')
= (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) m (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema)
ReaderT (Validation m) m (HashMap Text (Type m))
-> (HashMap Text (Type m) -> ReaderT (Validation m) m Error)
-> ReaderT (Validation m) m Error
forall a b.
ReaderT (Validation m) m a
-> (a -> ReaderT (Validation m) m b) -> ReaderT (Validation m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Error -> ReaderT (Validation m) m Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(m Error -> ReaderT (Validation m) m Error)
-> (HashMap Text (Type m) -> m Error)
-> HashMap Text (Type m)
-> ReaderT (Validation m) m Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Error -> (Type -> m Error) -> Maybe Type -> m Error
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Type -> Location -> m Error
forall {f :: * -> *}.
Applicative f =>
Text -> Type -> Location -> f Error
makeError Text
name Type
typeName Location
location') (m Error -> Type -> m Error
forall a b. a -> b -> a
const m Error
forall a. Monoid a => a
mempty)
(Maybe Type -> m Error)
-> (HashMap Text (Type m) -> Maybe Type)
-> HashMap Text (Type m)
-> m Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> HashMap Text (Type m) -> Maybe Type
forall (m :: * -> *). Type -> HashMap Text (Type m) -> Maybe Type
Type.lookupInputType Type
typeName
makeError :: Text -> Type -> Location -> f Error
makeError Text
name Type
typeName Location
location' = Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> f Error) -> Error -> f Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
name
, String
"\" cannot be non-input type \""
, Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Type -> Text
getTypeName Type
typeName
, String
"\"."
]
, locations :: [Location]
locations = [Location
location']
}
getTypeName :: Type -> Text
getTypeName (Full.TypeNamed Text
name) = Text
name
getTypeName (Full.TypeList Type
name) = Type -> Text
getTypeName Type
name
getTypeName (Full.TypeNonNull (Full.NonNullTypeNamed Text
nonNull)) = Text
nonNull
getTypeName (Full.TypeNonNull (Full.NonNullTypeList Type
nonNull)) =
Type -> Text
getTypeName Type
nonNull
noUndefinedVariablesRule :: forall m. Rule m
noUndefinedVariablesRule :: forall (m :: * -> *). Rule m
noUndefinedVariablesRule =
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
forall (m :: * -> *).
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
variableUsageDifference (UsageDifference -> UsageDifference
forall a b c. (a -> b -> c) -> b -> a -> c
flip UsageDifference
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference) Maybe Text -> Text -> String
errorMessage
where
errorMessage :: Maybe Text -> Text -> String
errorMessage Maybe Text
Nothing Text
variableName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" is not defined."
]
errorMessage (Just Text
operationName) Text
variableName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" is not defined by operation \""
, Text -> String
Text.unpack Text
operationName
, String
"\"."
]
type UsageDifference
= HashMap Full.Name [Full.Location]
-> HashMap Full.Name [Full.Location]
-> HashMap Full.Name [Full.Location]
variableUsageDifference :: forall m. UsageDifference
-> (Maybe Full.Name -> Full.Name -> String)
-> Rule m
variableUsageDifference :: forall (m :: * -> *).
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
variableUsageDifference UsageDifference
difference Maybe Text -> Text -> String
errorMessage = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
_ Location
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Full.OperationDefinition OperationType
_ Maybe Text
operationName [VariableDefinition]
variables [Directive]
_ SelectionSet
selections Location
_ ->
let variableNames :: HashMap Text [Location]
variableNames = [(Text, [Location])] -> HashMap Text [Location]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, [Location])] -> HashMap Text [Location])
-> [(Text, [Location])] -> HashMap Text [Location]
forall a b. (a -> b) -> a -> b
$ VariableDefinition -> (Text, [Location])
getVariableName (VariableDefinition -> (Text, [Location]))
-> [VariableDefinition] -> [(Text, [Location])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VariableDefinition]
variables
in (Seq (Text, [Location]) -> Seq Error)
-> ReaderT (Validation m) Seq (Text, [Location]) -> RuleT m
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Maybe Text
-> HashMap Text [Location] -> Seq (Text, [Location]) -> Seq Error
forall {t :: * -> *}.
Foldable t =>
Maybe Text
-> HashMap Text [Location] -> t (Text, [Location]) -> Seq Error
readerMapper Maybe Text
operationName HashMap Text [Location]
variableNames)
(ReaderT (Validation m) Seq (Text, [Location]) -> RuleT m)
-> ReaderT (Validation m) Seq (Text, [Location]) -> RuleT m
forall a b. (a -> b) -> a -> b
$ (StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> HashSet Text -> ReaderT (Validation m) Seq (Text, [Location]))
-> HashSet Text
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> HashSet Text -> ReaderT (Validation m) Seq (Text, [Location])
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HashSet Text
forall a. HashSet a
HashSet.empty
(StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall a b. (a -> b) -> a -> b
$ SelectionSetOpt
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (t :: * -> *).
Foldable t =>
t Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
filterSelections'
(SelectionSetOpt
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> SelectionSetOpt
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a b. (a -> b) -> a -> b
$ SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
where
readerMapper :: Maybe Text
-> HashMap Text [Location] -> t (Text, [Location]) -> Seq Error
readerMapper Maybe Text
operationName HashMap Text [Location]
variableNames' = [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList
([Error] -> Seq Error)
-> (t (Text, [Location]) -> [Error])
-> t (Text, [Location])
-> Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [Location]) -> Error) -> [(Text, [Location])] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> (Text, [Location]) -> Error
makeError Maybe Text
operationName)
([(Text, [Location])] -> [Error])
-> (t (Text, [Location]) -> [(Text, [Location])])
-> t (Text, [Location])
-> [Error]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text [Location] -> [(Text, [Location])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
(HashMap Text [Location] -> [(Text, [Location])])
-> (t (Text, [Location]) -> HashMap Text [Location])
-> t (Text, [Location])
-> [(Text, [Location])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsageDifference
difference HashMap Text [Location]
variableNames'
(HashMap Text [Location] -> HashMap Text [Location])
-> (t (Text, [Location]) -> HashMap Text [Location])
-> t (Text, [Location])
-> HashMap Text [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Location] -> [Location] -> [Location])
-> [(Text, [Location])] -> HashMap Text [Location]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
(++)
([(Text, [Location])] -> HashMap Text [Location])
-> (t (Text, [Location]) -> [(Text, [Location])])
-> t (Text, [Location])
-> HashMap Text [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (Text, [Location]) -> [(Text, [Location])]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
getVariableName :: VariableDefinition -> (Text, [Location])
getVariableName (Full.VariableDefinition Text
variableName Type
_ Maybe (Node ConstValue)
_ Location
location') =
(Text
variableName, [Location
location'])
filterSelections' :: Foldable t
=> t Full.Selection
-> ValidationState m (Full.Name, [Full.Location])
filterSelections' :: forall (t :: * -> *).
Foldable t =>
t Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
filterSelections' = (Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> t Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a (m :: * -> *).
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
forall (t :: * -> *) a (m :: * -> *).
Foldable t =>
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
filterSelections Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
variableFilter
variableFilter :: Full.Selection -> ValidationState m (Full.Name, [Full.Location])
variableFilter :: Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
variableFilter (Full.InlineFragmentSelection InlineFragment
inline)
| Full.InlineFragment Maybe Text
_ [Directive]
directives' SelectionSet
_ Location
_ <- InlineFragment
inline =
ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a b. (a -> b) -> a -> b
$ Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall a b. (a -> b) -> a -> b
$ [Directive] -> Seq (Text, [Location])
mapDirectives [Directive]
directives'
variableFilter (Full.FieldSelection Field
fieldSelection)
| Full.Field Maybe Text
_ Text
_ [Argument]
arguments [Directive]
directives' SelectionSetOpt
_ Location
_ <- Field
fieldSelection =
ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a b. (a -> b) -> a -> b
$ Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall a b. (a -> b) -> a -> b
$ [Argument] -> Seq (Text, [Location])
mapArguments [Argument]
arguments Seq (Text, [Location])
-> Seq (Text, [Location]) -> Seq (Text, [Location])
forall a. Semigroup a => a -> a -> a
<> [Directive] -> Seq (Text, [Location])
mapDirectives [Directive]
directives'
variableFilter (Full.FragmentSpreadSelection FragmentSpread
spread)
| Full.FragmentSpread Text
fragmentName [Directive]
_ Location
_ <- FragmentSpread
spread = do
Maybe FragmentDefinition
nonVisitedFragmentDefinition <- Text -> ValidationState m (Maybe FragmentDefinition)
forall (m :: * -> *).
Text -> ValidationState m (Maybe FragmentDefinition)
visitFragmentDefinition Text
fragmentName
case Maybe FragmentDefinition
nonVisitedFragmentDefinition of
Just FragmentDefinition
fragmentDefinition -> FragmentDefinition
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
diveIntoSpread FragmentDefinition
fragmentDefinition
Maybe FragmentDefinition
_ -> ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a b. (a -> b) -> a -> b
$ Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq (Text, [Location])
forall a. Monoid a => a
mempty
diveIntoSpread :: FragmentDefinition
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
diveIntoSpread (Full.FragmentDefinition Text
_ Text
_ [Directive]
directives' SelectionSet
selections Location
_)
= SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (t :: * -> *).
Foldable t =>
t Selection
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
filterSelections' SelectionSet
selections
StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
-> ((Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall a b.
StateT (HashSet Text) (ReaderT (Validation m) Seq) a
-> (a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) b)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location]))
-> ((Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> (Text, [Location])
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (Text, [Location])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq (Text, [Location]) -> Seq (Text, [Location]))
-> ReaderT (Validation m) Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Seq (Text, [Location])
-> Seq (Text, [Location]) -> Seq (Text, [Location])
forall a. Semigroup a => a -> a -> a
<> [Directive] -> Seq (Text, [Location])
mapDirectives [Directive]
directives') (ReaderT (Validation m) Seq (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> ((Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location]))
-> (Text, [Location])
-> ReaderT (Validation m) Seq (Text, [Location])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Location]) -> ReaderT (Validation m) Seq (Text, [Location])
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
findDirectiveVariables :: Directive -> Seq (Text, [Location])
findDirectiveVariables (Full.Directive Text
_ [Argument]
arguments Location
_) = [Argument] -> Seq (Text, [Location])
mapArguments [Argument]
arguments
mapArguments :: [Argument] -> Seq (Text, [Location])
mapArguments = [(Text, [Location])] -> Seq (Text, [Location])
forall a. [a] -> Seq a
Seq.fromList ([(Text, [Location])] -> Seq (Text, [Location]))
-> ([Argument] -> [(Text, [Location])])
-> [Argument]
-> Seq (Text, [Location])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Argument]
-> (Argument -> [(Text, [Location])]) -> [(Text, [Location])]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Argument -> [(Text, [Location])]
findArgumentVariables)
mapDirectives :: [Directive] -> Seq (Text, [Location])
mapDirectives = (Directive -> Seq (Text, [Location]))
-> [Directive] -> Seq (Text, [Location])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Directive -> Seq (Text, [Location])
findDirectiveVariables
findArgumentVariables :: Argument -> [(Text, [Location])]
findArgumentVariables (Full.Argument Text
_ Node Value
value Location
_) = Node Value -> [(Text, [Location])]
findNodeVariables Node Value
value
findNodeVariables :: Node Value -> [(Text, [Location])]
findNodeVariables Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Value
value, Location
location :: Location
$sel:location:Node :: forall a. Node a -> Location
..} = Location -> Value -> [(Text, [Location])]
findValueVariables Location
location Value
value
findValueVariables :: Location -> Value -> [(Text, [Location])]
findValueVariables Location
location (Full.Variable Text
value') = [(Text
value', [Location
location])]
findValueVariables Location
_ (Full.List [Node Value]
values) = [Node Value]
values [Node Value]
-> (Node Value -> [(Text, [Location])]) -> [(Text, [Location])]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node Value -> [(Text, [Location])]
findNodeVariables
findValueVariables Location
_ (Full.Object [ObjectField Value]
fields) = [ObjectField Value]
fields
[ObjectField Value]
-> (ObjectField Value -> [(Text, [Location])])
-> [(Text, [Location])]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Node Value -> [(Text, [Location])]
findNodeVariables (Node Value -> [(Text, [Location])])
-> (ObjectField Value -> Node Value)
-> ObjectField Value
-> [(Text, [Location])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) r a. HasField x r a => r -> a
forall (x :: Symbol) r a. HasField x r a => r -> a
getField @"value"
findValueVariables Location
_ Value
_ = []
makeError :: Maybe Text -> (Text, [Location]) -> Error
makeError Maybe Text
operationName (Text
variableName, [Location]
locations') = Error
{ message :: String
message = Maybe Text -> Text -> String
errorMessage Maybe Text
operationName Text
variableName
, locations :: [Location]
locations = [Location]
locations'
}
noUnusedVariablesRule :: forall m. Rule m
noUnusedVariablesRule :: forall (m :: * -> *). Rule m
noUnusedVariablesRule = UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
forall (m :: * -> *).
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
variableUsageDifference UsageDifference
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference Maybe Text -> Text -> String
errorMessage
where
errorMessage :: Maybe Text -> Text -> String
errorMessage Maybe Text
Nothing Text
variableName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" is never used."
]
errorMessage (Just Text
operationName) Text
variableName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" is never used in operation \""
, Text -> String
Text.unpack Text
operationName
, String
"\"."
]
uniqueInputFieldNamesRule :: forall m. Rule m
uniqueInputFieldNamesRule :: forall (m :: * -> *). Rule m
uniqueInputFieldNamesRule =
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule ((Node Value -> RuleT m) -> Maybe Type -> Node Value -> RuleT m
forall a b. a -> b -> a
const ((Node Value -> RuleT m) -> Maybe Type -> Node Value -> RuleT m)
-> (Node Value -> RuleT m) -> Maybe Type -> Node Value -> RuleT m
forall a b. (a -> b) -> a -> b
$ Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> RuleT m)
-> (Node Value -> Seq Error) -> Node Value -> RuleT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Value -> Seq Error
go) ((Node ConstValue -> RuleT m)
-> Maybe Type -> Node ConstValue -> RuleT m
forall a b. a -> b -> a
const ((Node ConstValue -> RuleT m)
-> Maybe Type -> Node ConstValue -> RuleT m)
-> (Node ConstValue -> RuleT m)
-> Maybe Type
-> Node ConstValue
-> RuleT m
forall a b. (a -> b) -> a -> b
$ Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> RuleT m)
-> (Node ConstValue -> Seq Error) -> Node ConstValue -> RuleT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node ConstValue -> Seq Error
constGo)
where
go :: Node Value -> Seq Error
go (Full.Node (Full.Object [ObjectField Value]
fields) Location
_) = [ObjectField Value] -> Seq Error
forall {a}. [ObjectField a] -> Seq Error
filterFieldDuplicates [ObjectField Value]
fields
go Node Value
_ = Seq Error
forall a. Monoid a => a
mempty
filterFieldDuplicates :: [ObjectField a] -> Seq Error
filterFieldDuplicates = (ObjectField a -> (Text, Location))
-> String -> [ObjectField a] -> Seq Error
forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates ObjectField a -> (Text, Location)
forall {a}. ObjectField a -> (Text, Location)
getFieldName String
"input field"
getFieldName :: ObjectField a -> (Text, Location)
getFieldName (Full.ObjectField Text
fieldName Node a
_ Location
location') = (Text
fieldName, Location
location')
constGo :: Node ConstValue -> Seq Error
constGo (Full.Node (Full.ConstObject [ObjectField ConstValue]
fields) Location
_) = [ObjectField ConstValue] -> Seq Error
forall {a}. [ObjectField a] -> Seq Error
filterFieldDuplicates [ObjectField ConstValue]
fields
constGo Node ConstValue
_ = Seq Error
forall a. Monoid a => a
mempty
fieldsOnCorrectTypeRule :: forall m. Rule m
fieldsOnCorrectTypeRule :: forall (m :: * -> *). Rule m
fieldsOnCorrectTypeRule = (Maybe (Type m) -> Field -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m) -> Rule m
FieldRule Maybe (Type m) -> Field -> RuleT m
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {m :: * -> *}.
(MonadTrans t, Monad m, Monoid (m Error), Applicative (t m)) =>
Maybe (Type m) -> Field -> t m Error
fieldRule
where
fieldRule :: Maybe (Type m) -> Field -> t m Error
fieldRule Maybe (Type m)
parentType (Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
location')
| Just Type m
objectType <- Maybe (Type m)
parentType
, Maybe (Field m)
Nothing <- Text -> Type m -> Maybe (Field m)
forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type m
objectType
, Just Text
typeName <- Type m -> Maybe Text
forall (m :: * -> *). Type m -> Maybe Text
typeNameIfComposite Type m
objectType = Error -> t m Error
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> t m Error) -> Error -> t m Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> Text -> String
errorMessage Text
fieldName Text
typeName
, locations :: [Location]
locations = [Location
location']
}
| Bool
otherwise = m Error -> t m Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Error
forall a. Monoid a => a
mempty
errorMessage :: Text -> Text -> String
errorMessage Text
fieldName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Cannot query field \""
, Text -> String
Text.unpack Text
fieldName
, String
"\" on type \""
, Text -> String
Text.unpack Text
typeName
, String
"\"."
]
compositeTypeName :: forall m. Type.CompositeType m -> Full.Name
compositeTypeName :: forall (m :: * -> *). CompositeType m -> Text
compositeTypeName (Type.CompositeObjectType (Out.ObjectType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
_)) =
Text
typeName
compositeTypeName (Type.CompositeInterfaceType InterfaceType m
interfaceType) =
let Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_ = InterfaceType m
interfaceType
in Text
typeName
compositeTypeName (Type.CompositeUnionType (Out.UnionType Text
typeName Maybe Text
_ [ObjectType m]
_)) =
Text
typeName
typeNameIfComposite :: forall m. Out.Type m -> Maybe Full.Name
typeNameIfComposite :: forall (m :: * -> *). Type m -> Maybe Text
typeNameIfComposite = (CompositeType m -> Text) -> Maybe (CompositeType m) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompositeType m -> Text
forall (m :: * -> *). CompositeType m -> Text
compositeTypeName (Maybe (CompositeType m) -> Maybe Text)
-> (Type m -> Maybe (CompositeType m)) -> Type m -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type m -> Maybe (CompositeType m)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite
scalarLeafsRule :: forall m. Rule m
scalarLeafsRule :: forall (m :: * -> *). Rule m
scalarLeafsRule = (Maybe (Type m) -> Field -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m) -> Rule m
FieldRule Maybe (Type m) -> Field -> RuleT m
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {m :: * -> *}.
(MonadTrans t, Monad m, Monoid (m Error)) =>
Maybe (Type m) -> Field -> t m Error
fieldRule
where
fieldRule :: Maybe (Type m) -> Field -> t m Error
fieldRule Maybe (Type m)
parentType selectionField :: Field
selectionField@(Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_)
| Just Type m
objectType <- Maybe (Type m)
parentType
, Just Field m
field <- Text -> Type m -> Maybe (Field m)
forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type m
objectType =
let Out.Field Maybe Text
_ Type m
fieldType Arguments
_ = Field m
field
in m Error -> t m Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Error -> t m Error) -> m Error -> t m Error
forall a b. (a -> b) -> a -> b
$ Type m -> Field -> m Error
forall {f :: * -> *} {m :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Type m -> Field -> f Error
check Type m
fieldType Field
selectionField
| Bool
otherwise = m Error -> t m Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Error
forall a. Monoid a => a
mempty
check :: Type m -> Field -> f Error
check (Out.ObjectBaseType (Out.ObjectType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
_)) =
Text -> Field -> f Error
forall {f :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Text -> Field -> f Error
checkNotEmpty Text
typeName
check (Out.InterfaceBaseType (Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_)) =
Text -> Field -> f Error
forall {f :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Text -> Field -> f Error
checkNotEmpty Text
typeName
check (Out.UnionBaseType (Out.UnionType Text
typeName Maybe Text
_ [ObjectType m]
_)) =
Text -> Field -> f Error
forall {f :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Text -> Field -> f Error
checkNotEmpty Text
typeName
check (Out.ScalarBaseType (Definition.ScalarType Text
typeName Maybe Text
_)) =
Text -> Field -> f Error
forall {f :: * -> *}.
(Monoid (f Error), Applicative f) =>
Text -> Field -> f Error
checkEmpty Text
typeName
check (Out.EnumBaseType (Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_)) =
Text -> Field -> f Error
forall {f :: * -> *}.
(Monoid (f Error), Applicative f) =>
Text -> Field -> f Error
checkEmpty Text
typeName
check (Out.ListBaseType Type m
wrappedType) = Type m -> Field -> f Error
check Type m
wrappedType
checkNotEmpty :: Text -> Field -> f Error
checkNotEmpty Text
typeName (Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ [] Location
location') =
let fieldName' :: String
fieldName' = Text -> String
Text.unpack Text
fieldName
in Location -> String -> f Error
forall {f :: * -> *}.
Applicative f =>
Location -> String -> f Error
makeError Location
location' (String -> f Error) -> String -> f Error
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Field \""
, String
fieldName'
, String
"\" of type \""
, Text -> String
Text.unpack Text
typeName
, String
"\" must have a selection of subfields. Did you mean \""
, String
fieldName'
, String
" { ... }\"?"
]
checkNotEmpty Text
_ Field
_ = f Error
forall a. Monoid a => a
mempty
checkEmpty :: Text -> Field -> f Error
checkEmpty Text
_ (Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ [] Location
_) = f Error
forall a. Monoid a => a
mempty
checkEmpty Text
typeName Field
field' =
let Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
location' = Field
field'
in Location -> String -> f Error
forall {f :: * -> *}.
Applicative f =>
Location -> String -> f Error
makeError Location
location' (String -> f Error) -> String -> f Error
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Field \""
, Text -> String
Text.unpack Text
fieldName
, String
"\" must not have a selection since type \""
, Text -> String
Text.unpack Text
typeName
, String
"\" has no subfields."
]
makeError :: Location -> String -> f Error
makeError Location
location' String
errorMessage = Error -> f Error
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> f Error) -> Error -> f Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = String
errorMessage
, locations :: [Location]
locations = [Location
location']
}
knownArgumentNamesRule :: forall m. Rule m
knownArgumentNamesRule :: forall (m :: * -> *). Rule m
knownArgumentNamesRule = (Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule Maybe (Type m) -> Field -> RuleT m
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
MonadTrans t =>
Maybe (Type m) -> Field -> t Seq Error
fieldRule Directive -> RuleT m
forall {m :: * -> *}. Directive -> ReaderT (Validation m) Seq Error
directiveRule
where
fieldRule :: Maybe (Type m) -> Field -> t Seq Error
fieldRule (Just Type m
objectType) (Full.Field Maybe Text
_ Text
fieldName [Argument]
arguments [Directive]
_ SelectionSetOpt
_ Location
_)
| Just Field m
typeField <- Text -> Type m -> Maybe (Field m)
forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type m
objectType
, Just Text
typeName <- Type m -> Maybe Text
forall (m :: * -> *). Type m -> Maybe Text
typeNameIfComposite Type m
objectType =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ (Argument -> Seq Error -> Seq Error)
-> Seq Error -> [Argument] -> Seq Error
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> Text -> Field m -> Argument -> Seq Error -> Seq Error
forall {m :: * -> *}.
Text -> Text -> Field m -> Argument -> Seq Error -> Seq Error
go Text
typeName Text
fieldName Field m
typeField) Seq Error
forall a. Seq a
Seq.empty [Argument]
arguments
fieldRule Maybe (Type m)
_ Field
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
go :: Text -> Text -> Field m -> Argument -> Seq Error -> Seq Error
go Text
typeName Text
fieldName Field m
fieldDefinition (Full.Argument Text
argumentName Node Value
_ Location
location') Seq Error
errors
| Out.Field Maybe Text
_ Type m
_ Arguments
definitions <- Field m
fieldDefinition
, Just Argument
_ <- Text -> Arguments -> Maybe Argument
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
argumentName Arguments
definitions = Seq Error
errors
| Bool
otherwise = Seq Error
errors Seq Error -> Error -> Seq Error
forall a. Seq a -> a -> Seq a
|> Error
{ message :: String
message = Text -> Text -> Text -> String
fieldMessage Text
argumentName Text
fieldName Text
typeName
, locations :: [Location]
locations = [Location
location']
}
fieldMessage :: Text -> Text -> Text -> String
fieldMessage Text
argumentName Text
fieldName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Unknown argument \""
, Text -> String
Text.unpack Text
argumentName
, String
"\" on field \""
, Text -> String
Text.unpack Text
typeName
, String
"."
, Text -> String
Text.unpack Text
fieldName
, String
"\"."
]
directiveRule :: Directive -> ReaderT (Validation m) Seq Error
directiveRule (Full.Directive Text
directiveName [Argument]
arguments Location
_) = do
Maybe Directive
available <- (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive))
-> (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Directive -> Maybe Directive
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName
(HashMap Text Directive -> Maybe Directive)
-> (Validation m -> HashMap Text Directive)
-> Validation m
-> Maybe Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema m -> HashMap Text Directive
forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives (Schema m -> HashMap Text Directive)
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
Full.Argument Text
argumentName Node Value
_ Location
location' <- Seq Argument -> ReaderT (Validation m) Seq Argument
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Argument -> ReaderT (Validation m) Seq Argument)
-> Seq Argument -> ReaderT (Validation m) Seq Argument
forall a b. (a -> b) -> a -> b
$ [Argument] -> Seq Argument
forall a. [a] -> Seq a
Seq.fromList [Argument]
arguments
case Maybe Directive
available of
Just (Schema.Directive Maybe Text
_ [DirectiveLocation]
_ Arguments
definitions)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Arguments -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
argumentName Arguments
definitions ->
Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Location -> Error
makeError Text
argumentName Text
directiveName Location
location'
Maybe Directive
_ -> Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
makeError :: Text -> Text -> Location -> Error
makeError Text
argumentName Text
directiveName Location
location' = Error
{ message :: String
message = Text -> Text -> String
directiveMessage Text
argumentName Text
directiveName
, locations :: [Location]
locations = [Location
location']
}
directiveMessage :: Text -> Text -> String
directiveMessage Text
argumentName Text
directiveName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Unknown argument \""
, Text -> String
Text.unpack Text
argumentName
, String
"\" on directive \"@"
, Text -> String
Text.unpack Text
directiveName
, String
"\"."
]
knownDirectiveNamesRule :: Rule m
knownDirectiveNamesRule :: forall (m :: * -> *). Rule m
knownDirectiveNamesRule = (DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule ((DirectiveLocation -> [Directive] -> RuleT m) -> Rule m)
-> (DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ ([Directive] -> RuleT m)
-> DirectiveLocation -> [Directive] -> RuleT m
forall a b. a -> b -> a
const (([Directive] -> RuleT m)
-> DirectiveLocation -> [Directive] -> RuleT m)
-> ([Directive] -> RuleT m)
-> DirectiveLocation
-> [Directive]
-> RuleT m
forall a b. (a -> b) -> a -> b
$ \[Directive]
directives' -> do
HashMap Text Directive
definitions' <- (Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive))
-> (Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive)
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text Directive
forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives (Schema m -> HashMap Text Directive)
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
let directiveSet :: HashSet Text
directiveSet = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ (Directive -> Text) -> [Directive] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Directive -> Text
directiveName [Directive]
directives'
let definitionSet :: HashSet Text
definitionSet = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ HashMap Text Directive -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Directive
definitions'
let difference :: HashSet Text
difference = HashSet Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet Text
directiveSet HashSet Text
definitionSet
let undefined' :: [Directive]
undefined' = (Directive -> Bool) -> [Directive] -> [Directive]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Text -> Directive -> Bool
definitionFilter HashSet Text
difference) [Directive]
directives'
Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> RuleT m) -> Seq Error -> RuleT m
forall a b. (a -> b) -> a -> b
$ [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList ([Error] -> Seq Error) -> [Error] -> Seq Error
forall a b. (a -> b) -> a -> b
$ Directive -> Error
makeError (Directive -> Error) -> [Directive] -> [Error]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directive]
undefined'
where
definitionFilter :: HashSet Text -> Directive -> Bool
definitionFilter HashSet Text
difference = (Text -> HashSet Text -> Bool) -> HashSet Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member HashSet Text
difference
(Text -> Bool) -> (Directive -> Text) -> Directive -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Directive -> Text
directiveName
directiveName :: Directive -> Text
directiveName (Full.Directive Text
directiveName' [Argument]
_ Location
_) = Text
directiveName'
makeError :: Directive -> Error
makeError (Full.Directive Text
directiveName' [Argument]
_ Location
location') = Error
{ message :: String
message = Text -> String
errorMessage Text
directiveName'
, locations :: [Location]
locations = [Location
location']
}
errorMessage :: Text -> String
errorMessage Text
directiveName' = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Unknown directive \"@"
, Text -> String
Text.unpack Text
directiveName'
, String
"\"."
]
knownInputFieldNamesRule :: Rule m
knownInputFieldNamesRule :: forall (m :: * -> *). Rule m
knownInputFieldNamesRule = (Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule Maybe Type -> Node Value -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go Maybe Type -> Node ConstValue -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node ConstValue -> t Seq Error
constGo
where
go :: Maybe Type -> Node Value -> t Seq Error
go (Just Type
valueType) (Full.Node (Full.Object [ObjectField Value]
inputFields) Location
_)
| In.InputObjectBaseType InputObjectType
objectType <- Type
valueType =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList ([Error] -> Seq Error) -> [Error] -> Seq Error
forall a b. (a -> b) -> a -> b
$ (ObjectField Value -> Maybe Error)
-> [ObjectField Value] -> [Error]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (InputObjectType -> ObjectField Value -> Maybe Error
forall {a}. InputObjectType -> ObjectField a -> Maybe Error
forEach InputObjectType
objectType) [ObjectField Value]
inputFields
go Maybe Type
_ Node Value
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
constGo :: Maybe Type -> Node ConstValue -> t Seq Error
constGo (Just Type
valueType) (Full.Node (Full.ConstObject [ObjectField ConstValue]
inputFields) Location
_)
| In.InputObjectBaseType InputObjectType
objectType <- Type
valueType =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList ([Error] -> Seq Error) -> [Error] -> Seq Error
forall a b. (a -> b) -> a -> b
$ (ObjectField ConstValue -> Maybe Error)
-> [ObjectField ConstValue] -> [Error]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (InputObjectType -> ObjectField ConstValue -> Maybe Error
forall {a}. InputObjectType -> ObjectField a -> Maybe Error
forEach InputObjectType
objectType) [ObjectField ConstValue]
inputFields
constGo Maybe Type
_ Node ConstValue
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
forEach :: InputObjectType -> ObjectField a -> Maybe Error
forEach InputObjectType
objectType (Full.ObjectField Text
inputFieldName Node a
_ Location
location')
| In.InputObjectType Text
_ Maybe Text
_ HashMap Text InputField
fieldTypes <- InputObjectType
objectType
, Just InputField
_ <- Text -> HashMap Text InputField -> Maybe InputField
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
inputFieldName HashMap Text InputField
fieldTypes = Maybe Error
forall a. Maybe a
Nothing
| Bool
otherwise
, In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
_ <- InputObjectType
objectType = Error -> Maybe Error
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> Text -> String
errorMessage Text
inputFieldName Text
typeName
, locations :: [Location]
locations = [Location
location']
}
errorMessage :: Text -> Text -> String
errorMessage Text
fieldName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Field \""
, Text -> String
Text.unpack Text
fieldName
, String
"\" is not defined by type \""
, Text -> String
Text.unpack Text
typeName
, String
"\"."
]
directivesInValidLocationsRule :: Rule m
directivesInValidLocationsRule :: forall (m :: * -> *). Rule m
directivesInValidLocationsRule = (DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule DirectiveLocation -> [Directive] -> RuleT m
forall {m :: * -> *}.
DirectiveLocation
-> [Directive] -> ReaderT (Validation m) Seq Error
directivesRule
where
directivesRule :: DirectiveLocation
-> [Directive] -> ReaderT (Validation m) Seq Error
directivesRule DirectiveLocation
directiveLocation [Directive]
directives' = do
Full.Directive Text
directiveName [Argument]
_ Location
location <- Seq Directive -> ReaderT (Validation m) Seq Directive
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Directive -> ReaderT (Validation m) Seq Directive)
-> Seq Directive -> ReaderT (Validation m) Seq Directive
forall a b. (a -> b) -> a -> b
$ [Directive] -> Seq Directive
forall a. [a] -> Seq a
Seq.fromList [Directive]
directives'
Maybe Directive
maybeDefinition <- (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks
((Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive))
-> (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Directive -> Maybe Directive
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName (HashMap Text Directive -> Maybe Directive)
-> (Validation m -> HashMap Text Directive)
-> Validation m
-> Maybe Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema m -> HashMap Text Directive
forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives (Schema m -> HashMap Text Directive)
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Maybe Directive
maybeDefinition of
Just (Schema.Directive Maybe Text
_ [DirectiveLocation]
allowedLocations Arguments
_)
| DirectiveLocation
directiveLocation DirectiveLocation -> [DirectiveLocation] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [DirectiveLocation]
allowedLocations -> Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> DirectiveLocation -> String
forall {a}. Show a => Text -> a -> String
errorMessage Text
directiveName DirectiveLocation
directiveLocation
, locations :: [Location]
locations = [Location
location]
}
Maybe Directive
_ -> Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
errorMessage :: Text -> a -> String
errorMessage Text
directiveName a
directiveLocation = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Directive \"@"
, Text -> String
Text.unpack Text
directiveName
, String
"\" may not be used on "
, a -> String
forall a. Show a => a -> String
show a
directiveLocation
, String
"."
]
providedRequiredArgumentsRule :: Rule m
providedRequiredArgumentsRule :: forall (m :: * -> *). Rule m
providedRequiredArgumentsRule = (Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule Maybe (Type m) -> Field -> RuleT m
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
MonadTrans t =>
Maybe (Type m) -> Field -> t Seq Error
fieldRule Directive -> RuleT m
forall {m :: * -> *}. Directive -> ReaderT (Validation m) Seq Error
directiveRule
where
fieldRule :: Maybe (Type a) -> Field -> t Seq Error
fieldRule (Just Type a
objectType) (Full.Field Maybe Text
_ Text
fieldName [Argument]
arguments [Directive]
_ SelectionSetOpt
_ Location
location')
| Just Field a
typeField <- Text -> Type a -> Maybe (Field a)
forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type a
objectType
, Out.Field Maybe Text
_ Type a
_ Arguments
definitions <- Field a
typeField =
let forEach :: Text -> Argument -> Seq Error -> Seq Error
forEach = (Text -> Text -> String)
-> [Argument]
-> Location
-> Text
-> Argument
-> Seq Error
-> Seq Error
forall {t :: * -> *}.
Foldable t =>
(Text -> Text -> String)
-> t Argument
-> Location
-> Text
-> Argument
-> Seq Error
-> Seq Error
go (Text -> Text -> Text -> String
fieldMessage Text
fieldName) [Argument]
arguments Location
location'
in Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ (Text -> Argument -> Seq Error -> Seq Error)
-> Seq Error -> Arguments -> Seq Error
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> Argument -> Seq Error -> Seq Error
forEach Seq Error
forall a. Seq a
Seq.empty Arguments
definitions
fieldRule Maybe (Type a)
_ Field
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
directiveRule :: Directive -> ReaderT (Validation m) Seq Error
directiveRule (Full.Directive Text
directiveName [Argument]
arguments Location
location') = do
Maybe Directive
available <- (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks
((Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive))
-> (Validation m -> Maybe Directive)
-> ReaderT (Validation m) Seq (Maybe Directive)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Directive -> Maybe Directive
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName (HashMap Text Directive -> Maybe Directive)
-> (Validation m -> HashMap Text Directive)
-> Validation m
-> Maybe Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema m -> HashMap Text Directive
forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives (Schema m -> HashMap Text Directive)
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Maybe Directive
available of
Just (Schema.Directive Maybe Text
_ [DirectiveLocation]
_ Arguments
definitions) ->
let forEach :: Text -> Argument -> Seq Error -> Seq Error
forEach = (Text -> Text -> String)
-> [Argument]
-> Location
-> Text
-> Argument
-> Seq Error
-> Seq Error
forall {t :: * -> *}.
Foldable t =>
(Text -> Text -> String)
-> t Argument
-> Location
-> Text
-> Argument
-> Seq Error
-> Seq Error
go (Text -> Text -> Text -> String
directiveMessage Text
directiveName) [Argument]
arguments Location
location'
in Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> ReaderT (Validation m) Seq Error)
-> Seq Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ (Text -> Argument -> Seq Error -> Seq Error)
-> Seq Error -> Arguments -> Seq Error
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> Argument -> Seq Error -> Seq Error
forEach Seq Error
forall a. Seq a
Seq.empty Arguments
definitions
Maybe Directive
_ -> Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
go :: (Text -> Text -> String)
-> t Argument
-> Location
-> Text
-> Argument
-> Seq Error
-> Seq Error
go Text -> Text -> String
makeMessage t Argument
arguments Location
location' Text
argumentName Argument
argumentType Seq Error
errors
| In.Argument Maybe Text
_ Type
type' Maybe Value
optionalValue <- Argument
argumentType
, Type -> Bool
In.isNonNullType Type
type'
, Text
typeName <- Type -> Text
inputTypeName Type
type'
, Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Value
optionalValue
, Maybe Argument -> Bool
isNothingOrNull (Maybe Argument -> Bool) -> Maybe Argument -> Bool
forall a b. (a -> b) -> a -> b
$ (Argument -> Bool) -> t Argument -> Maybe Argument
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Argument -> Bool
lookupArgument Text
argumentName) t Argument
arguments
= Seq Error
errors
Seq Error -> Error -> Seq Error
forall a. Seq a -> a -> Seq a
|> String -> Location -> Error
makeError (Text -> Text -> String
makeMessage Text
argumentName Text
typeName) Location
location'
| Bool
otherwise = Seq Error
errors
makeError :: String -> Location -> Error
makeError String
errorMessage Location
location' = Error
{ message :: String
message = String
errorMessage
, locations :: [Location]
locations = [Location
location']
}
isNothingOrNull :: Maybe Argument -> Bool
isNothingOrNull (Just (Full.Argument Text
_ (Full.Node Value
Full.Null Location
_) Location
_)) = Bool
True
isNothingOrNull Maybe Argument
x = Maybe Argument -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Argument
x
lookupArgument :: Text -> Argument -> Bool
lookupArgument Text
needle (Full.Argument Text
argumentName Node Value
_ Location
_) =
Text
needle Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
argumentName
fieldMessage :: Text -> Text -> Text -> String
fieldMessage Text
fieldName Text
argumentName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Field \""
, Text -> String
Text.unpack Text
fieldName
, String
"\" argument \""
, Text -> String
Text.unpack Text
argumentName
, String
"\" of type \""
, Text -> String
Text.unpack Text
typeName
, String
"\" is required, but it was not provided."
]
directiveMessage :: Text -> Text -> Text -> String
directiveMessage Text
directiveName Text
argumentName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Directive \"@"
, Text -> String
Text.unpack Text
directiveName
, String
"\" argument \""
, Text -> String
Text.unpack Text
argumentName
, String
"\" of type \""
, Text -> String
Text.unpack Text
typeName
, String
"\" is required, but it was not provided."
]
inputTypeName :: In.Type -> Text
inputTypeName :: Type -> Text
inputTypeName (In.ScalarBaseType (Definition.ScalarType Text
typeName Maybe Text
_)) = Text
typeName
inputTypeName (In.EnumBaseType (Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_)) = Text
typeName
inputTypeName (In.InputObjectBaseType (In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
_)) =
Text
typeName
inputTypeName (In.ListBaseType Type
listType) = Type -> Text
inputTypeName Type
listType
providedRequiredInputFieldsRule :: Rule m
providedRequiredInputFieldsRule :: forall (m :: * -> *). Rule m
providedRequiredInputFieldsRule = (Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule Maybe Type -> Node Value -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go Maybe Type -> Node ConstValue -> RuleT m
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a} {p} {p}.
(MonadTrans t, Monad m, Monoid (m a)) =>
p -> p -> t m a
constGo
where
go :: Maybe Type -> Node Value -> t Seq Error
go (Just Type
valueType) (Full.Node (Full.Object [ObjectField Value]
inputFields) Location
location')
| In.InputObjectBaseType InputObjectType
objectType <- Type
valueType
, In.InputObjectType Text
objectTypeName Maybe Text
_ HashMap Text InputField
fieldDefinitions <- InputObjectType
objectType
= Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ [Error] -> Seq Error
forall a. [a] -> Seq a
Seq.fromList
([Error] -> Seq Error) -> [Error] -> Seq Error
forall a b. (a -> b) -> a -> b
$ HashMap Text Error -> [Error]
forall k v. HashMap k v -> [v]
HashMap.elems
(HashMap Text Error -> [Error]) -> HashMap Text Error -> [Error]
forall a b. (a -> b) -> a -> b
$ ((Text -> InputField -> Maybe Error)
-> HashMap Text InputField -> HashMap Text Error)
-> HashMap Text InputField
-> (Text -> InputField -> Maybe Error)
-> HashMap Text Error
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> InputField -> Maybe Error)
-> HashMap Text InputField -> HashMap Text Error
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapMaybeWithKey HashMap Text InputField
fieldDefinitions
((Text -> InputField -> Maybe Error) -> HashMap Text Error)
-> (Text -> InputField -> Maybe Error) -> HashMap Text Error
forall a b. (a -> b) -> a -> b
$ [ObjectField Value]
-> Text -> Location -> Text -> InputField -> Maybe Error
forall {t :: * -> *}.
Foldable t =>
t (ObjectField Value)
-> Text -> Location -> Text -> InputField -> Maybe Error
forEach [ObjectField Value]
inputFields Text
objectTypeName Location
location'
go Maybe Type
_ Node Value
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
constGo :: p -> p -> t m a
constGo p
_ p
_ = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall a. Monoid a => a
mempty
forEach :: t (ObjectField Value)
-> Text -> Location -> Text -> InputField -> Maybe Error
forEach t (ObjectField Value)
inputFields Text
typeName Location
location' Text
definitionName InputField
fieldDefinition
| In.InputField Maybe Text
_ Type
inputType Maybe Value
optionalValue <- InputField
fieldDefinition
, Type -> Bool
In.isNonNullType Type
inputType
, Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Value
optionalValue
, Maybe (ObjectField Value) -> Bool
isNothingOrNull (Maybe (ObjectField Value) -> Bool)
-> Maybe (ObjectField Value) -> Bool
forall a b. (a -> b) -> a -> b
$ (ObjectField Value -> Bool)
-> t (ObjectField Value) -> Maybe (ObjectField Value)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> ObjectField Value -> Bool
forall {a}. Text -> ObjectField a -> Bool
lookupField Text
definitionName) t (ObjectField Value)
inputFields =
Error -> Maybe Error
forall a. a -> Maybe a
Just (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Location -> Error
makeError Text
definitionName Text
typeName Location
location'
| Bool
otherwise = Maybe Error
forall a. Maybe a
Nothing
isNothingOrNull :: Maybe (ObjectField Value) -> Bool
isNothingOrNull (Just (Full.ObjectField Text
_ (Full.Node Value
Full.Null Location
_) Location
_)) = Bool
True
isNothingOrNull Maybe (ObjectField Value)
x = Maybe (ObjectField Value) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (ObjectField Value)
x
lookupField :: Text -> ObjectField a -> Bool
lookupField Text
needle (Full.ObjectField Text
fieldName Node a
_ Location
_) = Text
needle Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fieldName
makeError :: Text -> Text -> Location -> Error
makeError Text
fieldName Text
typeName Location
location' = Error
{ message :: String
message = Text -> Text -> String
errorMessage Text
fieldName Text
typeName
, locations :: [Location]
locations = [Location
location']
}
errorMessage :: Text -> Text -> String
errorMessage Text
fieldName Text
typeName = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Input field \""
, Text -> String
Text.unpack Text
fieldName
, String
"\" of type \""
, Text -> String
Text.unpack Text
typeName
, String
"\" is required, but it was not provided."
]
overlappingFieldsCanBeMergedRule :: Rule m
overlappingFieldsCanBeMergedRule :: forall (m :: * -> *). Rule m
overlappingFieldsCanBeMergedRule = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
selectionSet Location
_ -> do
Schema m
schema' <- (Validation m -> Schema m) -> ReaderT (Validation m) Seq (Schema m)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
SelectionSetOpt -> CompositeType m -> RuleT m
forall {m :: * -> *}.
SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go (SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet)
(CompositeType m -> RuleT m) -> CompositeType m -> RuleT m
forall a b. (a -> b) -> a -> b
$ ObjectType m -> CompositeType m
forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
(ObjectType m -> CompositeType m)
-> ObjectType m -> CompositeType m
forall a b. (a -> b) -> a -> b
$ Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
Full.OperationDefinition OperationType
operationType Maybe Text
_ [VariableDefinition]
_ [Directive]
_ SelectionSet
selectionSet Location
_ -> do
Schema m
schema' <- (Validation m -> Schema m) -> ReaderT (Validation m) Seq (Schema m)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
let root :: ObjectType m -> ReaderT (Validation m) Seq Error
root = SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
forall {m :: * -> *}.
SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go (SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet) (CompositeType m -> ReaderT (Validation m) Seq Error)
-> (ObjectType m -> CompositeType m)
-> ObjectType m
-> ReaderT (Validation m) Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType m -> CompositeType m
forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
case OperationType
operationType of
OperationType
Full.Query -> ObjectType m -> RuleT m
forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root (ObjectType m -> RuleT m) -> ObjectType m -> RuleT m
forall a b. (a -> b) -> a -> b
$ Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
OperationType
Full.Mutation
| Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> ObjectType m -> RuleT m
forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root ObjectType m
objectType
OperationType
Full.Subscription
| Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> ObjectType m -> RuleT m
forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root ObjectType m
objectType
OperationType
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
go :: SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go SelectionSetOpt
selectionSet CompositeType m
selectionType = do
HashMap Text (NonEmpty (Field, CompositeType m))
fieldTuples <- StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashSet Text
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall {m :: * -> *}.
CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields CompositeType m
selectionType SelectionSetOpt
selectionSet) HashSet Text
forall a. HashSet a
HashSet.empty
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge HashMap Text (NonEmpty (Field, CompositeType m))
fieldTuples
fieldsInSetCanMerge :: forall m
. HashMap Full.Name (NonEmpty (Full.Field, Type.CompositeType m))
-> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge :: forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge HashMap Text (NonEmpty (Field, CompositeType m))
fieldTuples = do
Validation m
validation <- ReaderT (Validation m) Seq (Validation m)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let (Seq (FieldInfo m)
lonely, Seq (FieldInfo m, FieldInfo m)
paired) = HashMap Text (NonEmpty (Field, CompositeType m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
flattenPairs HashMap Text (NonEmpty (Field, CompositeType m))
fieldTuples
let reader :: ReaderT (Validation m) m a -> m a
reader = (ReaderT (Validation m) m a -> Validation m -> m a)
-> Validation m -> ReaderT (Validation m) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (Validation m) m a -> Validation m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Validation m
validation
Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> ReaderT (Validation m) Seq Error)
-> Seq Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ (FieldInfo m -> Seq Error) -> Seq (FieldInfo m) -> Seq Error
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ReaderT (Validation m) Seq Error -> Seq Error
forall {m :: * -> *} {a}. ReaderT (Validation m) m a -> m a
reader (ReaderT (Validation m) Seq Error -> Seq Error)
-> (FieldInfo m -> ReaderT (Validation m) Seq Error)
-> FieldInfo m
-> Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfo m -> ReaderT (Validation m) Seq Error
forall {m :: * -> *}.
FieldInfo m -> ReaderT (Validation m) Seq Error
visitLonelyFields) Seq (FieldInfo m)
lonely
Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> ((FieldInfo m, FieldInfo m) -> Seq Error)
-> Seq (FieldInfo m, FieldInfo m) -> Seq Error
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ReaderT (Validation m) Seq Error -> Seq Error
forall {m :: * -> *} {a}. ReaderT (Validation m) m a -> m a
reader (ReaderT (Validation m) Seq Error -> Seq Error)
-> ((FieldInfo m, FieldInfo m) -> ReaderT (Validation m) Seq Error)
-> (FieldInfo m, FieldInfo m)
-> Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldInfo m, FieldInfo m) -> ReaderT (Validation m) Seq Error
forall (m :: * -> *).
(FieldInfo m, FieldInfo m) -> ReaderT (Validation m) Seq Error
forEachFieldTuple) Seq (FieldInfo m, FieldInfo m)
paired
forEachFieldTuple :: forall m
. (FieldInfo m, FieldInfo m)
-> ReaderT (Validation m) Seq Error
forEachFieldTuple :: forall (m :: * -> *).
(FieldInfo m, FieldInfo m) -> ReaderT (Validation m) Seq Error
forEachFieldTuple (FieldInfo m
fieldA, FieldInfo m
fieldB) =
case (FieldInfo m -> CompositeType m
forall (m :: * -> *). FieldInfo m -> CompositeType m
parent FieldInfo m
fieldA, FieldInfo m -> CompositeType m
forall (m :: * -> *). FieldInfo m -> CompositeType m
parent FieldInfo m
fieldB) of
(parentA :: CompositeType m
parentA@Type.CompositeObjectType{}, parentB :: CompositeType m
parentB@Type.CompositeObjectType{})
| CompositeType m
parentA CompositeType m -> CompositeType m -> Bool
forall a. Eq a => a -> a -> Bool
/= CompositeType m
parentB -> FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
forall (m :: * -> *).
FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
sameResponseShape FieldInfo m
fieldA FieldInfo m
fieldB
(CompositeType m, CompositeType m)
_ -> (Seq Error -> Seq Error)
-> ReaderT (Validation m) Seq Error
-> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Field -> Field -> Seq Error -> Seq Error
checkEquality (FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA) (FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldB))
(ReaderT (Validation m) Seq Error
-> ReaderT (Validation m) Seq Error)
-> ReaderT (Validation m) Seq Error
-> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
forall (m :: * -> *).
FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
sameResponseShape FieldInfo m
fieldA FieldInfo m
fieldB
checkEquality :: Field -> Field -> Seq Error -> Seq Error
checkEquality Field
fieldA Field
fieldB Seq Error
Seq.Empty
| Full.Field Maybe Text
_ Text
fieldNameA [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_ <- Field
fieldA
, Full.Field Maybe Text
_ Text
fieldNameB [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_ <- Field
fieldB
, Text
fieldNameA Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
fieldNameB = Error -> Seq Error
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ Field -> Field -> Error
makeError Field
fieldA Field
fieldB
| Full.Field Maybe Text
_ Text
fieldNameA [Argument]
argumentsA [Directive]
_ SelectionSetOpt
_ Location
locationA <- Field
fieldA
, Full.Field Maybe Text
_ Text
_ [Argument]
argumentsB [Directive]
_ SelectionSetOpt
_ Location
locationB <- Field
fieldB
, [Argument]
argumentsA [Argument] -> [Argument] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Argument]
argumentsB =
let message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fields \""
, Text -> String
Text.unpack Text
fieldNameA
, String
"\" conflict because they have different arguments. Use "
, String
"different aliases on the fields to fetch both if this "
, String
"was intentional."
]
in Error -> Seq Error
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ String -> [Location] -> Error
Error String
message [Location
locationB, Location
locationA]
checkEquality Field
_ Field
_ Seq Error
previousErrors = Seq Error
previousErrors
visitLonelyFields :: FieldInfo m -> ReaderT (Validation m) Seq Error
visitLonelyFields FieldInfo{Field
Type m
CompositeType m
parent :: forall (m :: * -> *). FieldInfo m -> CompositeType m
node :: forall (m :: * -> *). FieldInfo m -> Field
node :: Field
type' :: Type m
parent :: CompositeType m
type' :: forall (m :: * -> *). FieldInfo m -> Type m
..} =
let Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
subSelections Location
_ = Field
node
compositeFieldType :: Maybe (CompositeType m)
compositeFieldType = Type m -> Maybe (CompositeType m)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
type'
in ReaderT (Validation m) Seq Error
-> (CompositeType m -> ReaderT (Validation m) Seq Error)
-> Maybe (CompositeType m)
-> ReaderT (Validation m) Seq Error
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Seq a
Seq.empty) (SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
forall {m :: * -> *}.
SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go SelectionSetOpt
subSelections) Maybe (CompositeType m)
compositeFieldType
sameResponseShape :: forall m
. FieldInfo m
-> FieldInfo m
-> ReaderT (Validation m) Seq Error
sameResponseShape :: forall (m :: * -> *).
FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
sameResponseShape FieldInfo m
fieldA FieldInfo m
fieldB =
let Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
selectionsA Location
_ = FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA
Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
selectionsB Location
_ = FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldB
in case Type m -> Type m -> Either Bool (CompositeType m, CompositeType m)
forall {a :: * -> *}.
Type a -> Type a -> Either Bool (CompositeType a, CompositeType a)
unwrapTypes (FieldInfo m -> Type m
forall (m :: * -> *). FieldInfo m -> Type m
type' FieldInfo m
fieldA) (FieldInfo m -> Type m
forall (m :: * -> *). FieldInfo m -> Type m
type' FieldInfo m
fieldB) of
Left Bool
True -> Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
Right (CompositeType m
compositeA, CompositeType m
compositeB) -> do
Validation m
validation <- ReaderT (Validation m) Seq (Validation m)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let collectFields' :: CompositeType m
-> SelectionSetOpt
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields' CompositeType m
composite = (ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> Validation m
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m))))
-> Validation m
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> Validation m
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Validation m
validation
(ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m))))
-> (SelectionSetOpt
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> SelectionSetOpt
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashSet Text
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> HashSet Text
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashSet Text
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HashSet Text
forall a. HashSet a
HashSet.empty
(StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> (SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> SelectionSetOpt
-> ReaderT
(Validation m)
Seq
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall {m :: * -> *}.
CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields CompositeType m
composite
let collectA :: Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectA = CompositeType m
-> SelectionSetOpt
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields' CompositeType m
compositeA SelectionSetOpt
selectionsA
let collectB :: Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectB = CompositeType m
-> SelectionSetOpt
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields' CompositeType m
compositeB SelectionSetOpt
selectionsB
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge
(HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error)
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ (HashMap Text (NonEmpty (Field, CompositeType m))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashMap Text (NonEmpty (Field, CompositeType m))
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((NonEmpty (Field, CompositeType m)
-> NonEmpty (Field, CompositeType m)
-> NonEmpty (Field, CompositeType m))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> HashMap Text (NonEmpty (Field, CompositeType m))
forall k v.
Eq k =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith NonEmpty (Field, CompositeType m)
-> NonEmpty (Field, CompositeType m)
-> NonEmpty (Field, CompositeType m)
forall a. Semigroup a => a -> a -> a
(<>)) HashMap Text (NonEmpty (Field, CompositeType m))
forall k v. HashMap k v
HashMap.empty
(Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashMap Text (NonEmpty (Field, CompositeType m)))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
-> HashMap Text (NonEmpty (Field, CompositeType m))
forall a b. (a -> b) -> a -> b
$ Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectA Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
-> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
forall a. Semigroup a => a -> a -> a
<> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectB
Either Bool (CompositeType m, CompositeType m)
_ -> Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Field -> Field -> Error
makeError (FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA) (FieldInfo m -> Field
forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldB)
makeError :: Field -> Field -> Error
makeError Field
fieldA Field
fieldB =
let Full.Field Maybe Text
aliasA Text
fieldNameA [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
locationA = Field
fieldA
Full.Field Maybe Text
_ Text
fieldNameB [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
locationB = Field
fieldB
message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fields \""
, Text -> String
Text.unpack (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fieldNameA Maybe Text
aliasA)
, String
"\" conflict because \""
, Text -> String
Text.unpack Text
fieldNameB
, String
"\" and \""
, Text -> String
Text.unpack Text
fieldNameA
, String
"\" are different fields. Use different aliases on the fields "
, String
"to fetch both if this was intentional."
]
in String -> [Location] -> Error
Error String
message [Location
locationB, Location
locationA]
unwrapTypes :: Type a -> Type a -> Either Bool (CompositeType a, CompositeType a)
unwrapTypes typeA :: Type a
typeA@Out.ScalarBaseType{} typeB :: Type a
typeB@Out.ScalarBaseType{} =
Bool -> Either Bool (CompositeType a, CompositeType a)
forall a b. a -> Either a b
Left (Bool -> Either Bool (CompositeType a, CompositeType a))
-> Bool -> Either Bool (CompositeType a, CompositeType a)
forall a b. (a -> b) -> a -> b
$ Type a
typeA Type a -> Type a -> Bool
forall a. Eq a => a -> a -> Bool
== Type a
typeB
unwrapTypes typeA :: Type a
typeA@Out.EnumBaseType{} typeB :: Type a
typeB@Out.EnumBaseType{} =
Bool -> Either Bool (CompositeType a, CompositeType a)
forall a b. a -> Either a b
Left (Bool -> Either Bool (CompositeType a, CompositeType a))
-> Bool -> Either Bool (CompositeType a, CompositeType a)
forall a b. (a -> b) -> a -> b
$ Type a
typeA Type a -> Type a -> Bool
forall a. Eq a => a -> a -> Bool
== Type a
typeB
unwrapTypes (Out.ListType Type a
listA) (Out.ListType Type a
listB) =
Type a -> Type a -> Either Bool (CompositeType a, CompositeType a)
unwrapTypes Type a
listA Type a
listB
unwrapTypes (Out.NonNullListType Type a
listA) (Out.NonNullListType Type a
listB) =
Type a -> Type a -> Either Bool (CompositeType a, CompositeType a)
unwrapTypes Type a
listA Type a
listB
unwrapTypes Type a
typeA Type a
typeB
| Type a -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type a
typeA Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Type a -> Bool
forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type a
typeB
, Just CompositeType a
compositeA <- Type a -> Maybe (CompositeType a)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type a
typeA
, Just CompositeType a
compositeB <- Type a -> Maybe (CompositeType a)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type a
typeB =
(CompositeType a, CompositeType a)
-> Either Bool (CompositeType a, CompositeType a)
forall a b. b -> Either a b
Right (CompositeType a
compositeA, CompositeType a
compositeB)
| Bool
otherwise = Bool -> Either Bool (CompositeType a, CompositeType a)
forall a b. a -> Either a b
Left Bool
False
flattenPairs :: forall m
. HashMap Full.Name (NonEmpty (Full.Field, Type.CompositeType m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
flattenPairs :: forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
flattenPairs HashMap Text (NonEmpty (Field, CompositeType m))
xs = ([FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m)))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> HashMap Text [FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr [FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
forall (m :: * -> *).
[FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
splitSingleFields (Seq (FieldInfo m)
forall a. Seq a
Seq.empty, Seq (FieldInfo m, FieldInfo m)
forall a. Seq a
Seq.empty)
(HashMap Text [FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m)))
-> HashMap Text [FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
forall a b. (a -> b) -> a -> b
$ ((Field, CompositeType m) -> [FieldInfo m] -> [FieldInfo m])
-> [FieldInfo m]
-> NonEmpty (Field, CompositeType m)
-> [FieldInfo m]
forall a b. (a -> b -> b) -> b -> NonEmpty a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Field, CompositeType m) -> [FieldInfo m] -> [FieldInfo m]
forall {m :: * -> *}.
(Field, CompositeType m) -> [FieldInfo m] -> [FieldInfo m]
lookupTypeField [] (NonEmpty (Field, CompositeType m) -> [FieldInfo m])
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> HashMap Text [FieldInfo m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (NonEmpty (Field, CompositeType m))
xs
splitSingleFields :: forall m
. [FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
splitSingleFields :: forall (m :: * -> *).
[FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
splitSingleFields [FieldInfo m
head'] (Seq (FieldInfo m)
fields, Seq (FieldInfo m, FieldInfo m)
pairList) = (Seq (FieldInfo m)
fields Seq (FieldInfo m) -> FieldInfo m -> Seq (FieldInfo m)
forall a. Seq a -> a -> Seq a
|> FieldInfo m
head', Seq (FieldInfo m, FieldInfo m)
pairList)
splitSingleFields [FieldInfo m]
xs (Seq (FieldInfo m)
fields, Seq (FieldInfo m, FieldInfo m)
pairList) = (Seq (FieldInfo m)
fields, Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m] -> Seq (FieldInfo m, FieldInfo m)
forall (m :: * -> *).
Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m] -> Seq (FieldInfo m, FieldInfo m)
pairs Seq (FieldInfo m, FieldInfo m)
pairList [FieldInfo m]
xs)
lookupTypeField :: (Field, CompositeType m) -> [FieldInfo m] -> [FieldInfo m]
lookupTypeField (Field
field, CompositeType m
parentType) [FieldInfo m]
accumulator =
let Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_ = Field
field
in case Text -> CompositeType m -> Maybe (Field m)
forall (a :: * -> *). Text -> CompositeType a -> Maybe (Field a)
Type.lookupCompositeField Text
fieldName CompositeType m
parentType of
Maybe (Field m)
Nothing -> [FieldInfo m]
accumulator
Just (Out.Field Maybe Text
_ Type m
typeField Arguments
_) ->
Field -> Type m -> CompositeType m -> FieldInfo m
forall (m :: * -> *).
Field -> Type m -> CompositeType m -> FieldInfo m
FieldInfo Field
field Type m
typeField CompositeType m
parentType FieldInfo m -> [FieldInfo m] -> [FieldInfo m]
forall a. a -> [a] -> [a]
: [FieldInfo m]
accumulator
pairs :: forall m
. Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m]
-> Seq (FieldInfo m, FieldInfo m)
pairs :: forall (m :: * -> *).
Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m] -> Seq (FieldInfo m, FieldInfo m)
pairs Seq (FieldInfo m, FieldInfo m)
accumulator [] = Seq (FieldInfo m, FieldInfo m)
accumulator
pairs Seq (FieldInfo m, FieldInfo m)
accumulator (FieldInfo m
fieldA : [FieldInfo m]
fields) =
FieldInfo m
-> Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m]
-> Seq (FieldInfo m, FieldInfo m)
forall {a} {b}. a -> Seq (a, b) -> [b] -> Seq (a, b)
pair FieldInfo m
fieldA (Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m] -> Seq (FieldInfo m, FieldInfo m)
forall (m :: * -> *).
Seq (FieldInfo m, FieldInfo m)
-> [FieldInfo m] -> Seq (FieldInfo m, FieldInfo m)
pairs Seq (FieldInfo m, FieldInfo m)
accumulator [FieldInfo m]
fields) [FieldInfo m]
fields
pair :: a -> Seq (a, b) -> [b] -> Seq (a, b)
pair a
_ Seq (a, b)
accumulator [] = Seq (a, b)
accumulator
pair a
field Seq (a, b)
accumulator (b
fieldA : [b]
fields) =
a -> Seq (a, b) -> [b] -> Seq (a, b)
pair a
field Seq (a, b)
accumulator [b]
fields Seq (a, b) -> (a, b) -> Seq (a, b)
forall a. Seq a -> a -> Seq a
|> (a
field, b
fieldA)
collectFields :: CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields CompositeType m
objectType = CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall {m :: * -> *}.
CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
accumulateFields CompositeType m
objectType HashMap Text (NonEmpty (Field, CompositeType m))
forall a. Monoid a => a
mempty
accumulateFields :: CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
accumulateFields = (HashMap Text (NonEmpty (Field, CompositeType m))
-> Selection
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((HashMap Text (NonEmpty (Field, CompositeType m))
-> Selection
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> (CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> Selection
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> Selection
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forEach
forEach :: CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> Selection
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forEach CompositeType m
parentType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator = \case
Full.FieldSelection Field
fieldSelection ->
CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> Field
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall {f :: * -> *} {p}.
Applicative f =>
p
-> HashMap Text (NonEmpty (Field, p))
-> Field
-> f (HashMap Text (NonEmpty (Field, p)))
forField CompositeType m
parentType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator Field
fieldSelection
Full.FragmentSpreadSelection FragmentSpread
fragmentSelection ->
HashMap Text (NonEmpty (Field, CompositeType m))
-> FragmentSpread
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forSpread HashMap Text (NonEmpty (Field, CompositeType m))
accumulator FragmentSpread
fragmentSelection
Full.InlineFragmentSelection InlineFragment
fragmentSelection ->
CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> InlineFragment
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forInline CompositeType m
parentType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator InlineFragment
fragmentSelection
forField :: p
-> HashMap Text (NonEmpty (Field, p))
-> Field
-> f (HashMap Text (NonEmpty (Field, p)))
forField p
parentType HashMap Text (NonEmpty (Field, p))
accumulator field :: Field
field@(Full.Field Maybe Text
alias Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
_ Location
_) =
let key :: Text
key = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fieldName Maybe Text
alias
value :: NonEmpty (Field, p)
value = (Field
field, p
parentType) (Field, p) -> [(Field, p)] -> NonEmpty (Field, p)
forall a. a -> [a] -> NonEmpty a
:| []
in HashMap Text (NonEmpty (Field, p))
-> f (HashMap Text (NonEmpty (Field, p)))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (NonEmpty (Field, p))
-> f (HashMap Text (NonEmpty (Field, p))))
-> HashMap Text (NonEmpty (Field, p))
-> f (HashMap Text (NonEmpty (Field, p)))
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Field, p) -> NonEmpty (Field, p) -> NonEmpty (Field, p))
-> Text
-> NonEmpty (Field, p)
-> HashMap Text (NonEmpty (Field, p))
-> HashMap Text (NonEmpty (Field, p))
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith NonEmpty (Field, p) -> NonEmpty (Field, p) -> NonEmpty (Field, p)
forall a. Semigroup a => a -> a -> a
(<>) Text
key NonEmpty (Field, p)
value HashMap Text (NonEmpty (Field, p))
accumulator
forSpread :: HashMap Text (NonEmpty (Field, CompositeType m))
-> FragmentSpread
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forSpread HashMap Text (NonEmpty (Field, CompositeType m))
accumulator (Full.FragmentSpread Text
fragmentName [Directive]
_ Location
_) = do
Bool
inVisitetFragments <- (HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ((HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool)
-> (HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName
if Bool
inVisitetFragments
then HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
else Text
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFromSpread Text
fragmentName HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
forInline :: CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> InlineFragment
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forInline CompositeType m
parentType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator = \case
Full.InlineFragment Maybe Text
maybeType [Directive]
_ SelectionSet
selections Location
_
| Just Text
typeCondition <- Maybe Text
maybeType ->
Text
-> SelectionSet
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFromFragment Text
typeCondition SelectionSet
selections HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
| Bool
otherwise -> CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
accumulateFields CompositeType m
parentType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator (SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a b. (a -> b) -> a -> b
$ SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
collectFromFragment :: Text
-> SelectionSet
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFromFragment Text
typeCondition SelectionSet
selectionSet' HashMap Text (NonEmpty (Field, CompositeType m))
accumulator = do
HashMap Text (Type m)
types' <- ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (Type m)))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
Just CompositeType m
compositeType ->
CompositeType m
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
accumulateFields CompositeType m
compositeType HashMap Text (NonEmpty (Field, CompositeType m))
accumulator (SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m))))
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a b. (a -> b) -> a -> b
$ SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet'
collectFromSpread :: Text
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFromSpread Text
fragmentName HashMap Text (NonEmpty (Field, CompositeType m))
accumulator = do
(HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ())
-> (HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ()
forall a b. (a -> b) -> a -> b
$ Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName
Document
ast' <- ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document)
-> ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall a b. (a -> b) -> a -> b
$ (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
Just (Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
selectionSet' Location
_) ->
Text
-> SelectionSet
-> HashMap Text (NonEmpty (Field, CompositeType m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFromFragment Text
typeCondition SelectionSet
selectionSet' HashMap Text (NonEmpty (Field, CompositeType m))
accumulator
data FieldInfo m = FieldInfo
{ forall (m :: * -> *). FieldInfo m -> Field
node :: Full.Field
, forall (m :: * -> *). FieldInfo m -> Type m
type' :: Out.Type m
, forall (m :: * -> *). FieldInfo m -> CompositeType m
parent :: Type.CompositeType m
}
possibleFragmentSpreadsRule :: forall m. Rule m
possibleFragmentSpreadsRule :: forall (m :: * -> *). Rule m
possibleFragmentSpreadsRule = (Maybe (Type m) -> Selection -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe (Type m) -> Selection -> RuleT m) -> Rule m
SelectionRule Maybe (Type m) -> Selection -> RuleT m
forall {m :: * -> *}.
Maybe (Type m) -> Selection -> ReaderT (Validation m) Seq Error
go
where
go :: Maybe (Type m) -> Selection -> ReaderT (Validation m) Seq Error
go (Just Type m
parentType) (Full.InlineFragmentSelection InlineFragment
fragmentSelection)
| Full.InlineFragment Maybe Text
maybeType [Directive]
_ SelectionSet
_ Location
location' <- InlineFragment
fragmentSelection
, Just Text
typeCondition <- Maybe Text
maybeType = do
(Text
fragmentTypeName, Text
parentTypeName) <-
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
forall {m :: * -> *}.
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
compareTypes Text
typeCondition Type m
parentType
Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment cannot be spread here as objects of type \""
, Text -> String
Text.unpack Text
parentTypeName
, String
"\" can never be of type \""
, Text -> String
Text.unpack Text
fragmentTypeName
, String
"\"."
]
, locations :: [Location]
locations = [Location
location']
}
go (Just Type m
parentType) (Full.FragmentSpreadSelection FragmentSpread
fragmentSelection)
| Full.FragmentSpread Text
fragmentName [Directive]
_ Location
location' <- FragmentSpread
fragmentSelection = do
Text
typeCondition <- Text -> ReaderT (Validation m) Seq Text
forall (m1 :: * -> *). Text -> ReaderT (Validation m1) Seq Text
findSpreadTarget Text
fragmentName
(Text
fragmentTypeName, Text
parentTypeName) <-
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
forall {m :: * -> *}.
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
compareTypes Text
typeCondition Type m
parentType
Error -> ReaderT (Validation m) Seq Error
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> ReaderT (Validation m) Seq Error)
-> Error -> ReaderT (Validation m) Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fragment \""
, Text -> String
Text.unpack Text
fragmentName
, String
"\" cannot be spread here as objects of type \""
, Text -> String
Text.unpack Text
parentTypeName
, String
"\" can never be of type \""
, Text -> String
Text.unpack Text
fragmentTypeName
, String
"\"."
]
, locations :: [Location]
locations = [Location
location']
}
go Maybe (Type m)
_ Selection
_ = Seq Error -> ReaderT (Validation m) Seq Error
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
compareTypes :: Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
compareTypes Text
typeCondition Type m
parentType = do
HashMap Text (Type m)
types' <- (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
CompositeType m
fragmentType <- Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m))
-> Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m)
forall a b. (a -> b) -> a -> b
$ Maybe (CompositeType m) -> Seq (CompositeType m)
forall a. Maybe a -> Seq a
maybeToSeq
(Maybe (CompositeType m) -> Seq (CompositeType m))
-> Maybe (CompositeType m) -> Seq (CompositeType m)
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types'
CompositeType m
parentComposite <- Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m))
-> Seq (CompositeType m)
-> ReaderT (Validation m) Seq (CompositeType m)
forall a b. (a -> b) -> a -> b
$ Maybe (CompositeType m) -> Seq (CompositeType m)
forall a. Maybe a -> Seq a
maybeToSeq
(Maybe (CompositeType m) -> Seq (CompositeType m))
-> Maybe (CompositeType m) -> Seq (CompositeType m)
forall a b. (a -> b) -> a -> b
$ Type m -> Maybe (CompositeType m)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
parentType
HashSet Text
possibleFragments <- CompositeType m -> ReaderT (Validation m) Seq (HashSet Text)
forall {m :: * -> *} {m :: * -> *}.
Monad m =>
CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
fragmentType
HashSet Text
possibleParents <- CompositeType m -> ReaderT (Validation m) Seq (HashSet Text)
forall {m :: * -> *} {m :: * -> *}.
Monad m =>
CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
parentComposite
let fragmentTypeName :: Text
fragmentTypeName = CompositeType m -> Text
forall (m :: * -> *). CompositeType m -> Text
compositeTypeName CompositeType m
fragmentType
let parentTypeName :: Text
parentTypeName = CompositeType m -> Text
forall (m :: * -> *). CompositeType m -> Text
compositeTypeName CompositeType m
parentComposite
if HashSet Text -> Bool
forall a. HashSet a -> Bool
HashSet.null (HashSet Text -> Bool) -> HashSet Text -> Bool
forall a b. (a -> b) -> a -> b
$ HashSet Text -> HashSet Text -> HashSet Text
forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HashSet.intersection HashSet Text
possibleFragments HashSet Text
possibleParents
then (Text, Text) -> ReaderT (Validation m) Seq (Text, Text)
forall a. a -> ReaderT (Validation m) Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fragmentTypeName, Text
parentTypeName)
else Seq (Text, Text) -> ReaderT (Validation m) Seq (Text, Text)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq (Text, Text)
forall a. Monoid a => a
mempty
getPossibleTypeList :: CompositeType m -> ReaderT (Validation m) m [Type m]
getPossibleTypeList (Type.CompositeObjectType ObjectType m
objectType) =
[Type m] -> ReaderT (Validation m) m [Type m]
forall a. a -> ReaderT (Validation m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Schema.ObjectType ObjectType m
objectType]
getPossibleTypeList (Type.CompositeUnionType UnionType m
unionType) =
let Out.UnionType Text
_ Maybe Text
_ [ObjectType m]
members = UnionType m
unionType
in [Type m] -> ReaderT (Validation m) m [Type m]
forall a. a -> ReaderT (Validation m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Type m] -> ReaderT (Validation m) m [Type m])
-> [Type m] -> ReaderT (Validation m) m [Type m]
forall a b. (a -> b) -> a -> b
$ ObjectType m -> Type m
forall (m :: * -> *). ObjectType m -> Type m
Schema.ObjectType (ObjectType m -> Type m) -> [ObjectType m] -> [Type m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ObjectType m]
members
getPossibleTypeList (Type.CompositeInterfaceType InterfaceType m
interfaceType) =
let Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_ = InterfaceType m
interfaceType
in [Type m] -> Text -> HashMap Text [Type m] -> [Type m]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault [] Text
typeName
(HashMap Text [Type m] -> [Type m])
-> ReaderT (Validation m) m (HashMap Text [Type m])
-> ReaderT (Validation m) m [Type m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Validation m -> HashMap Text [Type m])
-> ReaderT (Validation m) m (HashMap Text [Type m])
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (Schema m -> HashMap Text [Type m]
forall (m :: * -> *). Schema m -> HashMap Text [Type m]
Schema.implementations (Schema m -> HashMap Text [Type m])
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text [Type m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema)
getPossibleTypes :: CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
compositeType
= (Type m -> HashSet Text -> HashSet Text)
-> HashSet Text -> [Type m] -> HashSet Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert (Text -> HashSet Text -> HashSet Text)
-> (Type m -> Text) -> Type m -> HashSet Text -> HashSet Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type m -> Text
forall (m :: * -> *). Type m -> Text
internalTypeName) HashSet Text
forall a. HashSet a
HashSet.empty
([Type m] -> HashSet Text)
-> ReaderT (Validation m) m [Type m]
-> ReaderT (Validation m) m (HashSet Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompositeType m -> ReaderT (Validation m) m [Type m]
forall {m :: * -> *} {m :: * -> *}.
Monad m =>
CompositeType m -> ReaderT (Validation m) m [Type m]
getPossibleTypeList CompositeType m
compositeType
internalTypeName :: forall m. Schema.Type m -> Full.Name
internalTypeName :: forall (m :: * -> *). Type m -> Text
internalTypeName (Schema.ScalarType (Definition.ScalarType Text
typeName Maybe Text
_)) =
Text
typeName
internalTypeName (Schema.EnumType (Definition.EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_)) = Text
typeName
internalTypeName (Schema.ObjectType (Out.ObjectType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Resolver m)
_)) = Text
typeName
internalTypeName (Schema.InputObjectType (In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
_)) =
Text
typeName
internalTypeName (Schema.InterfaceType (Out.InterfaceType Text
typeName Maybe Text
_ [InterfaceType m]
_ HashMap Text (Field m)
_)) =
Text
typeName
internalTypeName (Schema.UnionType (Out.UnionType Text
typeName Maybe Text
_ [ObjectType m]
_)) = Text
typeName
findSpreadTarget :: Full.Name -> ReaderT (Validation m1) Seq Full.TypeCondition
findSpreadTarget :: forall (m1 :: * -> *). Text -> ReaderT (Validation m1) Seq Text
findSpreadTarget Text
fragmentName = do
Document
ast' <- (Validation m1 -> Document) -> ReaderT (Validation m1) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m1 -> Document
forall (m :: * -> *). Validation m -> Document
ast
let target :: Maybe Definition
target = (Definition -> Bool) -> Document -> Maybe Definition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Definition -> Bool
isSpreadTarget Text
fragmentName) Document
ast'
Seq Text -> ReaderT (Validation m1) Seq Text
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m1) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Text -> ReaderT (Validation m1) Seq Text)
-> Seq Text -> ReaderT (Validation m1) Seq Text
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Seq Text
forall a. Maybe a -> Seq a
maybeToSeq (Maybe Text -> Seq Text) -> Maybe Text -> Seq Text
forall a b. (a -> b) -> a -> b
$ Maybe Definition
target Maybe Definition -> (Definition -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Definition -> Maybe Text
extractTypeCondition
where
extractTypeCondition :: Definition -> Maybe Text
extractTypeCondition (Definition -> Maybe FragmentDefinition
viewFragment -> Just FragmentDefinition
fragmentDefinition) =
let Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
_ Location
_ = FragmentDefinition
fragmentDefinition
in Text -> Maybe Text
forall a. a -> Maybe a
Just Text
typeCondition
extractTypeCondition Definition
_ = Maybe Text
forall a. Maybe a
Nothing
visitFragmentDefinition :: forall m
. Text
-> ValidationState m (Maybe Full.FragmentDefinition)
visitFragmentDefinition :: forall (m :: * -> *).
Text -> ValidationState m (Maybe FragmentDefinition)
visitFragmentDefinition Text
fragmentName = do
Document
definitions <- ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document)
-> ReaderT (Validation m) Seq Document
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Document
forall a b. (a -> b) -> a -> b
$ (Validation m -> Document) -> ReaderT (Validation m) Seq Document
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Document
forall (m :: * -> *). Validation m -> Document
ast
Bool
visited <- (HashSet Text -> Bool)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName)
(HashSet Text -> HashSet Text)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName)
case (Definition -> Bool) -> Document -> Maybe Definition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Definition -> Bool
isSpreadTarget Text
fragmentName) Document
definitions of
Just (Definition -> Maybe FragmentDefinition
viewFragment -> Just FragmentDefinition
fragmentDefinition)
| Bool -> Bool
not Bool
visited -> Maybe FragmentDefinition
-> ValidationState m (Maybe FragmentDefinition)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FragmentDefinition
-> ValidationState m (Maybe FragmentDefinition))
-> Maybe FragmentDefinition
-> ValidationState m (Maybe FragmentDefinition)
forall a b. (a -> b) -> a -> b
$ FragmentDefinition -> Maybe FragmentDefinition
forall a. a -> Maybe a
Just FragmentDefinition
fragmentDefinition
Maybe Definition
_ -> Maybe FragmentDefinition
-> ValidationState m (Maybe FragmentDefinition)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FragmentDefinition
forall a. Maybe a
Nothing
variablesInAllowedPositionRule :: forall m. Rule m
variablesInAllowedPositionRule :: forall (m :: * -> *). Rule m
variablesInAllowedPositionRule = (OperationDefinition -> RuleT m) -> Rule m
forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule ((OperationDefinition -> RuleT m) -> Rule m)
-> (OperationDefinition -> RuleT m) -> Rule m
forall a b. (a -> b) -> a -> b
$ \case
Full.OperationDefinition OperationType
operationType Maybe Text
_ [VariableDefinition]
variables [Directive]
_ SelectionSet
selectionSet Location
_ -> do
Schema m
schema' <- (Validation m -> Schema m) -> ReaderT (Validation m) Seq (Schema m)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
let root :: ObjectType m -> RuleT m
root = [VariableDefinition]
-> SelectionSetOpt -> CompositeType m -> RuleT m
forall {t :: * -> *}.
Foldable t =>
[VariableDefinition] -> t Selection -> CompositeType m -> RuleT m
go [VariableDefinition]
variables (SelectionSet -> SelectionSetOpt
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet) (CompositeType m -> RuleT m)
-> (ObjectType m -> CompositeType m) -> ObjectType m -> RuleT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType m -> CompositeType m
forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
case OperationType
operationType of
OperationType
Full.Query -> ObjectType m -> RuleT m
root (ObjectType m -> RuleT m) -> ObjectType m -> RuleT m
forall a b. (a -> b) -> a -> b
$ Schema m -> ObjectType m
forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
OperationType
Full.Mutation
| Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> ObjectType m -> RuleT m
root ObjectType m
objectType
OperationType
Full.Subscription
| Just ObjectType m
objectType <- Schema m -> Maybe (ObjectType m)
forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> ObjectType m -> RuleT m
root ObjectType m
objectType
OperationType
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
OperationDefinition
_ -> Seq Error -> RuleT m
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
where
go :: [VariableDefinition] -> t Selection -> CompositeType m -> RuleT m
go [VariableDefinition]
variables t Selection
selections CompositeType m
selectionType = (Seq (Seq Error) -> Seq Error)
-> ReaderT (Validation m) Seq (Seq Error) -> RuleT m
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((Seq Error -> Seq Error -> Seq Error)
-> Seq Error -> Seq (Seq Error) -> Seq Error
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
(<>) Seq Error
forall a. Seq a
Seq.empty)
(ReaderT (Validation m) Seq (Seq Error) -> RuleT m)
-> ReaderT (Validation m) Seq (Seq Error) -> RuleT m
forall a b. (a -> b) -> a -> b
$ (StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
-> HashSet Text -> ReaderT (Validation m) Seq (Seq Error))
-> HashSet Text
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
-> ReaderT (Validation m) Seq (Seq Error)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
-> HashSet Text -> ReaderT (Validation m) Seq (Seq Error)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HashSet Text
forall a. HashSet a
HashSet.empty
(StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
-> ReaderT (Validation m) Seq (Seq Error))
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
-> ReaderT (Validation m) Seq (Seq Error)
forall a b. (a -> b) -> a -> b
$ [VariableDefinition]
-> CompositeType m
-> SelectionSetOpt
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (t :: * -> *).
Foldable t =>
[VariableDefinition]
-> CompositeType m
-> t Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
selectionType
(SelectionSetOpt
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> SelectionSetOpt
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ t Selection -> SelectionSetOpt
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Selection
selections
visitSelectionSet :: Foldable t
=> [Full.VariableDefinition]
-> Type.CompositeType m
-> t Full.Selection
-> ValidationState m (Seq Error)
visitSelectionSet :: forall (t :: * -> *).
Foldable t =>
[VariableDefinition]
-> CompositeType m
-> t Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
selectionType =
(Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> t Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
selectionType) Seq Error
forall a. Monoid a => a
mempty
evaluateFieldSelection :: [VariableDefinition]
-> t Selection
-> Seq Error
-> Maybe (CompositeType m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateFieldSelection [VariableDefinition]
variables t Selection
selections Seq Error
accumulator = \case
Just CompositeType m
newParentType -> do
let folder :: Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
folder = [VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
newParentType
Seq Error
selectionErrors <- (Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> t Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
folder Seq Error
accumulator t Selection
selections
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
Maybe (CompositeType m)
Nothing -> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Error
accumulator
evaluateSelection :: [Full.VariableDefinition]
-> Type.CompositeType m
-> Seq Error
-> Full.Selection
-> ValidationState m (Seq Error)
evaluateSelection :: [VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
selectionType Seq Error
accumulator Selection
selection
| Full.FragmentSpreadSelection FragmentSpread
spread <- Selection
selection
, Full.FragmentSpread Text
fragmentName [Directive]
_ Location
_ <- FragmentSpread
spread = do
HashMap Text (Type m)
types' <- ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (Type m)))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
Maybe FragmentDefinition
nonVisitedFragmentDefinition <- Text -> ValidationState m (Maybe FragmentDefinition)
forall (m :: * -> *).
Text -> ValidationState m (Maybe FragmentDefinition)
visitFragmentDefinition Text
fragmentName
case Maybe FragmentDefinition
nonVisitedFragmentDefinition of
Just FragmentDefinition
fragmentDefinition
| Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
_ Location
_ <- FragmentDefinition
fragmentDefinition
, Just CompositeType m
spreadType <- Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' -> do
Seq Error
spreadErrors <- [VariableDefinition]
-> FragmentSpread
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
spreadVariables [VariableDefinition]
variables FragmentSpread
spread
Seq Error
selectionErrors <- [VariableDefinition]
-> CompositeType m
-> FragmentDefinition
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
diveIntoSpread [VariableDefinition]
variables CompositeType m
spreadType FragmentDefinition
fragmentDefinition
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
spreadErrors Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
Maybe FragmentDefinition
_ -> ReaderT (Validation m) Seq (Seq Error)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (Seq Error)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> ReaderT (Validation m) Seq (Seq Error)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq (Seq Error) -> ReaderT (Validation m) Seq (Seq Error)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Validation m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq (Seq Error)
forall a. Monoid a => a
mempty
| Full.FieldSelection Field
fieldSelection <- Selection
selection
, Full.Field Maybe Text
_ Text
fieldName [Argument]
_ [Directive]
_ SelectionSetOpt
subselections Location
_ <- Field
fieldSelection =
case Text -> CompositeType m -> Maybe (Field m)
forall (a :: * -> *). Text -> CompositeType a -> Maybe (Field a)
Type.lookupCompositeField Text
fieldName CompositeType m
selectionType of
Just (Out.Field Maybe Text
_ Type m
typeField Arguments
argumentTypes) -> do
Seq Error
fieldErrors <- [VariableDefinition]
-> Arguments
-> Field
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
fieldVariables [VariableDefinition]
variables Arguments
argumentTypes Field
fieldSelection
Seq Error
selectionErrors <- [VariableDefinition]
-> SelectionSetOpt
-> Seq Error
-> Maybe (CompositeType m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Foldable t =>
[VariableDefinition]
-> t Selection
-> Seq Error
-> Maybe (CompositeType m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateFieldSelection [VariableDefinition]
variables SelectionSetOpt
subselections Seq Error
accumulator
(Maybe (CompositeType m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Maybe (CompositeType m)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Type m -> Maybe (CompositeType m)
forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
typeField
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
selectionErrors Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
fieldErrors
Maybe (Field m)
Nothing -> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Error
accumulator
| Full.InlineFragmentSelection InlineFragment
inlineSelection <- Selection
selection
, Full.InlineFragment Maybe Text
typeCondition [Directive]
_ SelectionSet
subselections Location
_ <- InlineFragment
inlineSelection = do
HashMap Text (Type m)
types' <- ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (Type m)))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m)))
-> (Validation m -> HashMap Text (Type m))
-> ReaderT (Validation m) Seq (HashMap Text (Type m))
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text (Type m)
forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types (Schema m -> HashMap Text (Type m))
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text (Type m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
let inlineType :: CompositeType m
inlineType = CompositeType m -> Maybe (CompositeType m) -> CompositeType m
forall a. a -> Maybe a -> a
fromMaybe CompositeType m
selectionType
(Maybe (CompositeType m) -> CompositeType m)
-> Maybe (CompositeType m) -> CompositeType m
forall a b. (a -> b) -> a -> b
$ Maybe Text
typeCondition Maybe Text
-> (Text -> Maybe (CompositeType m)) -> Maybe (CompositeType m)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> HashMap Text (Type m) -> Maybe (CompositeType m))
-> HashMap Text (Type m) -> Text -> Maybe (CompositeType m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition HashMap Text (Type m)
types'
Seq Error
fragmentErrors <- [VariableDefinition]
-> InlineFragment
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
inlineVariables [VariableDefinition]
variables InlineFragment
inlineSelection
let folder :: Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
folder = [VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
inlineType
Seq Error
selectionErrors <- (Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> SelectionSet
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Error
-> Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
folder Seq Error
accumulator SelectionSet
subselections
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
fragmentErrors Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
inlineVariables :: [VariableDefinition]
-> InlineFragment
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
inlineVariables [VariableDefinition]
variables InlineFragment
inline
| Full.InlineFragment Maybe Text
_ [Directive]
directives' SelectionSet
_ Location
_ <- InlineFragment
inline =
[VariableDefinition]
-> [Directive]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
fieldVariables :: [Full.VariableDefinition]
-> In.Arguments
-> Full.Field
-> ValidationState m (Seq Error)
fieldVariables :: [VariableDefinition]
-> Arguments
-> Field
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
fieldVariables [VariableDefinition]
variables Arguments
argumentTypes Field
fieldSelection = do
let Full.Field Maybe Text
_ Text
_ [Argument]
arguments [Directive]
directives' SelectionSetOpt
_ Location
_ = Field
fieldSelection
Seq Error
argumentErrors <- [VariableDefinition]
-> Arguments
-> [Argument]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> Arguments
-> t Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
argumentTypes [Argument]
arguments
Seq Error
directiveErrors <- [VariableDefinition]
-> [Directive]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
argumentErrors Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
directiveErrors
spreadVariables :: [VariableDefinition]
-> FragmentSpread
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
spreadVariables [VariableDefinition]
variables (Full.FragmentSpread Text
_ [Directive]
directives' Location
_) =
[VariableDefinition]
-> [Directive]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
diveIntoSpread :: [VariableDefinition]
-> CompositeType m
-> FragmentDefinition
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
diveIntoSpread [VariableDefinition]
variables CompositeType m
fieldType FragmentDefinition
fragmentDefinition = do
let Full.FragmentDefinition Text
_ Text
_ [Directive]
directives' SelectionSet
selections Location
_ =
FragmentDefinition
fragmentDefinition
Seq Error
selectionErrors <- [VariableDefinition]
-> CompositeType m
-> SelectionSet
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (t :: * -> *).
Foldable t =>
[VariableDefinition]
-> CompositeType m
-> t Selection
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
fieldType SelectionSet
selections
Seq Error
directiveErrors <- [VariableDefinition]
-> [Directive]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ Seq Error
selectionErrors Seq Error -> Seq Error -> Seq Error
forall a. Semigroup a => a -> a -> a
<> Seq Error
directiveErrors
findDirectiveVariables :: [VariableDefinition]
-> Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
findDirectiveVariables [VariableDefinition]
variables Directive
directive = do
let Full.Directive Text
directiveName [Argument]
arguments Location
_ = Directive
directive
HashMap Text Directive
directiveDefinitions <- ReaderT (Validation m) Seq (HashMap Text Directive)
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text Directive)
forall (m :: * -> *) a. Monad m => m a -> StateT (HashSet Text) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Validation m) Seq (HashMap Text Directive)
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text Directive))
-> ReaderT (Validation m) Seq (HashMap Text Directive)
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text Directive)
forall a b. (a -> b) -> a -> b
$ (Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive)
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive))
-> (Validation m -> HashMap Text Directive)
-> ReaderT (Validation m) Seq (HashMap Text Directive)
forall a b. (a -> b) -> a -> b
$ Schema m -> HashMap Text Directive
forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives (Schema m -> HashMap Text Directive)
-> (Validation m -> Schema m)
-> Validation m
-> HashMap Text Directive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation m -> Schema m
forall (m :: * -> *). Validation m -> Schema m
schema
case Text -> HashMap Text Directive -> Maybe Directive
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName HashMap Text Directive
directiveDefinitions of
Just (Schema.Directive Maybe Text
_ [DirectiveLocation]
_ Arguments
directiveArguments) ->
[VariableDefinition]
-> Arguments
-> [Argument]
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> Arguments
-> t Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
directiveArguments [Argument]
arguments
Maybe Directive
Nothing -> Seq Error
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a. a -> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Error
forall a. Monoid a => a
mempty
mapArguments :: [VariableDefinition]
-> Arguments
-> t Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
argumentTypes = (t (Seq Error) -> Seq Error)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b.
(a -> b)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (Seq Error) -> Seq Error
forall m. Monoid m => t m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
(StateT (HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> (t Argument
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error)))
-> t Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> t Argument
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse ([VariableDefinition]
-> Arguments
-> Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
findArgumentVariables [VariableDefinition]
variables Arguments
argumentTypes)
mapDirectives :: [VariableDefinition]
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
mapDirectives [VariableDefinition]
variables = (t (Seq Error) -> Seq Error)
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b.
(a -> b)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) a
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t (Seq Error) -> Seq Error
forall m. Monoid m => t m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
(StateT (HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> (t Directive
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error)))
-> t Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> t Directive
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (t (Seq Error))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse ([VariableDefinition]
-> Directive
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
findDirectiveVariables [VariableDefinition]
variables)
lookupInputObject :: t VariableDefinition
-> Node Value -> Maybe (Type, Maybe Value) -> f (Seq Error)
lookupInputObject t VariableDefinition
variables Node Value
objectFieldValue Maybe (Type, Maybe Value)
locationInfo
| Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Full.Object [ObjectField Value]
objectFields } <- Node Value
objectFieldValue
, Just (Type
expectedType, Maybe Value
_) <- Maybe (Type, Maybe Value)
locationInfo
, In.InputObjectBaseType InputObjectType
inputObjectType <- Type
expectedType
, In.InputObjectType Text
_ Maybe Text
_ HashMap Text InputField
fieldTypes' <- InputObjectType
inputObjectType =
[Seq Error] -> Seq Error
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Seq Error] -> Seq Error) -> f [Seq Error] -> f (Seq Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectField Value -> f (Seq Error))
-> [ObjectField Value] -> f [Seq Error]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (t VariableDefinition
-> HashMap Text InputField -> ObjectField Value -> f (Seq Error)
traverseObjectField t VariableDefinition
variables HashMap Text InputField
fieldTypes') [ObjectField Value]
objectFields
| Bool
otherwise = Seq Error -> f (Seq Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Error
forall a. Monoid a => a
mempty
maybeUsageAllowed :: Text
-> t VariableDefinition -> Maybe (Type, Maybe a) -> f (Seq Error)
maybeUsageAllowed Text
variableName t VariableDefinition
variables Maybe (Type, Maybe a)
locationInfo
| Just (Type
locationType, Maybe a
locationValue) <- Maybe (Type, Maybe a)
locationInfo
, VariableDefinition -> Bool
findVariableDefinition' <- Text -> VariableDefinition -> Bool
findVariableDefinition Text
variableName
, Just VariableDefinition
variableDefinition <- (VariableDefinition -> Bool)
-> t VariableDefinition -> Maybe VariableDefinition
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find VariableDefinition -> Bool
findVariableDefinition' t VariableDefinition
variables
= Maybe Error -> Seq Error
forall a. Maybe a -> Seq a
maybeToSeq
(Maybe Error -> Seq Error) -> f (Maybe Error) -> f (Seq Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Maybe a -> VariableDefinition -> f (Maybe Error)
forall {f :: * -> *} {a}.
Applicative f =>
Type -> Maybe a -> VariableDefinition -> f (Maybe Error)
isVariableUsageAllowed Type
locationType Maybe a
locationValue VariableDefinition
variableDefinition
| Bool
otherwise = Seq Error -> f (Seq Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Error
forall a. Monoid a => a
mempty
findArgumentVariables :: [Full.VariableDefinition]
-> HashMap Full.Name In.Argument
-> Full.Argument
-> ValidationState m (Seq Error)
findArgumentVariables :: [VariableDefinition]
-> Arguments
-> Argument
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
findArgumentVariables [VariableDefinition]
variables Arguments
argumentTypes Argument
argument
| Full.Argument Text
argumentName Node Value
argumentValue Location
_ <- Argument
argument
, Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Full.Variable Text
variableName } <- Node Value
argumentValue
= Text
-> [VariableDefinition]
-> Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {t :: * -> *} {f :: * -> *} {a}.
(Foldable t, Applicative f) =>
Text
-> t VariableDefinition -> Maybe (Type, Maybe a) -> f (Seq Error)
maybeUsageAllowed Text
variableName [VariableDefinition]
variables
(Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ (Argument -> (Type, Maybe Value))
-> Arguments -> Text -> Maybe (Type, Maybe Value)
forall {k} {a} {b}.
Hashable k =>
(a -> b) -> HashMap k a -> k -> Maybe b
locationPair Argument -> (Type, Maybe Value)
extractArgument Arguments
argumentTypes Text
argumentName
| Full.Argument Text
argumentName Node Value
argumentValue Location
_ <- Argument
argument
= [VariableDefinition]
-> Node Value
-> Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall {f :: * -> *} {t :: * -> *}.
(Applicative f, Foldable t) =>
t VariableDefinition
-> Node Value -> Maybe (Type, Maybe Value) -> f (Seq Error)
lookupInputObject [VariableDefinition]
variables Node Value
argumentValue
(Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error))
-> Maybe (Type, Maybe Value)
-> StateT (HashSet Text) (ReaderT (Validation m) Seq) (Seq Error)
forall a b. (a -> b) -> a -> b
$ (Argument -> (Type, Maybe Value))
-> Arguments -> Text -> Maybe (Type, Maybe Value)
forall {k} {a} {b}.
Hashable k =>
(a -> b) -> HashMap k a -> k -> Maybe b
locationPair Argument -> (Type, Maybe Value)
extractArgument Arguments
argumentTypes Text
argumentName
extractField :: InputField -> (Type, Maybe Value)
extractField (In.InputField Maybe Text
_ Type
locationType Maybe Value
locationValue) =
(Type
locationType, Maybe Value
locationValue)
extractArgument :: Argument -> (Type, Maybe Value)
extractArgument (In.Argument Maybe Text
_ Type
locationType Maybe Value
locationValue) =
(Type
locationType, Maybe Value
locationValue)
locationPair :: (a -> b) -> HashMap k a -> k -> Maybe b
locationPair a -> b
extract HashMap k a
fieldTypes k
name =
a -> b
extract (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
name HashMap k a
fieldTypes
traverseObjectField :: t VariableDefinition
-> HashMap Text InputField -> ObjectField Value -> f (Seq Error)
traverseObjectField t VariableDefinition
variables HashMap Text InputField
fieldTypes Full.ObjectField{Text
Node Value
Location
name :: Text
value :: Node Value
location :: Location
$sel:name:ObjectField :: forall a. ObjectField a -> Text
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:location:ObjectField :: forall a. ObjectField a -> Location
..}
| Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Full.Variable Text
variableName } <- Node Value
value
= Text
-> t VariableDefinition
-> Maybe (Type, Maybe Value)
-> f (Seq Error)
forall {t :: * -> *} {f :: * -> *} {a}.
(Foldable t, Applicative f) =>
Text
-> t VariableDefinition -> Maybe (Type, Maybe a) -> f (Seq Error)
maybeUsageAllowed Text
variableName t VariableDefinition
variables
(Maybe (Type, Maybe Value) -> f (Seq Error))
-> Maybe (Type, Maybe Value) -> f (Seq Error)
forall a b. (a -> b) -> a -> b
$ (InputField -> (Type, Maybe Value))
-> HashMap Text InputField -> Text -> Maybe (Type, Maybe Value)
forall {k} {a} {b}.
Hashable k =>
(a -> b) -> HashMap k a -> k -> Maybe b
locationPair InputField -> (Type, Maybe Value)
extractField HashMap Text InputField
fieldTypes Text
name
| Bool
otherwise = t VariableDefinition
-> Node Value -> Maybe (Type, Maybe Value) -> f (Seq Error)
lookupInputObject t VariableDefinition
variables Node Value
value
(Maybe (Type, Maybe Value) -> f (Seq Error))
-> Maybe (Type, Maybe Value) -> f (Seq Error)
forall a b. (a -> b) -> a -> b
$ (InputField -> (Type, Maybe Value))
-> HashMap Text InputField -> Text -> Maybe (Type, Maybe Value)
forall {k} {a} {b}.
Hashable k =>
(a -> b) -> HashMap k a -> k -> Maybe b
locationPair InputField -> (Type, Maybe Value)
extractField HashMap Text InputField
fieldTypes Text
name
findVariableDefinition :: Text -> VariableDefinition -> Bool
findVariableDefinition Text
variableName VariableDefinition
variableDefinition =
let Full.VariableDefinition Text
variableName' Type
_ Maybe (Node ConstValue)
_ Location
_ = VariableDefinition
variableDefinition
in Text
variableName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
variableName'
isVariableUsageAllowed :: Type -> Maybe a -> VariableDefinition -> f (Maybe Error)
isVariableUsageAllowed Type
locationType Maybe a
locationDefaultValue VariableDefinition
variableDefinition
| Full.VariableDefinition Text
_ Type
variableType Maybe (Node ConstValue)
_ Location
_ <- VariableDefinition
variableDefinition
, Full.TypeNonNull NonNullType
_ <- Type
variableType =
VariableDefinition -> Type -> f (Maybe Error)
forall {f :: * -> *}.
Applicative f =>
VariableDefinition -> Type -> f (Maybe Error)
typesCompatibleOrError VariableDefinition
variableDefinition Type
locationType
| Just Type
nullableLocationType <- Type -> Maybe Type
unwrapInType Type
locationType
, Full.VariableDefinition Text
_ Type
variableType Maybe (Node ConstValue)
variableDefaultValue Location
_ <-
VariableDefinition
variableDefinition
, Bool
hasNonNullVariableDefaultValue' <-
Maybe (Node ConstValue) -> Bool
hasNonNullVariableDefaultValue Maybe (Node ConstValue)
variableDefaultValue
, Bool
hasLocationDefaultValue <- Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
locationDefaultValue =
if (Bool
hasNonNullVariableDefaultValue' Bool -> Bool -> Bool
|| Bool
hasLocationDefaultValue)
Bool -> Bool -> Bool
&& Type -> Type -> Bool
areTypesCompatible Type
variableType Type
nullableLocationType
then Maybe Error -> f (Maybe Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Error
forall a. Maybe a
Nothing
else Maybe Error -> f (Maybe Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Error -> f (Maybe Error)) -> Maybe Error -> f (Maybe Error)
forall a b. (a -> b) -> a -> b
$ VariableDefinition -> Type -> Maybe Error
forall {a}. Show a => VariableDefinition -> a -> Maybe Error
makeError VariableDefinition
variableDefinition Type
locationType
| Bool
otherwise = VariableDefinition -> Type -> f (Maybe Error)
forall {f :: * -> *}.
Applicative f =>
VariableDefinition -> Type -> f (Maybe Error)
typesCompatibleOrError VariableDefinition
variableDefinition Type
locationType
typesCompatibleOrError :: VariableDefinition -> Type -> f (Maybe Error)
typesCompatibleOrError VariableDefinition
variableDefinition Type
locationType
| Full.VariableDefinition Text
_ Type
variableType Maybe (Node ConstValue)
_ Location
_ <- VariableDefinition
variableDefinition
, Type -> Type -> Bool
areTypesCompatible Type
variableType Type
locationType = Maybe Error -> f (Maybe Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Error
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Error -> f (Maybe Error)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Error -> f (Maybe Error)) -> Maybe Error -> f (Maybe Error)
forall a b. (a -> b) -> a -> b
$ VariableDefinition -> Type -> Maybe Error
forall {a}. Show a => VariableDefinition -> a -> Maybe Error
makeError VariableDefinition
variableDefinition Type
locationType
areTypesCompatible :: Type -> Type -> Bool
areTypesCompatible Type
nonNullType (Type -> Maybe Type
unwrapInType -> Just Type
nullableLocationType)
| Full.TypeNonNull (Full.NonNullTypeNamed Text
namedType) <- Type
nonNullType =
Type -> Type -> Bool
areTypesCompatible (Text -> Type
Full.TypeNamed Text
namedType) Type
nullableLocationType
| Full.TypeNonNull (Full.NonNullTypeList Type
namedList) <- Type
nonNullType =
Type -> Type -> Bool
areTypesCompatible (Type -> Type
Full.TypeList Type
namedList) Type
nullableLocationType
areTypesCompatible Type
_ (Type -> Bool
In.isNonNullType -> Bool
True) = Bool
False
areTypesCompatible (Full.TypeNonNull NonNullType
nonNullType) Type
locationType
| Full.NonNullTypeNamed Text
namedType <- NonNullType
nonNullType =
Type -> Type -> Bool
areTypesCompatible (Text -> Type
Full.TypeNamed Text
namedType) Type
locationType
| Full.NonNullTypeList Type
namedType <- NonNullType
nonNullType =
Type -> Type -> Bool
areTypesCompatible (Type -> Type
Full.TypeList Type
namedType) Type
locationType
areTypesCompatible Type
variableType Type
locationType
| Full.TypeList Type
itemVariableType <- Type
variableType
, In.ListType Type
itemLocationType <- Type
locationType =
Type -> Type -> Bool
areTypesCompatible Type
itemVariableType Type
itemLocationType
| Type -> Type -> Bool
areIdentical Type
variableType Type
locationType = Bool
True
| Bool
otherwise = Bool
False
areIdentical :: Type -> Type -> Bool
areIdentical (Full.TypeList Type
typeList) (In.ListType Type
itemLocationType) =
Type -> Type -> Bool
areIdentical Type
typeList Type
itemLocationType
areIdentical (Full.TypeNonNull NonNullType
nonNullType) Type
locationType
| Full.NonNullTypeList Type
nonNullList <- NonNullType
nonNullType
, In.NonNullListType Type
itemLocationType <- Type
locationType =
Type -> Type -> Bool
areIdentical Type
nonNullList Type
itemLocationType
| Full.NonNullTypeNamed Text
_ <- NonNullType
nonNullType
, In.ListBaseType Type
_ <- Type
locationType = Bool
False
| Full.NonNullTypeNamed Text
nonNullList <- NonNullType
nonNullType
, Type -> Bool
In.isNonNullType Type
locationType =
Text
nonNullList Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Type -> Text
inputTypeName Type
locationType
areIdentical (Full.TypeNamed Text
_) (In.ListBaseType Type
_) = Bool
False
areIdentical (Full.TypeNamed Text
typeNamed) Type
locationType
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Type -> Bool
In.isNonNullType Type
locationType =
Text
typeNamed Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Type -> Text
inputTypeName Type
locationType
areIdentical Type
_ Type
_ = Bool
False
hasNonNullVariableDefaultValue :: Maybe (Node ConstValue) -> Bool
hasNonNullVariableDefaultValue (Just (Full.Node ConstValue
Full.ConstNull Location
_)) = Bool
False
hasNonNullVariableDefaultValue Maybe (Node ConstValue)
Nothing = Bool
False
hasNonNullVariableDefaultValue Maybe (Node ConstValue)
_ = Bool
True
makeError :: VariableDefinition -> a -> Maybe Error
makeError VariableDefinition
variableDefinition a
expectedType =
let Full.VariableDefinition Text
variableName Type
variableType Maybe (Node ConstValue)
_ Location
location' =
VariableDefinition
variableDefinition
in Error -> Maybe Error
forall a. a -> Maybe a
Just (Error -> Maybe Error) -> Error -> Maybe Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" of type \""
, Type -> String
forall a. Show a => a -> String
show Type
variableType
, String
"\" used in position expecting type \""
, a -> String
forall a. Show a => a -> String
show a
expectedType
, String
"\"."
]
, locations :: [Location]
locations = [Location
location']
}
unwrapInType :: In.Type -> Maybe In.Type
unwrapInType :: Type -> Maybe Type
unwrapInType (In.NonNullScalarType ScalarType
nonNullType) =
Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ ScalarType -> Type
In.NamedScalarType ScalarType
nonNullType
unwrapInType (In.NonNullEnumType EnumType
nonNullType) =
Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ EnumType -> Type
In.NamedEnumType EnumType
nonNullType
unwrapInType (In.NonNullInputObjectType InputObjectType
nonNullType) =
Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ InputObjectType -> Type
In.NamedInputObjectType InputObjectType
nonNullType
unwrapInType (In.NonNullListType Type
nonNullType) =
Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
In.ListType Type
nonNullType
unwrapInType Type
_ = Maybe Type
forall a. Maybe a
Nothing
valuesOfCorrectTypeRule :: forall m. Rule m
valuesOfCorrectTypeRule :: forall (m :: * -> *). Rule m
valuesOfCorrectTypeRule = (Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule Maybe Type -> Node Value -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go Maybe Type -> Node ConstValue -> RuleT m
forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node ConstValue -> t Seq Error
constGo
where
go :: Maybe Type -> Node Value -> t Seq Error
go (Just Type
inputType) Node Value
value
| Just Node ConstValue
constValue <- Node Value -> Maybe (Node ConstValue)
toConstNode Node Value
value =
Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error) -> Seq Error -> t Seq Error
forall a b. (a -> b) -> a -> b
$ Type -> Node ConstValue -> Seq Error
check Type
inputType Node ConstValue
constValue
go Maybe Type
_ Node Value
_ = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
toConstNode :: Node Value -> Maybe (Node ConstValue)
toConstNode Full.Node{Value
Location
$sel:node:Node :: forall a. Node a -> a
$sel:location:Node :: forall a. Node a -> Location
node :: Value
location :: Location
..} = (ConstValue -> Location -> Node ConstValue)
-> Location -> ConstValue -> Node ConstValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConstValue -> Location -> Node ConstValue
forall a. a -> Location -> Node a
Full.Node Location
location (ConstValue -> Node ConstValue)
-> Maybe ConstValue -> Maybe (Node ConstValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Maybe ConstValue
toConst Value
node
toConst :: Value -> Maybe ConstValue
toConst (Full.Variable Text
_) = Maybe ConstValue
forall a. Maybe a
Nothing
toConst (Full.Int Int32
integer) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Int32 -> ConstValue
Full.ConstInt Int32
integer
toConst (Full.Float Double
double) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Double -> ConstValue
Full.ConstFloat Double
double
toConst (Full.String Text
string) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Text -> ConstValue
Full.ConstString Text
string
toConst (Full.Boolean Bool
boolean) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Bool -> ConstValue
Full.ConstBoolean Bool
boolean
toConst Value
Full.Null = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just ConstValue
Full.ConstNull
toConst (Full.Enum Text
enum) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ Text -> ConstValue
Full.ConstEnum Text
enum
toConst (Full.List [Node Value]
values) =
ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ [Node ConstValue] -> ConstValue
Full.ConstList ([Node ConstValue] -> ConstValue)
-> [Node ConstValue] -> ConstValue
forall a b. (a -> b) -> a -> b
$ (Node Value -> Maybe (Node ConstValue))
-> [Node Value] -> [Node ConstValue]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node Value -> Maybe (Node ConstValue)
toConstNode [Node Value]
values
toConst (Full.Object [ObjectField Value]
fields) = ConstValue -> Maybe ConstValue
forall a. a -> Maybe a
Just (ConstValue -> Maybe ConstValue) -> ConstValue -> Maybe ConstValue
forall a b. (a -> b) -> a -> b
$ [ObjectField ConstValue] -> ConstValue
Full.ConstObject
([ObjectField ConstValue] -> ConstValue)
-> [ObjectField ConstValue] -> ConstValue
forall a b. (a -> b) -> a -> b
$ (ObjectField Value -> Maybe (ObjectField ConstValue))
-> [ObjectField Value] -> [ObjectField ConstValue]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ObjectField Value -> Maybe (ObjectField ConstValue)
constObjectField [ObjectField Value]
fields
constObjectField :: ObjectField Value -> Maybe (ObjectField ConstValue)
constObjectField Full.ObjectField{Text
Node Value
Location
$sel:name:ObjectField :: forall a. ObjectField a -> Text
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:location:ObjectField :: forall a. ObjectField a -> Location
name :: Text
value :: Node Value
location :: Location
..}
| Just Node ConstValue
constValue <- Node Value -> Maybe (Node ConstValue)
toConstNode Node Value
value =
ObjectField ConstValue -> Maybe (ObjectField ConstValue)
forall a. a -> Maybe a
Just (ObjectField ConstValue -> Maybe (ObjectField ConstValue))
-> ObjectField ConstValue -> Maybe (ObjectField ConstValue)
forall a b. (a -> b) -> a -> b
$ Text -> Node ConstValue -> Location -> ObjectField ConstValue
forall a. Text -> Node a -> Location -> ObjectField a
Full.ObjectField Text
name Node ConstValue
constValue Location
location
| Bool
otherwise = Maybe (ObjectField ConstValue)
forall a. Maybe a
Nothing
constGo :: Maybe Type -> Node ConstValue -> t Seq Error
constGo Maybe Type
Nothing = t Seq Error -> Node ConstValue -> t Seq Error
forall a b. a -> b -> a
const (t Seq Error -> Node ConstValue -> t Seq Error)
-> t Seq Error -> Node ConstValue -> t Seq Error
forall a b. (a -> b) -> a -> b
$ Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Seq Error
forall a. Monoid a => a
mempty
constGo (Just Type
inputType) = Seq Error -> t Seq Error
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Seq Error -> t Seq Error)
-> (Node ConstValue -> Seq Error) -> Node ConstValue -> t Seq Error
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Node ConstValue -> Seq Error
check Type
inputType
check :: In.Type -> Full.Node Full.ConstValue -> Seq Error
check :: Type -> Node ConstValue -> Seq Error
check Type
_ Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = ConstValue
Full.ConstNull } =
Seq Error
forall a. Monoid a => a
mempty
check (In.ScalarBaseType ScalarType
scalarType) Full.Node{ ConstValue
$sel:node:Node :: forall a. Node a -> a
node :: ConstValue
node }
| Definition.ScalarType Text
"Int" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Boolean" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstBoolean Bool
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"String" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstString Text
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"ID" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstString Text
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"ID" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Float" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstFloat Double
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Float" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
check (In.EnumBaseType EnumType
enumType) Full.Node{ ConstValue
$sel:node:Node :: forall a. Node a -> a
node :: ConstValue
node }
| Definition.EnumType Text
_ Maybe Text
_ HashMap Text EnumValue
members <- EnumType
enumType
, Full.ConstEnum Text
memberValue <- ConstValue
node
, Text -> HashMap Text EnumValue -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
memberValue HashMap Text EnumValue
members = Seq Error
forall a. Monoid a => a
mempty
check (In.InputObjectBaseType InputObjectType
objectType) Full.Node{ ConstValue
$sel:node:Node :: forall a. Node a -> a
node :: ConstValue
node }
| In.InputObjectType{} <- InputObjectType
objectType
, Full.ConstObject{} <- ConstValue
node = Seq Error
forall a. Monoid a => a
mempty
check (In.ListBaseType Type
listType) constValue :: Node ConstValue
constValue@Full.Node{ ConstValue
Location
$sel:node:Node :: forall a. Node a -> a
$sel:location:Node :: forall a. Node a -> Location
node :: ConstValue
location :: Location
.. }
| Full.ConstList [Node ConstValue]
values <- ConstValue
node =
(Node ConstValue -> Seq Error) -> [Node ConstValue] -> Seq Error
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Type -> Node ConstValue -> Seq Error
checkNull Type
listType) [Node ConstValue]
values
| Bool
otherwise = Type -> Node ConstValue -> Seq Error
check Type
listType Node ConstValue
constValue
check Type
inputType Full.Node{ ConstValue
Location
$sel:node:Node :: forall a. Node a -> a
$sel:location:Node :: forall a. Node a -> Location
node :: ConstValue
location :: Location
.. } = Error -> Seq Error
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Value "
, ConstValue -> String
forall a. Show a => a -> String
show ConstValue
node
, String
" cannot be coerced to type \""
, Type -> String
forall a. Show a => a -> String
show Type
inputType
, String
"\"."
]
, locations :: [Location]
locations = [Location
location]
}
checkNull :: Type -> Node ConstValue -> Seq Error
checkNull Type
inputType Node ConstValue
constValue =
let checkResult :: Seq Error
checkResult = Type -> Node ConstValue -> Seq Error
check Type
inputType Node ConstValue
constValue
in case Seq Error -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq Error
checkResult of
Bool
True
| Just Type
unwrappedType <- Type -> Maybe Type
unwrapInType Type
inputType
, Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = ConstValue
Full.ConstNull, Location
$sel:location:Node :: forall a. Node a -> Location
location :: Location
.. } <- Node ConstValue
constValue ->
Error -> Seq Error
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error -> Seq Error) -> Error -> Seq Error
forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"List of non-null values of type \""
, Type -> String
forall a. Show a => a -> String
show Type
unwrappedType
, String
"\" cannot contain null values."
]
, locations :: [Location]
locations = [Location
location]
}
| Bool
otherwise -> Seq Error
forall a. Monoid a => a
mempty
Bool
_ -> Seq Error
checkResult