Collect types once the schema is created

src/Language/GraphQL/Execute/Execution.hs

@@ -27,8 +27,7 @@ import qualified Language.GraphQL.Execute.Transform as Transform
 import qualified Language.GraphQL.Type as Type
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
-import Language.GraphQL.Type.Internal
-import Language.GraphQL.Type.Schema
+import qualified Language.GraphQL.Type.Internal as Internal
 import Prelude hiding (null)
 
 resolveFieldValue :: MonadCatch m
@@ -60,7 +59,7 @@ collectFields objectType = foldl forEach Map.empty
          in Map.insertWith (<>) responseKey (field :| []) groupedFields
     forEach groupedFields (Transform.SelectionFragment selectionFragment)
         | Transform.Fragment fragmentType fragmentSelectionSet <- selectionFragment
-        , doesFragmentTypeApply fragmentType objectType =
+        , Internal.doesFragmentTypeApply fragmentType objectType =
             let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
              in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
         | otherwise = groupedFields
@@ -69,15 +68,15 @@ aliasOrName :: forall m. Transform.Field m -> Name
 aliasOrName (Transform.Field alias name _ _) = fromMaybe name alias
 
 resolveAbstractType :: Monad m
-    => AbstractType m
+    => Internal.AbstractType m
     -> Type.Subs
     -> CollectErrsT m (Maybe (Out.ObjectType m))
 resolveAbstractType abstractType values'
     | Just (Type.String typeName) <- HashMap.lookup "__typename" values' = do
         types' <- gets types
         case HashMap.lookup typeName types' of
-            Just (ObjectType objectType) ->
-                if instanceOf objectType abstractType
+            Just (Internal.ObjectType objectType) ->
+                if Internal.instanceOf objectType abstractType
                     then pure $ Just objectType
                     else pure Nothing
             _ -> pure Nothing
@@ -129,7 +128,7 @@ completeValue (Out.ObjectBaseType objectType) fields result =
     executeSelectionSet result objectType $ mergeSelectionSets fields
 completeValue (Out.InterfaceBaseType interfaceType) fields result
     | Type.Object objectMap <- result = do
-        let abstractType = AbstractInterfaceType interfaceType
+        let abstractType = Internal.AbstractInterfaceType interfaceType
         concreteType <- resolveAbstractType abstractType objectMap
         case concreteType of
             Just objectType -> executeSelectionSet result objectType
@@ -137,7 +136,7 @@ completeValue (Out.InterfaceBaseType interfaceType) fields result
             Nothing -> addErrMsg "Interface value completion failed."
 completeValue (Out.UnionBaseType unionType) fields result
     | Type.Object objectMap <- result = do
-        let abstractType = AbstractUnionType unionType
+        let abstractType = Internal.AbstractUnionType unionType
         concreteType <- resolveAbstractType abstractType objectMap
         case concreteType of
             Just objectType -> executeSelectionSet result objectType

src/Language/GraphQL/Execute/Transform.hs

@@ -47,9 +47,8 @@ import Language.GraphQL.AST (Name)
 import qualified Language.GraphQL.Execute.Coerce as Coerce
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type as Type
-import Language.GraphQL.Type.Internal
+import qualified Language.GraphQL.Type.Internal as Type
 import qualified Language.GraphQL.Type.Out as Out
-import Language.GraphQL.Type.Schema (Schema)
 import qualified Language.GraphQL.Type.Schema as Schema
 
 -- | Associates a fragment name with a list of 'Field's.
@@ -64,7 +63,7 @@ type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition
 
 -- | Represents fragments and inline fragments.
 data Fragment m
-    = Fragment (CompositeType m) (Seq (Selection m))
+    = Fragment (Type.CompositeType m) (Seq (Selection m))
 
 -- | Single selection element.
 data Selection m
@@ -154,7 +153,7 @@ coerceVariableValues types operationDefinition variableValues =
         let Full.VariableDefinition variableName variableTypeName defaultValue _ =
                 variableDefinition
         let defaultValue' = constValue . Full.node <$> defaultValue
-        variableType <- lookupInputType variableTypeName types
+        variableType <- Type.lookupInputType variableTypeName types
 
         Coerce.matchFieldValues
             coerceVariableValue'
@@ -185,13 +184,13 @@ constValue (Full.ConstObject o) =
 -- for query execution.
 document :: Coerce.VariableValue a
     => forall m
-    . Schema m
+    . Type.Schema m
     -> Maybe Full.Name
     -> HashMap Full.Name a
     -> Full.Document
     -> Either QueryError (Document m)
 document schema operationName subs ast = do
-    let referencedTypes = collectReferencedTypes schema
+    let referencedTypes = Schema.types schema
 
     (operations, fragmentTable) <- defragment ast
     chosenOperation <- getOperation operationName operations
@@ -311,7 +310,7 @@ inlineFragment (Full.InlineFragment type' directives' selections _) = do
                 Nothing -> pure $ Left fragmentSelectionSet
                 Just typeName -> do
                     types' <- gets types
-                    case lookupTypeCondition typeName types' of
+                    case Type.lookupTypeCondition typeName types' of
                         Just typeCondition -> pure $
                             selectionFragment typeCondition fragmentSelectionSet
                         Nothing -> pure $ Left mempty
@@ -358,7 +357,7 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections _) = do
     fragmentSelection <- appendSelection selections
     types' <- gets types
 
-    case lookupTypeCondition type' types' of
+    case Type.lookupTypeCondition type' types' of
         Just compositeType -> do
             let newValue = Fragment compositeType fragmentSelection
             modify $ insertFragment newValue