Collect types once the schema is created

1 files changed, 158 insertions, 145 deletions

diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index 11f4482..b794b64 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -55,16 +55,17 @@ import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Language.GraphQL.AST.Document
+import qualified Language.GraphQL.AST.Document as Full
 import qualified Language.GraphQL.Type.Definition as Definition
-import Language.GraphQL.Type.Internal
+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
 
 -- Local help type that contains a hash set to track visited fragments.
-type ValidationState m a = StateT (HashSet Name) (ReaderT (Validation m) Seq) a
+type ValidationState m a =
+    StateT (HashSet Full.Name) (ReaderT (Validation m) Seq) a
 
 -- | Default rules given in the specification.
 specifiedRules :: forall m. [Rule m]
@@ -107,9 +108,9 @@ specifiedRules =
 -- | Definition must be OperationDefinition or FragmentDefinition.
 executableDefinitionsRule :: forall m. Rule m
 executableDefinitionsRule = DefinitionRule $ \case
-    ExecutableDefinition _ -> lift mempty
-    TypeSystemDefinition _ location' -> pure $ error' location'
-    TypeSystemExtension _ location' -> pure $ error' location'
+    Full.ExecutableDefinition _ -> lift mempty
+    Full.TypeSystemDefinition _ location' -> pure $ error' location'
+    Full.TypeSystemExtension _ location' -> pure $ error' location'
   where
     error' location' = Error
         { message =
@@ -120,7 +121,7 @@ executableDefinitionsRule = DefinitionRule $ \case
 -- | Subscription operations must have exactly one root field.
 singleFieldSubscriptionsRule :: forall m. Rule m
 singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
-    OperationDefinition Subscription name' _ _ rootFields location' -> do
+    Full.OperationDefinition Full.Subscription name' _ _ rootFields location' -> do
         groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty
         case HashSet.size groupedFieldSet of
             1 -> lift mempty
@@ -143,46 +144,46 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
         "Anonymous Subscription must select only one top level field."
     collectFields selectionSet = foldM forEach HashSet.empty selectionSet
     forEach accumulator = \case
-        FieldSelection fieldSelection -> forField accumulator fieldSelection
-        FragmentSpreadSelection fragmentSelection ->
+        Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
+        Full.FragmentSpreadSelection fragmentSelection ->
             forSpread accumulator fragmentSelection
-        InlineFragmentSelection fragmentSelection ->
+        Full.InlineFragmentSelection fragmentSelection ->
             forInline accumulator fragmentSelection
-    forField accumulator (Field alias name _ directives' _ _)
+    forField accumulator (Full.Field alias name _ directives' _ _)
         | any skip directives' = pure accumulator
         | Just aliasedName <- alias = pure
             $ HashSet.insert aliasedName accumulator
         | otherwise = pure $ HashSet.insert name accumulator
-    forSpread accumulator (FragmentSpread fragmentName directives' _)
+    forSpread accumulator (Full.FragmentSpread fragmentName directives' _)
         | any skip directives' = pure accumulator
         | otherwise = do
             inVisitetFragments <- gets $ HashSet.member fragmentName
             if inVisitetFragments
                then pure accumulator
                else collectFromSpread fragmentName accumulator
-    forInline accumulator (InlineFragment maybeType directives' selections _)
+    forInline accumulator (Full.InlineFragment maybeType directives' selections _)
         | any skip directives' = pure accumulator
         | Just typeCondition <- maybeType =
             collectFromFragment typeCondition selections accumulator
         | otherwise = HashSet.union accumulator
             <$> collectFields selections
-    skip (Directive "skip" [Argument "if" (Node argumentValue _) _] _) =
-        Boolean True == argumentValue
-    skip (Directive "include" [Argument "if" (Node argumentValue _) _] _) =
-        Boolean False == argumentValue
+    skip (Full.Directive "skip" [Full.Argument "if" (Full.Node argumentValue _) _] _) =
+        Full.Boolean True == argumentValue
+    skip (Full.Directive "include" [Full.Argument "if" (Full.Node argumentValue _) _] _) =
+        Full.Boolean False == argumentValue
     skip _ = False
-    findFragmentDefinition (ExecutableDefinition executableDefinition) Nothing
-        | DefinitionFragment fragmentDefinition <- executableDefinition =
+    findFragmentDefinition (Full.ExecutableDefinition executableDefinition) Nothing
+        | Full.DefinitionFragment fragmentDefinition <- executableDefinition =
             Just fragmentDefinition
     findFragmentDefinition _ accumulator = accumulator
     collectFromFragment typeCondition selectionSet accumulator = do
-        types' <- lift $ asks types
+        types' <- lift $ asks $ Schema.types . schema
         schema' <- lift $ asks schema
-        case lookupTypeCondition typeCondition types' of
+        case Type.lookupTypeCondition typeCondition types' of
             Nothing -> pure accumulator
             Just compositeType
                 | Just objectType <- Schema.subscription schema'
-                , True <- doesFragmentTypeApply compositeType objectType ->
+                , True <- Type.doesFragmentTypeApply compositeType objectType ->
                     HashSet.union accumulator <$> collectFields selectionSet
                 | otherwise -> pure accumulator
     collectFromSpread fragmentName accumulator = do
@@ -190,15 +191,16 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
         ast' <- lift $ asks ast
         case foldr findFragmentDefinition Nothing ast' of
             Nothing -> pure accumulator
-            Just (FragmentDefinition _ typeCondition _ selectionSet _) ->
+            Just (Full.FragmentDefinition _ typeCondition _ selectionSet _) ->
                 collectFromFragment typeCondition selectionSet accumulator
 
 -- | GraphQL allows a short‐hand form for defining query operations when only
 -- that one operation exists in the document.
 loneAnonymousOperationRule :: forall m. Rule m
 loneAnonymousOperationRule = OperationDefinitionRule $ \case
-      SelectionSet _ thisLocation -> check thisLocation
-      OperationDefinition _ Nothing _ _ _ thisLocation -> check thisLocation
+      Full.SelectionSet _ thisLocation -> check thisLocation
+      Full.OperationDefinition _ Nothing _ _ _ thisLocation ->
+          check thisLocation
       _ -> lift mempty
     where
       check thisLocation = asks ast
@@ -208,9 +210,9 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case
               compareAnonymousOperations thisLocation operationDefinition
       filterAnonymousOperations _ _ accumulator = accumulator
       compareAnonymousOperations thisLocation = \case
-          OperationDefinition _ _ _ _ _ thatLocation
+          Full.OperationDefinition _ _ _ _ _ thatLocation
               | thisLocation /= thatLocation -> pure $ error' thisLocation
-          SelectionSet _ thatLocation
+          Full.SelectionSet _ thatLocation
               | thisLocation /= thatLocation -> pure $ error' thisLocation
           _ -> mempty
       error' location' = Error
@@ -223,7 +225,7 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case
 -- referred to by its name.
 uniqueOperationNamesRule :: forall m. Rule m
 uniqueOperationNamesRule = OperationDefinitionRule $ \case
-    OperationDefinition _ (Just thisName) _ _ _ thisLocation ->
+    Full.OperationDefinition _ (Just thisName) _ _ _ thisLocation ->
         findDuplicates (filterByName thisName) thisLocation (error' thisName)
     _ -> lift mempty
   where
@@ -234,12 +236,12 @@ uniqueOperationNamesRule = OperationDefinitionRule $ \case
         ]
     filterByName thisName definition' accumulator
         | (viewOperation -> Just operationDefinition) <- definition'
-        , OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition
+        , Full.OperationDefinition _ (Just thatName) _ _ _ thatLocation <- operationDefinition
         , thisName == thatName = thatLocation : accumulator
         | otherwise = accumulator
 
-findDuplicates :: (Definition -> [Location] -> [Location])
-    -> Location
+findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
+    -> Full.Location
     -> String
     -> RuleT m
 findDuplicates filterByName thisLocation errorMessage = do
@@ -254,17 +256,17 @@ findDuplicates filterByName thisLocation errorMessage = do
         , locations = locations'
         }
 
-viewOperation :: Definition -> Maybe OperationDefinition
+viewOperation :: Full.Definition -> Maybe Full.OperationDefinition
 viewOperation definition
-    | ExecutableDefinition executableDefinition <- definition
-    , DefinitionOperation operationDefinition <- executableDefinition =
+    | Full.ExecutableDefinition executableDefinition <- definition
+    , Full.DefinitionOperation operationDefinition <- executableDefinition =
         Just operationDefinition
 viewOperation _ = Nothing
 
-viewFragment :: Definition -> Maybe FragmentDefinition
+viewFragment :: Full.Definition -> Maybe Full.FragmentDefinition
 viewFragment definition
-    | ExecutableDefinition executableDefinition <- definition
-    , DefinitionFragment fragmentDefinition <- executableDefinition =
+    | Full.ExecutableDefinition executableDefinition <- definition
+    , Full.DefinitionFragment fragmentDefinition <- executableDefinition =
         Just fragmentDefinition
 viewFragment _ = Nothing
 
@@ -275,7 +277,7 @@ viewFragment _ = Nothing
 -- by this validation rule.
 uniqueFragmentNamesRule :: forall m. Rule m
 uniqueFragmentNamesRule = FragmentDefinitionRule $ \case
-    FragmentDefinition thisName _ _ _ thisLocation ->
+    Full.FragmentDefinition thisName _ _ _ thisLocation ->
         findDuplicates (filterByName thisName) thisLocation (error' thisName)
   where
     error' fragmentName = concat
@@ -285,7 +287,7 @@ uniqueFragmentNamesRule = FragmentDefinitionRule $ \case
         ]
     filterByName thisName definition accumulator
         | Just fragmentDefinition <- viewFragment definition
-        , FragmentDefinition thatName _ _ _ thatLocation <- fragmentDefinition
+        , Full.FragmentDefinition thatName _ _ _ thatLocation <- fragmentDefinition
         , thisName == thatName = thatLocation : accumulator
         | otherwise = accumulator
 
@@ -293,7 +295,7 @@ uniqueFragmentNamesRule = FragmentDefinitionRule $ \case
 -- It is a validation error if the target of a spread is not defined.
 fragmentSpreadTargetDefinedRule :: forall m. Rule m
 fragmentSpreadTargetDefinedRule = FragmentSpreadRule $ \case
-    FragmentSpread fragmentName _ location' -> do
+    Full.FragmentSpread fragmentName _ location' -> do
         ast' <- asks ast
         case find (isSpreadTarget fragmentName) ast' of
             Nothing -> pure $ Error
@@ -308,9 +310,9 @@ fragmentSpreadTargetDefinedRule = FragmentSpreadRule $ \case
         , "\" is undefined."
         ]
 
-isSpreadTarget :: Text -> Definition -> Bool
+isSpreadTarget :: Text -> Full.Definition -> Bool
 isSpreadTarget thisName (viewFragment -> Just fragmentDefinition)
-    | FragmentDefinition thatName _ _ _ _ <- fragmentDefinition
+    | Full.FragmentDefinition thatName _ _ _ _ <- fragmentDefinition
     , thisName == thatName = True
 isSpreadTarget _ _ = False
 
@@ -319,22 +321,22 @@ isSpreadTarget _ _ = False
 -- the query does not validate.
 fragmentSpreadTypeExistenceRule :: forall m. Rule m
 fragmentSpreadTypeExistenceRule = SelectionRule $ const $ \case
-    FragmentSpreadSelection fragmentSelection
-        | FragmentSpread fragmentName _ location' <- fragmentSelection -> do
+    Full.FragmentSpreadSelection fragmentSelection
+        | Full.FragmentSpread fragmentName _ location' <- fragmentSelection -> do
             ast' <- asks ast
             let target = find (isSpreadTarget fragmentName) ast'
             typeCondition <- lift $ maybeToSeq $ target >>= extractTypeCondition
-            types' <- asks types
+            types' <- asks $ Schema.types . schema
             case HashMap.lookup typeCondition types' of
                 Nothing -> pure $ Error
                     { message = spreadError fragmentName typeCondition
                     , locations = [location']
                     }
                 Just _ -> lift mempty
-    InlineFragmentSelection fragmentSelection
-        | InlineFragment maybeType _ _ location' <- fragmentSelection
+    Full.InlineFragmentSelection fragmentSelection
+        | Full.InlineFragment maybeType _ _ location' <- fragmentSelection
         , Just typeCondition <- maybeType -> do
-            types' <- asks types
+            types' <- asks $ Schema.types . schema
             case HashMap.lookup typeCondition types' of
                 Nothing -> pure $ Error
                     { message = inlineError typeCondition
@@ -344,7 +346,7 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ const $ \case
     _ -> lift mempty
   where
     extractTypeCondition (viewFragment -> Just fragmentDefinition) =
-        let FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition
+        let Full.FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition
          in Just typeCondition
     extractTypeCondition _ = Nothing
     spreadError fragmentName typeCondition = concat
@@ -370,16 +372,16 @@ maybeToSeq Nothing = mempty
 fragmentsOnCompositeTypesRule :: forall m. Rule m
 fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule
   where
-    inlineRule (InlineFragment (Just typeCondition) _ _ location') =
+    inlineRule (Full.InlineFragment (Just typeCondition) _ _ location') =
         check typeCondition location'
     inlineRule _ = lift mempty
-    definitionRule (FragmentDefinition _ typeCondition _ _ location') =
+    definitionRule (Full.FragmentDefinition _ typeCondition _ _ location') =
         check typeCondition location'
     check typeCondition location' = do
-        types' <- asks types
+        types' <- asks $ Schema.types . schema
         -- Skip unknown types, they are checked by another rule.
         _ <- lift $ maybeToSeq $ HashMap.lookup typeCondition types'
-        case lookupTypeCondition typeCondition types' of
+        case Type.lookupTypeCondition typeCondition types' of
             Nothing -> pure $ Error
                 { message = errorMessage typeCondition
                 , locations = [location']
@@ -394,7 +396,7 @@ fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule
 -- | Defined fragments must be used within a document.
 noUnusedFragmentsRule :: forall m. Rule m
 noUnusedFragmentsRule = FragmentDefinitionRule $ \fragment -> do
-    let FragmentDefinition fragmentName _ _ _ location' = fragment
+    let Full.FragmentDefinition fragmentName _ _ _ location' = fragment
      in mapReaderT (checkFragmentName fragmentName location')
         $ asks ast
         >>= flip evalStateT HashSet.empty
@@ -414,35 +416,36 @@ noUnusedFragmentsRule = FragmentDefinitionRule $ \fragment -> do
         , "\" is never used."
         ]
     evaluateSelection selection
-        | FragmentSpreadSelection spreadSelection <- selection
-        , FragmentSpread spreadName _ _ <- spreadSelection =
+        | Full.FragmentSpreadSelection spreadSelection <- selection
+        , Full.FragmentSpread spreadName _ _ <- spreadSelection =
             lift $ pure spreadName
     evaluateSelection _ = lift $ lift mempty
 
-definitionSelections :: Definition -> SelectionSetOpt
+definitionSelections :: Full.Definition -> Full.SelectionSetOpt
 definitionSelections (viewOperation -> Just operation)
-    | OperationDefinition _ _ _ _ selections _ <- operation = toList selections
-    | SelectionSet selections _ <- operation = toList selections
+    | Full.OperationDefinition _ _ _ _ selections _ <- operation =
+        toList selections
+    | Full.SelectionSet selections _ <- operation = toList selections
 definitionSelections (viewFragment -> Just fragment)
-    | FragmentDefinition _ _ _ selections _ <- fragment = toList selections
+    | Full.FragmentDefinition _ _ _ selections _ <- fragment = toList selections
 definitionSelections _ = []
 
 filterSelections :: Foldable t
     => forall a m
-    . (Selection -> ValidationState m a)
-    -> t Selection
+    . (Full.Selection -> ValidationState m a)
+    -> t Full.Selection
     -> ValidationState m a
 filterSelections applyFilter selections
     = (lift . lift) (Seq.fromList $ foldr evaluateSelection mempty selections)
     >>= applyFilter
   where
     evaluateSelection selection accumulator
-        | FragmentSpreadSelection{} <- selection = selection : accumulator
-        | FieldSelection fieldSelection <- selection
-        , Field _ _ _ _ subselections _ <- fieldSelection =
+        | Full.FragmentSpreadSelection{} <- selection = selection : accumulator
+        | Full.FieldSelection fieldSelection <- selection
+        , Full.Field _ _ _ _ subselections _ <- fieldSelection =
             selection : foldr evaluateSelection accumulator subselections
-        | InlineFragmentSelection inlineSelection <- selection
-        , InlineFragment _ _ subselections _ <- inlineSelection =
+        | Full.InlineFragmentSelection inlineSelection <- selection
+        , Full.InlineFragment _ _ subselections _ <- inlineSelection =
             selection : foldr evaluateSelection accumulator subselections
 
 -- | The graph of fragment spreads must not form any cycles including spreading
@@ -450,7 +453,7 @@ filterSelections applyFilter selections
 -- on cycles in the underlying data.
 noFragmentCyclesRule :: forall m. Rule m
 noFragmentCyclesRule = FragmentDefinitionRule $ \case
-    FragmentDefinition fragmentName _ _ selections location' -> do
+    Full.FragmentDefinition fragmentName _ _ selections location' -> do
         state <- evalStateT (collectFields selections)
             (0, fragmentName)
         let spreadPath = fst <$> sortBy (comparing snd) (HashMap.toList state)
@@ -468,16 +471,16 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
             _ -> lift mempty
   where
     collectFields :: Traversable t
-        => t Selection
-        -> StateT (Int, Name) (ReaderT (Validation m) Seq) (HashMap Name Int)
+        => t Full.Selection
+        -> StateT (Int, Full.Name) (ReaderT (Validation m) Seq) (HashMap Full.Name Int)
     collectFields selectionSet = foldM forEach HashMap.empty selectionSet
     forEach accumulator = \case
-        FieldSelection fieldSelection -> forField accumulator fieldSelection
-        InlineFragmentSelection fragmentSelection ->
+        Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
+        Full.InlineFragmentSelection fragmentSelection ->
             forInline accumulator fragmentSelection
-        FragmentSpreadSelection fragmentSelection ->
+        Full.FragmentSpreadSelection fragmentSelection ->
             forSpread accumulator fragmentSelection
-    forSpread accumulator (FragmentSpread fragmentName _ _) = do
+    forSpread accumulator (Full.FragmentSpread fragmentName _ _) = do
         firstFragmentName <- gets snd
         modify $ first (+ 1)
         lastIndex <- gets fst
@@ -486,20 +489,20 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
         if fragmentName == firstFragmentName || inVisitetFragment
             then pure newAccumulator
             else collectFromSpread fragmentName newAccumulator
-    forInline accumulator (InlineFragment _ _ selections _) =
+    forInline accumulator (Full.InlineFragment _ _ selections _) =
         (accumulator <>) <$> collectFields selections
-    forField accumulator (Field _ _ _ _ selections _) =
+    forField accumulator (Full.Field _ _ _ _ selections _) =
         (accumulator <>) <$> collectFields selections
-    findFragmentDefinition n (ExecutableDefinition executableDefinition) Nothing
-        | DefinitionFragment fragmentDefinition <- executableDefinition
-        , FragmentDefinition fragmentName _ _ _ _ <- fragmentDefinition
+    findFragmentDefinition n (Full.ExecutableDefinition executableDefinition) Nothing
+        | Full.DefinitionFragment fragmentDefinition <- executableDefinition
+        , Full.FragmentDefinition fragmentName _ _ _ _ <- fragmentDefinition
         , fragmentName == n = Just fragmentDefinition
     findFragmentDefinition _ _ accumulator = accumulator
     collectFromSpread _fragmentName accumulator = do
         ast' <- lift $ asks ast
         case foldr (findFragmentDefinition _fragmentName) Nothing ast' of
             Nothing -> pure accumulator
-            Just (FragmentDefinition _ _ _ selections _) ->
+            Just (Full.FragmentDefinition _ _ _ selections _) ->
                 (accumulator <>) <$> collectFields selections
 
 -- | Fields and directives treat arguments as a mapping of argument name to
@@ -508,11 +511,11 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case
 uniqueArgumentNamesRule :: forall m. Rule m
 uniqueArgumentNamesRule = ArgumentsRule fieldRule directiveRule
   where
-    fieldRule _ (Field _ _ arguments _ _ _) =
+    fieldRule _ (Full.Field _ _ arguments _ _ _) =
         lift $ filterDuplicates extract "argument" arguments
-    directiveRule (Directive _ arguments _) =
+    directiveRule (Full.Directive _ arguments _) =
         lift $ filterDuplicates extract "argument" arguments
-    extract (Argument argumentName _ location') = (argumentName, location')
+    extract (Full.Argument argumentName _ location') = (argumentName, location')
 
 -- | Directives are used to describe some metadata or behavioral change on the
 -- definition they apply to. When more than one directive of the same name is
@@ -522,9 +525,10 @@ uniqueDirectiveNamesRule :: forall m. Rule m
 uniqueDirectiveNamesRule = DirectivesRule
     $ const $ lift . filterDuplicates extract "directive"
   where
-    extract (Directive directiveName _ location') = (directiveName, location')
+    extract (Full.Directive directiveName _ location') =
+        (directiveName, location')
 
-filterDuplicates :: (a -> (Text, Location)) -> String -> [a] -> Seq Error
+filterDuplicates :: (a -> (Text, Full.Location)) -> String -> [a] -> Seq Error
 filterDuplicates extract nodeType = Seq.fromList
     . fmap makeError
     . filter ((> 1) . length)
@@ -552,7 +556,7 @@ uniqueVariableNamesRule :: forall m. Rule m
 uniqueVariableNamesRule = VariablesRule
     $ lift . filterDuplicates extract "variable"
   where
-    extract (VariableDefinition variableName _ _ location') =
+    extract (Full.VariableDefinition variableName _ _ location') =
         (variableName, location')
 
 -- | Variables can only be input types. Objects, unions and interfaces cannot be
@@ -561,11 +565,11 @@ variablesAreInputTypesRule :: forall m. Rule m
 variablesAreInputTypesRule = VariablesRule
     $ (traverse check . Seq.fromList) >=> lift
   where
-    check (VariableDefinition name typeName _ location')
-        = asks types
+    check (Full.VariableDefinition name typeName _ location')
+        = asks (Schema.types . schema)
         >>= lift
         . maybe (makeError name typeName location') (const mempty)
-        . lookupInputType typeName
+        . Type.lookupInputType typeName
     makeError name typeName location' = pure $ Error
         { message = concat
             [ "Variable \"$"
@@ -576,10 +580,11 @@ variablesAreInputTypesRule = VariablesRule
             ]
         , locations = [location']
         }
-    getTypeName (TypeNamed name) = name
-    getTypeName (TypeList name) = getTypeName name
-    getTypeName (TypeNonNull (NonNullTypeNamed nonNull)) = nonNull
-    getTypeName (TypeNonNull (NonNullTypeList nonNull)) = getTypeName nonNull
+    getTypeName (Full.TypeNamed name) = name
+    getTypeName (Full.TypeList name) = getTypeName name
+    getTypeName (Full.TypeNonNull (Full.NonNullTypeNamed nonNull)) = nonNull
+    getTypeName (Full.TypeNonNull (Full.NonNullTypeList nonNull)) =
+        getTypeName nonNull
 
 -- | Variables are scoped on a per‐operation basis. That means that any variable
 -- used within the context of an operation must be defined at the top level of
@@ -601,13 +606,17 @@ noUndefinedVariablesRule =
         , "\"."
         ]
 
-variableUsageDifference :: forall m
-    . (HashMap Name [Location] -> HashMap Name [Location] -> HashMap Name [Location])
-    -> (Maybe Name -> Name -> 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 difference errorMessage = OperationDefinitionRule $ \case
-    SelectionSet _ _ -> lift mempty
-    OperationDefinition _ operationName variables _ selections _ ->
+    Full.SelectionSet _ _ -> lift mempty
+    Full.OperationDefinition _ operationName variables _ selections _ ->
         let variableNames = HashMap.fromList $ getVariableName <$> variables
          in mapReaderT (readerMapper operationName variableNames)
             $ flip evalStateT HashSet.empty
@@ -620,21 +629,21 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
         . difference variableNames'
         . HashMap.fromListWith (++)
         . toList
-    getVariableName (VariableDefinition variableName _ _ location') =
+    getVariableName (Full.VariableDefinition variableName _ _ location') =
         (variableName, [location'])
     filterSelections' :: Foldable t
-        => t Selection
-        -> ValidationState m (Name, [Location])
+        => t Full.Selection
+        -> ValidationState m (Full.Name, [Full.Location])
     filterSelections' = filterSelections variableFilter
-    variableFilter :: Selection -> ValidationState m (Name, [Location])
-    variableFilter (InlineFragmentSelection inline)
-        | InlineFragment _ directives' _ _ <- inline =
+    variableFilter :: Full.Selection -> ValidationState m (Full.Name, [Full.Location])
+    variableFilter (Full.InlineFragmentSelection inline)
+        | Full.InlineFragment _ directives' _ _ <- inline =
             lift $ lift $ mapDirectives directives'
-    variableFilter (FieldSelection fieldSelection)
-        | Field _ _ arguments directives' _ _ <- fieldSelection =
+    variableFilter (Full.FieldSelection fieldSelection)
+        | Full.Field _ _ arguments directives' _ _ <- fieldSelection =
             lift $ lift $ mapArguments arguments <> mapDirectives directives'
-    variableFilter (FragmentSpreadSelection spread)
-        | FragmentSpread fragmentName _ _ <- spread = do
+    variableFilter (Full.FragmentSpreadSelection spread)
+        | Full.FragmentSpread fragmentName _ _ <- spread = do
             definitions <- lift $ asks ast
             visited <- gets (HashSet.member fragmentName)
             modify (HashSet.insert fragmentName)
@@ -642,13 +651,13 @@ variableUsageDifference difference errorMessage = OperationDefinitionRule $ \cas
                 Just (viewFragment -> Just fragmentDefinition)
                     | not visited -> diveIntoSpread fragmentDefinition
                 _ -> lift $ lift mempty
-    diveIntoSpread (FragmentDefinition _ _ directives' selections _)
+    diveIntoSpread (Full.FragmentDefinition _ _ directives' selections _)
         = filterSelections' selections
         >>= lift . mapReaderT (<> mapDirectives directives') . pure
-    findDirectiveVariables (Directive _ arguments _) = mapArguments arguments
+    findDirectiveVariables (Full.Directive _ arguments _) = mapArguments arguments
     mapArguments = Seq.fromList . mapMaybe findArgumentVariables
     mapDirectives = foldMap findDirectiveVariables
-    findArgumentVariables (Argument _ Node{ node = Variable value', ..} _) =
+    findArgumentVariables (Full.Argument _ Full.Node{ node = Full.Variable value', ..} _) =
         Just (value', [location])
     findArgumentVariables _ = Nothing
     makeError operationName (variableName, locations') = Error
@@ -682,12 +691,12 @@ uniqueInputFieldNamesRule :: forall m. Rule m
 uniqueInputFieldNamesRule =
     ValueRule (const $ lift . go) (const $ lift . constGo)
   where
-    go (Node (Object fields) _) = filterFieldDuplicates fields
+    go (Full.Node (Full.Object fields) _) = filterFieldDuplicates fields
     go _ = mempty
     filterFieldDuplicates fields =
         filterDuplicates getFieldName "input field" fields
-    getFieldName (ObjectField fieldName _ location') = (fieldName, location')
-    constGo (Node (ConstObject fields) _) = filterFieldDuplicates fields
+    getFieldName (Full.ObjectField fieldName _ location') = (fieldName, location')
+    constGo (Full.Node (Full.ConstObject fields) _) = filterFieldDuplicates fields
     constGo _ = mempty
 
 -- | The target field of a field selection must be defined on the scoped type of
@@ -695,9 +704,9 @@ uniqueInputFieldNamesRule =
 fieldsOnCorrectTypeRule :: forall m. Rule m
 fieldsOnCorrectTypeRule = FieldRule fieldRule
   where
-    fieldRule parentType (Field _ fieldName _ _ _ location')
+    fieldRule parentType (Full.Field _ fieldName _ _ _ location')
         | Just objectType <- parentType
-        , Nothing <- lookupTypeField fieldName objectType
+        , Nothing <- Type.lookupTypeField fieldName objectType
         , Just typeName <- compositeTypeName objectType = pure $ Error
             { message = errorMessage fieldName typeName
             , locations = [location']
@@ -711,7 +720,7 @@ fieldsOnCorrectTypeRule = FieldRule fieldRule
         , "\"."
         ]
 
-compositeTypeName :: forall m. Out.Type m -> Maybe Name
+compositeTypeName :: forall m. Out.Type m -> Maybe Full.Name
 compositeTypeName (Out.ObjectBaseType (Out.ObjectType typeName _ _ _)) =
     Just typeName
 compositeTypeName (Out.InterfaceBaseType interfaceType) =
@@ -731,9 +740,9 @@ compositeTypeName (Out.ListBaseType wrappedType) =
 scalarLeafsRule :: forall m. Rule m
 scalarLeafsRule = FieldRule fieldRule
   where
-    fieldRule parentType selectionField@(Field _ fieldName _ _ _ _)
+    fieldRule parentType selectionField@(Full.Field _ fieldName _ _ _ _)
         | Just objectType <- parentType
-        , Just field <- lookupTypeField fieldName objectType =
+        , Just field <- Type.lookupTypeField fieldName objectType =
             let Out.Field _ fieldType _ = field
              in lift $ check fieldType selectionField
         | otherwise = lift mempty
@@ -748,7 +757,7 @@ scalarLeafsRule = FieldRule fieldRule
     check (Out.EnumBaseType (Definition.EnumType typeName _ _)) =
         checkEmpty typeName
     check (Out.ListBaseType wrappedType) = check wrappedType
-    checkNotEmpty typeName (Field _ fieldName _ _ [] location') =
+    checkNotEmpty typeName (Full.Field _ fieldName _ _ [] location') =
         let fieldName' = Text.unpack fieldName
          in makeError location' $ concat
             [ "Field \""
@@ -760,9 +769,9 @@ scalarLeafsRule = FieldRule fieldRule
             , " { ... }\"?"
             ]
     checkNotEmpty _ _ = mempty
-    checkEmpty _ (Field _ _ _ _ [] _) = mempty
+    checkEmpty _ (Full.Field _ _ _ _ [] _) = mempty
     checkEmpty typeName field' =
-        let Field _ fieldName _ _ _ location' = field'
+        let Full.Field _ fieldName _ _ _ location' = field'
          in makeError location' $ concat
             [ "Field \""
             , Text.unpack fieldName
@@ -780,12 +789,12 @@ scalarLeafsRule = FieldRule fieldRule
 knownArgumentNamesRule :: forall m. Rule m
 knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
   where
-    fieldRule (Just objectType) (Field _ fieldName arguments  _ _ _)
-        | Just typeField <- lookupTypeField fieldName objectType
+    fieldRule (Just objectType) (Full.Field _ fieldName arguments  _ _ _)
+        | Just typeField <- Type.lookupTypeField fieldName objectType
         , Just typeName <- compositeTypeName objectType =
             lift $ foldr (go typeName fieldName typeField) Seq.empty arguments
     fieldRule _ _ = lift mempty
-    go typeName fieldName fieldDefinition (Argument argumentName _ location') errors
+    go typeName fieldName fieldDefinition (Full.Argument argumentName _ location') errors
         | Out.Field _ _ definitions <- fieldDefinition
         , Just _ <- HashMap.lookup argumentName definitions = errors
         | otherwise = errors |> Error
@@ -801,9 +810,10 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
         , Text.unpack fieldName
         , "\"."
         ]
-    directiveRule (Directive directiveName arguments _) = do
-        available <- asks $ HashMap.lookup directiveName . directives
-        Argument argumentName _ location' <- lift $ Seq.fromList arguments
+    directiveRule (Full.Directive directiveName arguments _) = do
+        available <- asks $ HashMap.lookup directiveName
+            . Schema.directives . schema
+        Full.Argument argumentName _ location' <- lift $ Seq.fromList arguments
         case available of
             Just (Schema.Directive _ _ definitions)
                 | not $ HashMap.member argumentName definitions ->
@@ -825,7 +835,7 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
 -- directive, the directive must be available on that server.
 knownDirectiveNamesRule :: Rule m
 knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
-    definitions' <- asks directives
+    definitions' <- asks $ Schema.directives . schema
     let directiveSet = HashSet.fromList $ fmap directiveName directives'
     let definitionSet = HashSet.fromList $ HashMap.keys definitions'
     let difference = HashSet.difference directiveSet definitionSet
@@ -834,8 +844,8 @@ knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
   where
     definitionFilter difference = flip HashSet.member difference
         . directiveName
-    directiveName (Directive directiveName' _ _) = directiveName'
-    makeError (Directive directiveName' _ location') = Error
+    directiveName (Full.Directive directiveName' _ _) = directiveName'
+    makeError (Full.Directive directiveName' _ location') = Error
         { message = errorMessage directiveName'
         , locations = [location']
         }
@@ -850,15 +860,15 @@ knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
 knownInputFieldNamesRule :: Rule m
 knownInputFieldNamesRule = ValueRule go constGo
   where
-    go (Just valueType) (Node (Object inputFields) _)
+    go (Just valueType) (Full.Node (Full.Object inputFields) _)
         | In.InputObjectBaseType objectType <- valueType =
              lift $ Seq.fromList $ mapMaybe (forEach objectType) inputFields
     go _ _ = lift mempty
-    constGo (Just valueType) (Node (ConstObject inputFields) _)
+    constGo (Just valueType) (Full.Node (Full.ConstObject inputFields) _)
         | In.InputObjectBaseType objectType <- valueType =
              lift $ Seq.fromList $ mapMaybe (forEach objectType) inputFields
     constGo  _ _ = lift mempty
-    forEach objectType (ObjectField inputFieldName _ location')
+    forEach objectType (Full.ObjectField inputFieldName _ location')
         | In.InputObjectType _ _ fieldTypes <- objectType
         , Just _ <- HashMap.lookup inputFieldName fieldTypes = Nothing
         | otherwise
@@ -881,8 +891,9 @@ directivesInValidLocationsRule :: Rule m
 directivesInValidLocationsRule = DirectivesRule directivesRule
   where
     directivesRule directiveLocation directives' = do
-        Directive directiveName _ location <- lift $ Seq.fromList directives'
-        maybeDefinition <- asks $ HashMap.lookup directiveName . directives
+        Full.Directive directiveName _ location <- lift $ Seq.fromList directives'
+        maybeDefinition <- asks
+            $ HashMap.lookup directiveName . Schema.directives . schema
         case maybeDefinition of
             Just (Schema.Directive _ allowedLocations _)
                 | directiveLocation `notElem` allowedLocations -> pure $ Error
@@ -904,14 +915,15 @@ directivesInValidLocationsRule = DirectivesRule directivesRule
 providedRequiredArgumentsRule :: Rule m
 providedRequiredArgumentsRule = ArgumentsRule fieldRule directiveRule
   where
-    fieldRule (Just objectType) (Field _ fieldName arguments  _ _ location')
-        | Just typeField <- lookupTypeField fieldName objectType
+    fieldRule (Just objectType) (Full.Field _ fieldName arguments  _ _ location')
+        | Just typeField <- Type.lookupTypeField fieldName objectType
         , Out.Field _ _ definitions <- typeField =
             let forEach = go (fieldMessage fieldName) arguments location'
              in lift $ HashMap.foldrWithKey forEach Seq.empty definitions
     fieldRule _ _ = lift mempty
-    directiveRule (Directive directiveName arguments location') = do
-        available <- asks $ HashMap.lookup directiveName . directives
+    directiveRule (Full.Directive directiveName arguments location') = do
+        available <- asks
+            $ HashMap.lookup directiveName . Schema.directives . schema
         case available of
             Just (Schema.Directive _ _ definitions) ->
                 let forEach = go (directiveMessage directiveName) arguments location'
@@ -930,9 +942,10 @@ providedRequiredArgumentsRule = ArgumentsRule fieldRule directiveRule
         { message = errorMessage
         , locations = [location']
         }
-    isNothingOrNull (Just (Argument _ (Node Null _) _)) = True
+    isNothingOrNull (Just (Full.Argument _ (Full.Node Full.Null _) _)) = True
     isNothingOrNull x = isNothing x
-    lookupArgument needle (Argument argumentName _ _) = needle == argumentName
+    lookupArgument needle (Full.Argument argumentName _ _) =
+        needle == argumentName
     fieldMessage fieldName argumentName typeName = concat
         [ "Field \""
         , Text.unpack fieldName
@@ -966,7 +979,7 @@ inputTypeName (In.ListBaseType listType) = inputTypeName listType
 providedRequiredInputFieldsRule :: Rule m
 providedRequiredInputFieldsRule = ValueRule go constGo
   where
-    go (Just valueType) (Node (Object inputFields) location')
+    go (Just valueType) (Full.Node (Full.Object inputFields) location')
         | In.InputObjectBaseType objectType <- valueType
         , In.InputObjectType objectTypeName _ fieldDefinitions <- objectType
             = lift
@@ -983,9 +996,9 @@ providedRequiredInputFieldsRule = ValueRule go constGo
         , isNothingOrNull $ find (lookupField definitionName) inputFields =
             Just $ makeError definitionName typeName location'
         | otherwise = Nothing
-    isNothingOrNull (Just (ObjectField _ (Node Null _) _)) = True
+    isNothingOrNull (Just (Full.ObjectField _ (Full.Node Full.Null _) _)) = True
     isNothingOrNull x = isNothing x
-    lookupField needle (ObjectField fieldName _ _) = needle == fieldName
+    lookupField needle (Full.ObjectField fieldName _ _) = needle == fieldName
     makeError fieldName typeName location' = Error
         { message = errorMessage fieldName typeName
         , locations = [location']