{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 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 =
[ forall (m :: * -> *). Rule m
executableDefinitionsRule
, forall (m :: * -> *). Rule m
singleFieldSubscriptionsRule
, forall (m :: * -> *). Rule m
loneAnonymousOperationRule
, forall (m :: * -> *). Rule m
uniqueOperationNamesRule
, forall (m :: * -> *). Rule m
fieldsOnCorrectTypeRule
, forall (m :: * -> *). Rule m
scalarLeafsRule
, forall (m :: * -> *). Rule m
overlappingFieldsCanBeMergedRule
, forall (m :: * -> *). Rule m
knownArgumentNamesRule
, forall (m :: * -> *). Rule m
uniqueArgumentNamesRule
, forall (m :: * -> *). Rule m
providedRequiredArgumentsRule
, forall (m :: * -> *). Rule m
uniqueFragmentNamesRule
, forall (m :: * -> *). Rule m
fragmentSpreadTypeExistenceRule
, forall (m :: * -> *). Rule m
fragmentsOnCompositeTypesRule
, forall (m :: * -> *). Rule m
noUnusedFragmentsRule
, forall (m :: * -> *). Rule m
fragmentSpreadTargetDefinedRule
, forall (m :: * -> *). Rule m
noFragmentCyclesRule
, forall (m :: * -> *). Rule m
possibleFragmentSpreadsRule
, forall (m :: * -> *). Rule m
valuesOfCorrectTypeRule
, forall (m :: * -> *). Rule m
knownInputFieldNamesRule
, forall (m :: * -> *). Rule m
uniqueInputFieldNamesRule
, forall (m :: * -> *). Rule m
providedRequiredInputFieldsRule
, forall (m :: * -> *). Rule m
knownDirectiveNamesRule
, forall (m :: * -> *). Rule m
directivesInValidLocationsRule
, forall (m :: * -> *). Rule m
uniqueDirectiveNamesRule
, forall (m :: * -> *). Rule m
uniqueVariableNamesRule
, forall (m :: * -> *). Rule m
variablesAreInputTypesRule
, forall (m :: * -> *). Rule m
noUndefinedVariablesRule
, forall (m :: * -> *). Rule m
noUnusedVariablesRule
, forall (m :: * -> *). Rule m
variablesInAllowedPositionRule
]
executableDefinitionsRule :: forall m. Rule m
executableDefinitionsRule :: forall (m :: * -> *). Rule m
executableDefinitionsRule = forall (m :: * -> *). (Definition -> RuleT m) -> Rule m
DefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.ExecutableDefinition ExecutableDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
Full.TypeSystemDefinition TypeSystemDefinition
_ Location
location' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
location'
Full.TypeSystemExtension TypeSystemExtension
_ Location
location' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule 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 <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall {m :: * -> *}.
SelectionSet
-> StateT
(HashSet Text) (ReaderT (Validation m) Seq) (HashSet Text)
collectFields SelectionSet
rootFields) forall a. HashSet a
HashSet.empty
case forall a. HashSet a -> Int
HashSet.size HashSet Text
groupedFieldSet of
Int
1 -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
Int
_
| Just Text
name <- Maybe Text
name' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = String
errorMessage
, locations :: [Location]
locations = [Location
location']
}
OperationDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = 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 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 -> 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
_)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
| Just Text
aliasedName <- Maybe Text
alias = forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
aliasedName HashSet Text
accumulator
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
_)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
| Bool
otherwise = do
Bool
inVisitetFragments <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName
if Bool
inVisitetFragments
then 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
_)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Directive -> Bool
skip [Directive]
directives' = 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 = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet Text
accumulator
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 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 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' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
Schema m
schema' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Schema m
schema
case forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet Text
accumulator
Just CompositeType m
compositeType
| Just ObjectType m
objectType <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.subscription Schema m
schema'
, Bool
True <- forall (m :: * -> *). CompositeType m -> ObjectType m -> Bool
Type.doesFragmentTypeApply CompositeType m
compositeType ObjectType m
objectType ->
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet Text
accumulator 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 -> 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
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName
Document
ast' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> 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 = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
_ Location
thisLocation -> forall {m :: * -> *}. Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation
Full.OperationDefinition OperationType
_ Maybe Text
Nothing [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
forall {m :: * -> *}. Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation
OperationDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
where
check :: Location -> ReaderT (Validation m) Seq Error
check Location
thisLocation = forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Location -> Definition -> Seq Error -> Seq Error
filterAnonymousOperations Location
thisLocation) 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 =
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 forall a. Eq a => a -> a -> Bool
/= Location
thatLocation -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
thisLocation
Full.SelectionSet SelectionSet
_ Location
thatLocation
| Location
thisLocation forall a. Eq a => a -> a -> Bool
/= Location
thatLocation -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Location -> Error
error' Location
thisLocation
OperationDefinition
_ -> 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 = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.OperationDefinition OperationType
_ (Just Text
thisName) [VariableDefinition]
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
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
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
where
error' :: Text -> String
error' Text
operationName = 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 forall a. Eq a => a -> a -> Bool
== Text
thatName = Location
thatLocation 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
let locations' :: [Location]
locations' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> [Location] -> [Location]
filterByName [] Document
ast'
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Location]
locations' forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& forall a. [a] -> a
head [Location]
locations' forall a. Eq a => a -> a -> Bool
== Location
thisLocation
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Location] -> Error
error' [Location]
locations'
else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 =
forall a. a -> Maybe a
Just OperationDefinition
operationDefinition
viewOperation Definition
_ = 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 =
forall a. a -> Maybe a
Just FragmentDefinition
fragmentDefinition
viewFragment Definition
_ = forall a. Maybe a
Nothing
uniqueFragmentNamesRule :: forall m. Rule m
uniqueFragmentNamesRule :: forall (m :: * -> *). Rule m
uniqueFragmentNamesRule = forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentDefinition Text
thisName Text
_ [Directive]
_ SelectionSet
_ Location
thisLocation ->
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 = 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 forall a. Eq a => a -> a -> Bool
== Text
thatName = Location
thatLocation forall a. a -> [a] -> [a]
: [Location]
accumulator
| Bool
otherwise = [Location]
accumulator
fragmentSpreadTargetDefinedRule :: forall m. Rule m
fragmentSpreadTargetDefinedRule :: forall (m :: * -> *). Rule m
fragmentSpreadTargetDefinedRule = forall (m :: * -> *). (FragmentSpread -> RuleT m) -> Rule m
FragmentSpreadRule forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentSpread Text
fragmentName [Directive]
_ Location
location' -> do
Document
ast' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Definition -> Bool
isSpreadTarget Text
fragmentName) Document
ast' of
Maybe Definition
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
error' Text
fragmentName
, locations :: [Location]
locations = [Location
location']
}
Just Definition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
where
error' :: Text -> String
error' Text
fragmentName = 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 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 = forall (m :: * -> *).
(Maybe (Type m) -> Selection -> RuleT m) -> Rule m
SelectionRule forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
Text
typeCondition <- forall (m1 :: * -> *). Text -> ReaderT (Validation m1) Seq Text
findSpreadTarget Text
fragmentName
case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
inlineError Text
typeCondition
, locations :: [Location]
locations = [Location
location']
}
Just Type m
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
Selection
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
where
spreadError :: Text -> Text -> String
spreadError Text
fragmentName Text
typeCondition = 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 = 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
maybeToSeq Maybe a
Nothing = forall a. Monoid a => a
mempty
fragmentsOnCompositeTypesRule :: forall m. Rule m
fragmentsOnCompositeTypesRule :: forall (m :: * -> *). Rule m
fragmentsOnCompositeTypesRule = forall (m :: * -> *).
(FragmentDefinition -> RuleT m)
-> (InlineFragment -> RuleT m) -> Rule m
FragmentRule forall {m :: * -> *}.
FragmentDefinition -> ReaderT (Validation m) Seq Error
definitionRule 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') =
forall {m :: * -> *}.
Text -> Location -> ReaderT (Validation m) Seq Error
check Text
typeCondition Location
location'
inlineRule InlineFragment
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
definitionRule :: FragmentDefinition -> ReaderT (Validation m) Seq Error
definitionRule (Full.FragmentDefinition Text
_ Text
typeCondition [Directive]
_ SelectionSet
_ Location
location') =
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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
Type m
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Seq a
maybeToSeq forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
typeCondition HashMap Text (Type m)
types'
case forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = Text -> String
errorMessage Text
typeCondition
, locations :: [Location]
locations = [Location
location']
}
Just CompositeType m
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
errorMessage :: Text -> String
errorMessage Text
typeCondition = 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 = forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule forall a b. (a -> b) -> a -> b
$ \FragmentDefinition
fragment -> do
let Full.FragmentDefinition Text
fragmentName Text
_ [Directive]
_ SelectionSet
_ Location
location' = FragmentDefinition
fragment
in forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall {t :: * -> *} {f :: * -> *}.
(Foldable t, Monoid (f Error), Applicative f) =>
Text -> Location -> t Text -> f Error
checkFragmentName Text
fragmentName Location
location')
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. HashSet a
HashSet.empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a (m :: * -> *).
Foldable t =>
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
filterSelections forall {t :: (* -> *) -> * -> *} {t :: (* -> *) -> * -> *}
{m :: * -> *}.
(MonadTrans t, MonadTrans t, Monad m, Monad (t m),
Monoid (m Text)) =>
Selection -> t (t m) Text
evaluateSelection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Text
elements = forall a. Monoid a => a
mempty
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
spreadName
evaluateSelection Selection
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 =
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selections
| Full.SelectionSet SelectionSet
selections Location
_ <- OperationDefinition
operation = 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 = 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
= (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) (forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Selection -> SelectionSetOpt -> SelectionSetOpt
evaluateSelection forall a. Monoid a => a
mempty t Selection
selections)
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 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 forall a. a -> [a] -> [a]
: 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 forall a. a -> [a] -> [a]
: 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 = forall (m :: * -> *). (FragmentDefinition -> RuleT m) -> Rule m
FragmentDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.FragmentDefinition Text
fragmentName Text
_ [Directive]
_ SelectionSet
selections Location
location' -> do
HashMap Text Int
state <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd) (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Int
state)
case forall a. [a] -> [a]
reverse [Text]
spreadPath of
Text
x : [Text]
_ | Text
x forall a. Eq a => a -> a -> Bool
== Text
fragmentName -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = 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 forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
" -> " forall a b. (a -> b) -> a -> b
$ Text
fragmentName forall a. a -> [a] -> [a]
: [Text]
spreadPath
, String
")."
]
, locations :: [Location]
locations = [Location
location']
}
[Text]
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = 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 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 <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a, b) -> b
snd
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Num a => a -> a -> a
+ Int
1)
Int
lastIndex <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a, b) -> a
fst
let newAccumulator :: HashMap Text Int
newAccumulator = 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 = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
fragmentName HashMap Text Int
accumulator
if Text
fragmentName forall a. Eq a => a -> a -> Bool
== Text
firstFragmentName Bool -> Bool -> Bool
|| Bool
inVisitetFragment
then 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 forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> 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 forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Definition -> Maybe FragmentDefinition -> Maybe FragmentDefinition
compareDefinition 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 forall a. Eq a => a -> a -> Bool
== Text
fragmentName = 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 = forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule forall {t :: (* -> *) -> * -> *} {p}.
MonadTrans t =>
p -> Field -> t Seq Error
fieldRule 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
_) =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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
_) =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule
forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy a -> a -> Bool
equalByName forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 = forall a. [a] -> Seq a
Seq.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Error
makeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> [a] -> [[a]]
groupSorted a -> Text
getName
where
getName :: a -> Text
getName = forall a b. (a, b) -> a
fst 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 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [a]
directives'
, locations :: [Location]
locations = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Text, Location)
extract forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
directives'
}
makeMessage :: a -> String
makeMessage a
directive = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"There can be only one "
, String
nodeType
, String
" named \""
, Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst 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 = forall (m :: * -> *). ([VariableDefinition] -> RuleT m) -> Rule m
VariablesRule
forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *). ([VariableDefinition] -> RuleT m) -> Rule m
VariablesRule
forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *} {m :: * -> *}.
(Monad m, Monoid (m Error)) =>
VariableDefinition -> ReaderT (Validation m) m Error
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Seq a
Seq.fromList) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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')
= forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {f :: * -> *}.
Applicative f =>
Text -> Type -> Location -> f Error
makeError Text
name Type
typeName Location
location') (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = 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 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 =
forall (m :: * -> *).
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
variableUsageDifference (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = 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 = 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 = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
_ Location
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
Full.OperationDefinition OperationType
_ Maybe Text
operationName [VariableDefinition]
variables [Directive]
_ SelectionSet
selections Location
_ ->
let variableNames :: HashMap Text [Location]
variableNames = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ VariableDefinition -> (Text, [Location])
getVariableName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VariableDefinition]
variables
in forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall {t :: * -> *}.
Foldable t =>
Maybe Text
-> HashMap Text [Location] -> t (Text, [Location]) -> Seq Error
readerMapper Maybe Text
operationName HashMap Text [Location]
variableNames)
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. HashSet a
HashSet.empty
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *).
Foldable t =>
t Selection -> ValidationState m (Text, [Location])
filterSelections'
forall a b. (a -> b) -> a -> b
$ 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' = forall a. [a] -> Seq a
Seq.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Text -> (Text, [Location]) -> Error
makeError Maybe Text
operationName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UsageDifference
difference HashMap Text [Location]
variableNames'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith forall a. [a] -> [a] -> [a]
(++)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> ValidationState m (Text, [Location])
filterSelections' = forall (t :: * -> *) a (m :: * -> *).
Foldable t =>
(Selection -> ValidationState m a)
-> t Selection -> ValidationState m a
filterSelections Selection -> ValidationState m (Text, [Location])
variableFilter
variableFilter :: Full.Selection -> ValidationState m (Full.Name, [Full.Location])
variableFilter :: Selection -> ValidationState m (Text, [Location])
variableFilter (Full.InlineFragmentSelection InlineFragment
inline)
| Full.InlineFragment Maybe Text
_ [Directive]
directives' SelectionSet
_ Location
_ <- InlineFragment
inline =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [Argument] -> Seq (Text, [Location])
mapArguments [Argument]
arguments 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 <- forall (m :: * -> *).
Text -> ValidationState m (Maybe FragmentDefinition)
visitFragmentDefinition Text
fragmentName
case Maybe FragmentDefinition
nonVisitedFragmentDefinition of
Just FragmentDefinition
fragmentDefinition -> FragmentDefinition -> ValidationState m (Text, [Location])
diveIntoSpread FragmentDefinition
fragmentDefinition
Maybe FragmentDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
diveIntoSpread :: FragmentDefinition -> ValidationState m (Text, [Location])
diveIntoSpread (Full.FragmentDefinition Text
_ Text
_ [Directive]
directives' SelectionSet
selections Location
_)
= forall (t :: * -> *).
Foldable t =>
t Selection -> ValidationState m (Text, [Location])
filterSelections' SelectionSet
selections
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall a. Semigroup a => a -> a -> a
<> [Directive] -> Seq (Text, [Location])
mapDirectives [Directive]
directives') forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [a] -> Seq a
Seq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Argument -> Maybe (Text, [Location])
findArgumentVariables
mapDirectives :: [Directive] -> Seq (Text, [Location])
mapDirectives = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Directive -> Seq (Text, [Location])
findDirectiveVariables
findArgumentVariables :: Argument -> Maybe (Text, [Location])
findArgumentVariables (Full.Argument Text
_ Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Full.Variable Text
value', Location
$sel:location:Node :: forall a. Node a -> Location
location :: Location
..} Location
_) =
forall a. a -> Maybe a
Just (Text
value', [Location
location])
findArgumentVariables Argument
_ = forall a. Maybe a
Nothing
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 = forall (m :: * -> *).
UsageDifference -> (Maybe Text -> Text -> String) -> Rule m
variableUsageDifference 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 = 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 = 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 =
forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Value -> Seq Error
go) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
_) = forall {a}. [ObjectField a] -> Seq Error
filterFieldDuplicates [ObjectField Value]
fields
go Node Value
_ = forall a. Monoid a => a
mempty
filterFieldDuplicates :: [ObjectField a] -> Seq Error
filterFieldDuplicates = forall a. (a -> (Text, Location)) -> String -> [a] -> Seq Error
filterDuplicates 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
_) = forall {a}. [ObjectField a] -> Seq Error
filterFieldDuplicates [ObjectField ConstValue]
fields
constGo Node ConstValue
_ = forall a. Monoid a => a
mempty
fieldsOnCorrectTypeRule :: forall m. Rule m
fieldsOnCorrectTypeRule :: forall (m :: * -> *). Rule m
fieldsOnCorrectTypeRule = forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m) -> Rule m
FieldRule 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 <- forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type m
objectType
, Just Text
typeName <- forall (m :: * -> *). Type m -> Maybe Text
typeNameIfComposite Type m
objectType = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
errorMessage :: Text -> Text -> String
errorMessage Text
fieldName Text
typeName = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *). CompositeType m -> Text
compositeTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite
scalarLeafsRule :: forall m. Rule m
scalarLeafsRule :: forall (m :: * -> *). Rule m
scalarLeafsRule = forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m) -> Rule m
FieldRule 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 <- 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 forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {m :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Type m -> Field -> f Error
check Type m
fieldType Field
selectionField
| Bool
otherwise = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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)
_)) =
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)
_)) =
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]
_)) =
forall {f :: * -> *}.
(Applicative f, Monoid (f Error)) =>
Text -> Field -> f Error
checkNotEmpty Text
typeName
check (Out.ScalarBaseType (Definition.ScalarType Text
typeName Maybe Text
_)) =
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
_)) =
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 forall {f :: * -> *}.
Applicative f =>
Location -> String -> f Error
makeError Location
location' forall a b. (a -> b) -> a -> b
$ 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
_ = forall a. Monoid a => a
mempty
checkEmpty :: Text -> Field -> f Error
checkEmpty Text
_ (Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ [] Location
_) = 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 forall {f :: * -> *}.
Applicative f =>
Location -> String -> f Error
makeError Location
location' forall a b. (a -> b) -> a -> b
$ 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
MonadTrans t =>
Maybe (Type m) -> Field -> t Seq Error
fieldRule 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 <- forall (a :: * -> *). Text -> Type a -> Maybe (Field a)
Type.lookupTypeField Text
fieldName Type m
objectType
, Just Text
typeName <- forall (m :: * -> *). Type m -> Maybe Text
typeNameIfComposite Type m
objectType =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall {m :: * -> *}.
Text -> Text -> Field m -> Argument -> Seq Error -> Seq Error
go Text
typeName Text
fieldName Field m
typeField) forall a. Seq a
Seq.empty [Argument]
arguments
fieldRule Maybe (Type m)
_ Field
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
_ <- 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 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 = 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 <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
Full.Argument Text
argumentName Node Value
_ Location
location' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
argumentName Arguments
definitions ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Location -> Error
makeError Text
argumentName Text
directiveName Location
location'
Maybe Directive
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = 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 = forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ \[Directive]
directives' -> do
HashMap Text Directive
definitions' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
let directiveSet :: HashSet Text
directiveSet = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList 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 = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Directive
definitions'
let difference :: HashSet Text
difference = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet Text
directiveSet HashSet Text
definitionSet
let undefined' :: [Directive]
undefined' = forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Text -> Directive -> Bool
definitionFilter HashSet Text
difference) [Directive]
directives'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ Directive -> Error
makeError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directive]
undefined'
where
definitionFilter :: HashSet Text -> Directive -> Bool
definitionFilter HashSet Text
difference = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member HashSet Text
difference
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' = 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 = forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {a}. InputObjectType -> ObjectField a -> Maybe Error
forEach InputObjectType
objectType) [ObjectField Value]
inputFields
go Maybe Type
_ Node Value
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {a}. InputObjectType -> ObjectField a -> Maybe Error
forEach InputObjectType
objectType) [ObjectField ConstValue]
inputFields
constGo Maybe Type
_ Node ConstValue
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
_ <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
inputFieldName HashMap Text InputField
fieldTypes = forall a. Maybe a
Nothing
| Bool
otherwise
, In.InputObjectType Text
typeName Maybe Text
_ HashMap Text InputField
_ <- InputObjectType
objectType = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = 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 = forall (m :: * -> *).
(DirectiveLocation -> [Directive] -> RuleT m) -> Rule m
DirectivesRule 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList [Directive]
directives'
Maybe Directive
maybeDefinition <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks
forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
case Maybe Directive
maybeDefinition of
Just (Schema.Directive Maybe Text
_ [DirectiveLocation]
allowedLocations Arguments
_)
| DirectiveLocation
directiveLocation forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [DirectiveLocation]
allowedLocations -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = forall {a}. Show a => Text -> a -> String
errorMessage Text
directiveName DirectiveLocation
directiveLocation
, locations :: [Location]
locations = [Location
location]
}
Maybe Directive
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
errorMessage :: Text -> a -> String
errorMessage Text
directiveName a
directiveLocation = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Directive \"@"
, Text -> String
Text.unpack Text
directiveName
, String
"\" may not be used on "
, forall a. Show a => a -> String
show a
directiveLocation
, String
"."
]
providedRequiredArgumentsRule :: Rule m
providedRequiredArgumentsRule :: forall (m :: * -> *). Rule m
providedRequiredArgumentsRule = forall (m :: * -> *).
(Maybe (Type m) -> Field -> RuleT m)
-> (Directive -> RuleT m) -> Rule m
ArgumentsRule forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
MonadTrans t =>
Maybe (Type m) -> Field -> t Seq Error
fieldRule 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 <- 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 = 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 forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> Argument -> Seq Error -> Seq Error
forEach forall a. Seq a
Seq.empty Arguments
definitions
fieldRule Maybe (Type a)
_ Field
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks
forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
directiveName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Text -> Argument -> Seq Error -> Seq Error
forEach forall a. Seq a
Seq.empty Arguments
definitions
Maybe Directive
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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'
, forall a. Maybe a -> Bool
isNothing Maybe Value
optionalValue
, Maybe Argument -> Bool
isNothingOrNull forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Argument -> Bool
lookupArgument Text
argumentName) t Argument
arguments
= Seq Error
errors
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 = 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 forall a. Eq a => a -> a -> Bool
== Text
argumentName
fieldMessage :: Text -> Text -> Text -> String
fieldMessage Text
fieldName Text
argumentName Text
typeName = 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 = 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 = forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go 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
= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Seq a
Seq.fromList
forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
HashMap.elems
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapMaybeWithKey HashMap Text InputField
fieldDefinitions
forall a b. (a -> b) -> a -> b
$ 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
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
constGo :: p -> p -> t m a
constGo p
_ p
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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
, forall a. Maybe a -> Bool
isNothing Maybe Value
optionalValue
, Maybe (ObjectField Value) -> Bool
isNothingOrNull forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall {a}. Text -> ObjectField a -> Bool
lookupField Text
definitionName) t (ObjectField Value)
inputFields =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text -> Location -> Error
makeError Text
definitionName Text
typeName Location
location'
| Bool
otherwise = 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 = 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 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 = 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 = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.SelectionSet SelectionSet
selectionSet Location
_ -> do
Schema m
schema' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Schema m
schema
forall {m :: * -> *}.
SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
forall a b. (a -> b) -> a -> b
$ 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Schema m
schema
let root :: ObjectType m -> ReaderT (Validation m) Seq Error
root = forall {m :: * -> *}.
SelectionSetOpt
-> CompositeType m -> ReaderT (Validation m) Seq Error
go (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
case OperationType
operationType of
OperationType
Full.Query -> forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
OperationType
Full.Mutation
| Just ObjectType m
objectType <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root ObjectType m
objectType
OperationType
Full.Subscription
| Just ObjectType m
objectType <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> forall {m :: * -> *}.
ObjectType m -> ReaderT (Validation m) Seq Error
root ObjectType m
objectType
OperationType
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall {m :: * -> *}.
CompositeType m
-> SelectionSetOpt
-> StateT
(HashSet Text)
(ReaderT (Validation m) Seq)
(HashMap Text (NonEmpty (Field, CompositeType m)))
collectFields CompositeType m
selectionType SelectionSetOpt
selectionSet) forall a. HashSet a
HashSet.empty
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 <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let (Seq (FieldInfo m)
lonely, Seq (FieldInfo m, FieldInfo m)
paired) = 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Validation m
validation
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {m :: * -> *} {a}. ReaderT (Validation m) m a -> m a
reader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}.
FieldInfo m -> ReaderT (Validation m) Seq Error
visitLonelyFields) Seq (FieldInfo m)
lonely
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {m :: * -> *} {a}. ReaderT (Validation m) m a -> m a
reader forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall (m :: * -> *). FieldInfo m -> CompositeType m
parent FieldInfo m
fieldA, 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 forall a. Eq a => a -> a -> Bool
/= CompositeType m
parentB -> forall (m :: * -> *).
FieldInfo m -> FieldInfo m -> ReaderT (Validation m) Seq Error
sameResponseShape FieldInfo m
fieldA FieldInfo m
fieldB
(CompositeType m, CompositeType m)
_ -> 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 (forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA) (forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldB))
forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
/= Text
fieldNameB = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a. Eq a => a -> a -> Bool
/= [Argument]
argumentsB =
let message :: String
message = 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
type' :: forall (m :: * -> *). FieldInfo m -> Type m
parent :: CompositeType m
type' :: Type m
node :: Field
node :: forall (m :: * -> *). FieldInfo m -> Field
parent :: forall (m :: * -> *). FieldInfo m -> CompositeType m
..} =
let Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
subSelections Location
_ = Field
node
compositeFieldType :: Maybe (CompositeType m)
compositeFieldType = forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
type'
in forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Seq a
Seq.empty) (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
_ = forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA
Full.Field Maybe Text
_ Text
_ [Argument]
_ [Directive]
_ SelectionSetOpt
selectionsB Location
_ = forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldB
in case forall {a :: * -> *}.
Type a -> Type a -> Either Bool (CompositeType a, CompositeType a)
unwrapTypes (forall (m :: * -> *). FieldInfo m -> Type m
type' FieldInfo m
fieldA) (forall (m :: * -> *). FieldInfo m -> Type m
type' FieldInfo m
fieldB) of
Left Bool
True -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
Right (CompositeType m
compositeA, CompositeType m
compositeB) -> do
Validation m
validation <- 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Validation m
validation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. HashSet a
HashSet.empty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall (m :: * -> *).
HashMap Text (NonEmpty (Field, CompositeType m))
-> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith forall a. Semigroup a => a -> a -> a
(<>)) forall k v. HashMap k v
HashMap.empty
forall a b. (a -> b) -> a -> b
$ Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectA forall a. Semigroup a => a -> a -> a
<> Seq (HashMap Text (NonEmpty (Field, CompositeType m)))
collectB
Either Bool (CompositeType m, CompositeType m)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Field -> Field -> Error
makeError (forall (m :: * -> *). FieldInfo m -> Field
node FieldInfo m
fieldA) (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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Fields \""
, Text -> String
Text.unpack (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{} =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Type a
typeA forall a. Eq a => a -> a -> Bool
== Type a
typeB
unwrapTypes typeA :: Type a
typeA@Out.EnumBaseType{} typeB :: Type a
typeB@Out.EnumBaseType{} =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Type a
typeA 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
| forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type a
typeA forall a. Eq a => a -> a -> Bool
== forall (m :: * -> *). Type m -> Bool
Out.isNonNullType Type a
typeB
, Just CompositeType a
compositeA <- forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type a
typeA
, Just CompositeType a
compositeB <- forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type a
typeB =
forall a b. b -> Either a b
Right (CompositeType a
compositeA, CompositeType a
compositeB)
| Bool
otherwise = 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 = forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldr forall (m :: * -> *).
[FieldInfo m]
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
-> (Seq (FieldInfo m), Seq (FieldInfo m, FieldInfo m))
splitSingleFields (forall a. Seq a
Seq.empty, forall a. Seq a
Seq.empty)
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *}.
(Field, CompositeType m) -> [FieldInfo m] -> [FieldInfo m]
lookupTypeField [] 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 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, 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 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
_) ->
forall (m :: * -> *).
Field -> Type m -> CompositeType m -> FieldInfo m
FieldInfo Field
field Type m
typeField CompositeType m
parentType 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) =
forall {a} {b}. a -> Seq (a, b) -> [b] -> Seq (a, b)
pair FieldInfo m
fieldA (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 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 = 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 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 = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM 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 ->
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 = forall a. a -> Maybe a -> a
fromMaybe Text
fieldName Maybe Text
alias
value :: NonEmpty (Field, p)
value = (Field
field, p
parentType) forall a. a -> [a] -> NonEmpty a
:| []
in forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith 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 <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName
if Bool
inVisitetFragments
then 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 forall a b. (a -> b) -> a -> b
$ 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' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
case forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types' of
Maybe (CompositeType m)
Nothing -> 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 forall a b. (a -> b) -> a -> b
$ 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
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName
Document
ast' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
case Text -> Document -> Maybe FragmentDefinition
findFragmentDefinition Text
fragmentName Document
ast' of
Maybe FragmentDefinition
Nothing -> 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 = forall (m :: * -> *).
(Maybe (Type m) -> Selection -> RuleT m) -> Rule m
SelectionRule 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) <-
forall {m :: * -> *}.
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
compareTypes Text
typeCondition Type m
parentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = 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 <- forall (m1 :: * -> *). Text -> ReaderT (Validation m1) Seq Text
findSpreadTarget Text
fragmentName
(Text
fragmentTypeName, Text
parentTypeName) <-
forall {m :: * -> *}.
Text -> Type m -> ReaderT (Validation m) Seq (Text, Text)
compareTypes Text
typeCondition Type m
parentType
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = 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
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
CompositeType m
fragmentType <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Seq a
maybeToSeq
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition Text
typeCondition HashMap Text (Type m)
types'
CompositeType m
parentComposite <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Seq a
maybeToSeq
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
parentType
HashSet Text
possibleFragments <- forall {m :: * -> *} {m :: * -> *}.
Monad m =>
CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
fragmentType
HashSet Text
possibleParents <- forall {m :: * -> *} {m :: * -> *}.
Monad m =>
CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
parentComposite
let fragmentTypeName :: Text
fragmentTypeName = forall (m :: * -> *). CompositeType m -> Text
compositeTypeName CompositeType m
fragmentType
let parentTypeName :: Text
parentTypeName = forall (m :: * -> *). CompositeType m -> Text
compositeTypeName CompositeType m
parentComposite
if forall a. HashSet a -> Bool
HashSet.null forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.intersection HashSet Text
possibleFragments HashSet Text
possibleParents
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
fragmentTypeName, Text
parentTypeName)
else forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
getPossibleTypeList :: CompositeType m -> ReaderT (Validation m) m [Type m]
getPossibleTypeList (Type.CompositeObjectType ObjectType m
objectType) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure [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 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ObjectType m -> Type m
Schema.ObjectType 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 forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault [] Text
typeName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall (m :: * -> *). Schema m -> HashMap Text [Type m]
Schema.implementations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema)
getPossibleTypes :: CompositeType m -> ReaderT (Validation m) m (HashSet Text)
getPossibleTypes CompositeType m
compositeType
= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Type m -> Text
internalTypeName) forall a. HashSet a
HashSet.empty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
let target :: Maybe Definition
target = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Definition -> Bool
isSpreadTarget Text
fragmentName) Document
ast'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Seq a
maybeToSeq forall a b. (a -> b) -> a -> b
$ Maybe Definition
target 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 forall a. a -> Maybe a
Just Text
typeCondition
extractTypeCondition Definition
_ = 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Document
ast
Bool
visited <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
fragmentName)
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert Text
fragmentName)
case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just FragmentDefinition
fragmentDefinition
Maybe Definition
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
variablesInAllowedPositionRule :: forall m. Rule m
variablesInAllowedPositionRule :: forall (m :: * -> *). Rule m
variablesInAllowedPositionRule = forall (m :: * -> *). (OperationDefinition -> RuleT m) -> Rule m
OperationDefinitionRule forall a b. (a -> b) -> a -> b
$ \case
Full.OperationDefinition OperationType
operationType Maybe Text
_ [VariableDefinition]
variables [Directive]
_ SelectionSet
selectionSet Location
_ -> do
Schema m
schema' <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall (m :: * -> *). Validation m -> Schema m
schema
let root :: ObjectType m -> RuleT m
root = forall {t :: * -> *}.
Foldable t =>
[VariableDefinition] -> t Selection -> CompositeType m -> RuleT m
go [VariableDefinition]
variables (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet
selectionSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ObjectType m -> CompositeType m
Type.CompositeObjectType
case OperationType
operationType of
OperationType
Full.Query -> ObjectType m -> RuleT m
root forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> ObjectType m
Schema.query Schema m
schema'
OperationType
Full.Mutation
| Just ObjectType m
objectType <- 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 <- forall (m :: * -> *). Schema m -> Maybe (ObjectType m)
Schema.mutation Schema m
schema' -> ObjectType m -> RuleT m
root ObjectType m
objectType
OperationType
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
OperationDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
where
go :: [VariableDefinition] -> t Selection -> CompositeType m -> RuleT m
go [VariableDefinition]
variables t Selection
selections CompositeType m
selectionType = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Semigroup a => a -> a -> a
(<>) forall a. Seq a
Seq.empty)
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. HashSet a
HashSet.empty
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *).
Foldable t =>
[VariableDefinition]
-> CompositeType m -> t Selection -> ValidationState m (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
selectionType
forall a b. (a -> b) -> a -> b
$ 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 -> ValidationState m (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
selectionType =
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
-> ValidationState m (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
selectionType) forall a. Monoid a => a
mempty
evaluateFieldSelection :: [VariableDefinition]
-> t Selection
-> Seq Error
-> Maybe (CompositeType m)
-> ValidationState m (Seq Error)
evaluateFieldSelection [VariableDefinition]
variables t Selection
selections Seq Error
accumulator = \case
Just CompositeType m
newParentType -> do
let folder :: Seq Error -> Selection -> ValidationState m (Seq Error)
folder = [VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> ValidationState m (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
newParentType
Seq Error
selectionErrors <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Error -> Selection -> ValidationState m (Seq Error)
folder Seq Error
accumulator t Selection
selections
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
Maybe (CompositeType m)
Nothing -> 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
-> ValidationState m (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' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
Maybe FragmentDefinition
nonVisitedFragmentDefinition <- 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 <- 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 -> ValidationState m (Seq Error)
spreadVariables [VariableDefinition]
variables FragmentSpread
spread
Seq Error
selectionErrors <- [VariableDefinition]
-> CompositeType m
-> FragmentDefinition
-> ValidationState m (Seq Error)
diveIntoSpread [VariableDefinition]
variables CompositeType m
spreadType FragmentDefinition
fragmentDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator forall a. Semigroup a => a -> a -> a
<> Seq Error
spreadErrors forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
Maybe FragmentDefinition
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 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 -> ValidationState m (Seq Error)
fieldVariables [VariableDefinition]
variables Arguments
argumentTypes Field
fieldSelection
Seq Error
selectionErrors <- forall {t :: * -> *}.
Foldable t =>
[VariableDefinition]
-> t Selection
-> Seq Error
-> Maybe (CompositeType m)
-> ValidationState m (Seq Error)
evaluateFieldSelection [VariableDefinition]
variables SelectionSetOpt
subselections Seq Error
accumulator
forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *). Type a -> Maybe (CompositeType a)
Type.outToComposite Type m
typeField
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
selectionErrors forall a. Semigroup a => a -> a -> a
<> Seq Error
fieldErrors
Maybe (Field m)
Nothing -> 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' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text (Type m)
Schema.types forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
let inlineType :: CompositeType m
inlineType = forall a. a -> Maybe a -> a
fromMaybe CompositeType m
selectionType
forall a b. (a -> b) -> a -> b
$ Maybe Text
typeCondition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *).
Text -> HashMap Text (Type m) -> Maybe (CompositeType m)
Type.lookupTypeCondition HashMap Text (Type m)
types'
Seq Error
fragmentErrors <- [VariableDefinition]
-> InlineFragment -> ValidationState m (Seq Error)
inlineVariables [VariableDefinition]
variables InlineFragment
inlineSelection
let folder :: Seq Error -> Selection -> ValidationState m (Seq Error)
folder = [VariableDefinition]
-> CompositeType m
-> Seq Error
-> Selection
-> ValidationState m (Seq Error)
evaluateSelection [VariableDefinition]
variables CompositeType m
inlineType
Seq Error
selectionErrors <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Error -> Selection -> ValidationState m (Seq Error)
folder Seq Error
accumulator SelectionSet
subselections
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
accumulator forall a. Semigroup a => a -> a -> a
<> Seq Error
fragmentErrors forall a. Semigroup a => a -> a -> a
<> Seq Error
selectionErrors
inlineVariables :: [VariableDefinition]
-> InlineFragment -> ValidationState m (Seq Error)
inlineVariables [VariableDefinition]
variables InlineFragment
inline
| Full.InlineFragment Maybe Text
_ [Directive]
directives' SelectionSet
_ Location
_ <- InlineFragment
inline =
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive -> ValidationState m (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
fieldVariables :: [Full.VariableDefinition]
-> In.Arguments
-> Full.Field
-> ValidationState m (Seq Error)
fieldVariables :: [VariableDefinition]
-> Arguments -> Field -> ValidationState m (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 <- forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> Arguments -> t Argument -> ValidationState m (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
argumentTypes [Argument]
arguments
Seq Error
directiveErrors <- forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive -> ValidationState m (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
argumentErrors forall a. Semigroup a => a -> a -> a
<> Seq Error
directiveErrors
spreadVariables :: [VariableDefinition]
-> FragmentSpread -> ValidationState m (Seq Error)
spreadVariables [VariableDefinition]
variables (Full.FragmentSpread Text
_ [Directive]
directives' Location
_) =
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive -> ValidationState m (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
diveIntoSpread :: [VariableDefinition]
-> CompositeType m
-> FragmentDefinition
-> ValidationState m (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 <- forall (t :: * -> *).
Foldable t =>
[VariableDefinition]
-> CompositeType m -> t Selection -> ValidationState m (Seq Error)
visitSelectionSet [VariableDefinition]
variables CompositeType m
fieldType SelectionSet
selections
Seq Error
directiveErrors <- forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> t Directive -> ValidationState m (Seq Error)
mapDirectives [VariableDefinition]
variables [Directive]
directives'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Error
selectionErrors forall a. Semigroup a => a -> a -> a
<> Seq Error
directiveErrors
findDirectiveVariables :: [VariableDefinition] -> Directive -> ValidationState m (Seq Error)
findDirectiveVariables [VariableDefinition]
variables Directive
directive = do
let Full.Directive Text
directiveName [Argument]
arguments Location
_ = Directive
directive
HashMap Text Directive
directiveDefinitions <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Schema m -> HashMap Text Directive
Schema.directives forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Validation m -> Schema m
schema
case 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) ->
forall {t :: * -> *}.
Traversable t =>
[VariableDefinition]
-> Arguments -> t Argument -> ValidationState m (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
directiveArguments [Argument]
arguments
Maybe Directive
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
mapArguments :: [VariableDefinition]
-> Arguments -> t Argument -> ValidationState m (Seq Error)
mapArguments [VariableDefinition]
variables Arguments
argumentTypes = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([VariableDefinition]
-> Arguments -> Argument -> ValidationState m (Seq Error)
findArgumentVariables [VariableDefinition]
variables Arguments
argumentTypes)
mapDirectives :: [VariableDefinition]
-> t Directive -> ValidationState m (Seq Error)
mapDirectives [VariableDefinition]
variables = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([VariableDefinition] -> Directive -> ValidationState m (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 =
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find VariableDefinition -> Bool
findVariableDefinition' t VariableDefinition
variables
= forall a. Maybe a -> Seq a
maybeToSeq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *} {a}.
Applicative f =>
Type -> Maybe a -> VariableDefinition -> f (Maybe Error)
isVariableUsageAllowed Type
locationType Maybe a
locationValue VariableDefinition
variableDefinition
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
findArgumentVariables :: [Full.VariableDefinition]
-> HashMap Full.Name In.Argument
-> Full.Argument
-> ValidationState m (Seq Error)
findArgumentVariables :: [VariableDefinition]
-> Arguments -> Argument -> ValidationState m (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
= forall {t :: * -> *} {f :: * -> *} {a}.
(Foldable t, Applicative f) =>
Text
-> t VariableDefinition -> Maybe (Type, Maybe a) -> f (Seq Error)
maybeUsageAllowed Text
variableName [VariableDefinition]
variables
forall a b. (a -> b) -> a -> b
$ 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
= forall {f :: * -> *} {t :: * -> *}.
(Applicative f, Foldable t) =>
t VariableDefinition
-> Node Value -> Maybe (Type, Maybe Value) -> f (Seq Error)
lookupInputObject [VariableDefinition]
variables Node Value
argumentValue
forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:name:ObjectField :: forall a. ObjectField a -> Text
location :: Location
value :: Node Value
name :: Text
..}
| Full.Node{ $sel:node:Node :: forall a. Node a -> a
node = Full.Variable Text
variableName } <- Node Value
value
= forall {t :: * -> *} {f :: * -> *} {a}.
(Foldable t, Applicative f) =>
Text
-> t VariableDefinition -> Maybe (Type, Maybe a) -> f (Seq Error)
maybeUsageAllowed Text
variableName t VariableDefinition
variables
forall a b. (a -> b) -> a -> b
$ 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
forall a b. (a -> b) -> a -> b
$ 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 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 =
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 <- 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => VariableDefinition -> a -> Maybe Error
makeError VariableDefinition
variableDefinition Type
locationType
| Bool
otherwise = 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 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 forall a b. (a -> b) -> a -> b
$ Type -> Bool
In.isNonNullType Type
locationType =
Text
typeNamed 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 forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Variable \"$"
, Text -> String
Text.unpack Text
variableName
, String
"\" of type \""
, forall a. Show a => a -> String
show Type
variableType
, String
"\" used in position expecting type \""
, 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) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ScalarType -> Type
In.NamedScalarType ScalarType
nonNullType
unwrapInType (In.NonNullEnumType EnumType
nonNullType) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EnumType -> Type
In.NamedEnumType EnumType
nonNullType
unwrapInType (In.NonNullInputObjectType InputObjectType
nonNullType) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ InputObjectType -> Type
In.NamedInputObjectType InputObjectType
nonNullType
unwrapInType (In.NonNullListType Type
nonNullType) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Type -> Type
In.ListType Type
nonNullType
unwrapInType Type
_ = forall a. Maybe a
Nothing
valuesOfCorrectTypeRule :: forall m. Rule m
valuesOfCorrectTypeRule :: forall (m :: * -> *). Rule m
valuesOfCorrectTypeRule = forall (m :: * -> *).
(Maybe Type -> Node Value -> RuleT m)
-> (Maybe Type -> Node ConstValue -> RuleT m) -> Rule m
ValueRule forall {t :: (* -> *) -> * -> *}.
MonadTrans t =>
Maybe Type -> Node Value -> t Seq Error
go 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 =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Type -> Node ConstValue -> Seq Error
check Type
inputType Node ConstValue
constValue
go Maybe Type
_ Node Value
_ = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
toConstNode :: Node Value -> Maybe (Node ConstValue)
toConstNode Full.Node{Value
Location
location :: Location
node :: Value
$sel:location:Node :: forall a. Node a -> Location
$sel:node:Node :: forall a. Node a -> a
..} = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Location -> Node a
Full.Node Location
location 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
_) = forall a. Maybe a
Nothing
toConst (Full.Int Int32
integer) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int32 -> ConstValue
Full.ConstInt Int32
integer
toConst (Full.Float Double
double) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> ConstValue
Full.ConstFloat Double
double
toConst (Full.String Text
string) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ConstValue
Full.ConstString Text
string
toConst (Full.Boolean Bool
boolean) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool -> ConstValue
Full.ConstBoolean Bool
boolean
toConst Value
Full.Null = forall a. a -> Maybe a
Just ConstValue
Full.ConstNull
toConst (Full.Enum Text
enum) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ConstValue
Full.ConstEnum Text
enum
toConst (Full.List [Node Value]
values) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Node ConstValue] -> ConstValue
Full.ConstList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node Value -> Maybe (Node ConstValue)
toConstNode [Node Value]
values
toConst (Full.Object [ObjectField Value]
fields) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [ObjectField ConstValue] -> ConstValue
Full.ConstObject
forall a b. (a -> b) -> a -> b
$ 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
location :: Location
value :: Node Value
name :: Text
$sel:location:ObjectField :: forall a. ObjectField a -> Location
$sel:value:ObjectField :: forall a. ObjectField a -> Node a
$sel:name:ObjectField :: forall a. ObjectField a -> Text
..}
| Just Node ConstValue
constValue <- Node Value -> Maybe (Node ConstValue)
toConstNode Node Value
value =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Node a -> Location -> ObjectField a
Full.ObjectField Text
name Node ConstValue
constValue Location
location
| Bool
otherwise = forall a. Maybe a
Nothing
constGo :: Maybe Type -> Node ConstValue -> t Seq Error
constGo Maybe Type
Nothing = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a. Monoid a => a
mempty
constGo (Just Type
inputType) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 } =
forall a. Monoid a => a
mempty
check (In.ScalarBaseType ScalarType
scalarType) Full.Node{ ConstValue
node :: ConstValue
$sel:node:Node :: forall a. Node a -> a
node }
| Definition.ScalarType Text
"Int" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Boolean" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstBoolean Bool
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"String" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstString Text
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"ID" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstString Text
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"ID" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Float" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstFloat Double
_ <- ConstValue
node = forall a. Monoid a => a
mempty
| Definition.ScalarType Text
"Float" Maybe Text
_ <- ScalarType
scalarType
, Full.ConstInt Int32
_ <- ConstValue
node = forall a. Monoid a => a
mempty
check (In.EnumBaseType EnumType
enumType) Full.Node{ ConstValue
node :: ConstValue
$sel:node:Node :: forall a. Node a -> a
node }
| Definition.EnumType Text
_ Maybe Text
_ HashMap Text EnumValue
members <- EnumType
enumType
, Full.ConstEnum Text
memberValue <- ConstValue
node
, forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
memberValue HashMap Text EnumValue
members = forall a. Monoid a => a
mempty
check (In.InputObjectBaseType InputObjectType
objectType) Full.Node{ ConstValue
node :: ConstValue
$sel:node:Node :: forall a. Node a -> a
node }
| In.InputObjectType{} <- InputObjectType
objectType
, Full.ConstObject{} <- ConstValue
node = forall a. Monoid a => a
mempty
check (In.ListBaseType Type
listType) constValue :: Node ConstValue
constValue@Full.Node{ ConstValue
Location
location :: Location
node :: ConstValue
$sel:location:Node :: forall a. Node a -> Location
$sel:node:Node :: forall a. Node a -> a
.. }
| Full.ConstList [Node ConstValue]
values <- ConstValue
node =
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
location :: Location
node :: ConstValue
$sel:location:Node :: forall a. Node a -> Location
$sel:node:Node :: forall a. Node a -> a
.. } = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Value "
, forall a. Show a => a -> String
show ConstValue
node
, String
" cannot be coerced to type \""
, 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 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
location :: Location
$sel:location:Node :: forall a. Node a -> Location
.. } <- Node ConstValue
constValue ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Error
{ message :: String
message = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"List of non-null values of type \""
, forall a. Show a => a -> String
show Type
unwrappedType
, String
"\" cannot contain null values."
]
, locations :: [Location]
locations = [Location
location]
}
| Bool
otherwise -> forall a. Monoid a => a
mempty
Bool
_ -> Seq Error
checkResult