Define resolvers on type fields

Returning resolvers from other resolvers isn't supported anymore. Since we have a type system now, we define the resolvers in the object type fields and pass an object with the previous result to them.
2020-05-27 23:18:35 +02:00
parent c06d0b8e95
commit d12577ae71
25 changed files with 534 additions and 516 deletions
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@ -1,37 +1,15 @@
 -- | This is the AST meant to be executed.
 module Language.GraphQL.AST.Core
-    ( Alias
-    , Arguments(..)
-    , Directive(..)
-    , Field(..)
-    , Fragment(..)
+    ( Arguments(..)
    , Name
-    , Operation(..)
-    , Selection(..)
-    , TypeCondition
    ) where

 import Data.HashMap.Strict (HashMap)
-import Data.Sequence (Seq)
-import Data.Text (Text)
-import Language.GraphQL.AST (Alias, Name, TypeCondition)
-import qualified Language.GraphQL.Type.In as In
-
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
--
-- Currently only queries and mutations are supported.
-data Operation
-    = Query (Maybe Text) (Seq Selection)
-    | Mutation (Maybe Text) (Seq Selection)
-    deriving (Eq, Show)
-
-- | Single GraphQL field.
-data Field
-    = Field (Maybe Alias) Name Arguments (Seq Selection)
-    deriving (Eq, Show)
+import Language.GraphQL.AST (Name)
+import Language.GraphQL.Type.Definition

 -- | Argument list.
-newtype Arguments = Arguments (HashMap Name In.Value)
+newtype Arguments = Arguments (HashMap Name Value)
    deriving (Eq, Show)

 instance Semigroup Arguments where
@ -40,17 +18,3 @@ instance Semigroup Arguments where
 instance Monoid Arguments where
    mempty = Arguments mempty

-- | Directive.
-data Directive = Directive Name Arguments
-    deriving (Eq, Show)
-
-- | Represents fragments and inline fragments.
-data Fragment
-    = Fragment TypeCondition (Seq Selection)
-    deriving (Eq, Show)
-
-- | Single selection element.
-data Selection
-    = SelectionFragment Fragment
-    | SelectionField Field
-    deriving (Eq, Show)
--- a/src/Language/GraphQL/Error.hs
+++ b/src/Language/GraphQL/Error.hs
@ -5,21 +5,20 @@
 module Language.GraphQL.Error
    ( parseError
    , CollectErrsT
+    , Resolution(..)
    , addErr
    , addErrMsg
    , runCollectErrs
-    , runAppendErrs
    , singleError
    ) where

+import Control.Monad.Trans.State (StateT, modify, runStateT)
 import qualified Data.Aeson as Aeson
+import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
 import Data.Void (Void)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State ( StateT
-                                 , modify
-                                 , runStateT
-                                 )
+import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Type.Schema
 import Text.Megaparsec
    ( ParseErrorBundle(..)
    , PosState(..)
@ -30,6 +29,11 @@ import Text.Megaparsec
    , unPos
    )

+data Resolution m = Resolution
+    { errors :: [Aeson.Value]
+    , types :: HashMap Name (Type m)
+    }
+
 -- | Wraps a parse error into a list of errors.
 parseError :: Applicative f => ParseErrorBundle Text Void -> f Aeson.Value
 parseError ParseErrorBundle{..}  =
@ -46,11 +50,13 @@ parseError ParseErrorBundle{..}  =
         in (errorObject x sourcePosition : result, newState)

 -- | A wrapper to pass error messages around.
-type CollectErrsT m = StateT [Aeson.Value] m
+type CollectErrsT m = StateT (Resolution m) m

 -- | Adds an error to the list of errors.
 addErr :: Monad m => Aeson.Value -> CollectErrsT m ()
-addErr v = modify (v :)
+addErr v = modify appender
+  where
+    appender resolution@Resolution{..} = resolution{ errors = v : errors }

 makeErrorMessage :: Text -> Aeson.Value
 makeErrorMessage s = Aeson.object [("message", Aeson.toJSON s)]
@ -66,23 +72,17 @@ singleError message = Aeson.object
 addErrMsg :: Monad m => Text -> CollectErrsT m ()
 addErrMsg = addErr . makeErrorMessage

-- | Appends the given list of errors to the current list of errors.
-appendErrs :: Monad m => [Aeson.Value] -> CollectErrsT m ()
-appendErrs errs = modify (errs ++)
-
 -- | Runs the given query computation, but collects the errors into an error
 --   list, which is then sent back with the data.
-runCollectErrs :: Monad m => CollectErrsT m Aeson.Value -> m Aeson.Value
-runCollectErrs res = do
-    (dat, errs) <- runStateT res []
-    if null errs
+runCollectErrs :: Monad m
+    => HashMap Name (Type m)
+    -> CollectErrsT m Aeson.Value
+    -> m Aeson.Value
+runCollectErrs types' res = do
+    (dat, Resolution{..}) <- runStateT res $ Resolution{ errors = [], types = types' }
+    if null errors
       then return $ Aeson.object [("data", dat)]
-       else return $ Aeson.object [("data", dat), ("errors", Aeson.toJSON $ reverse errs)]
-
-- | Runs the given computation, collecting the errors and appending them
--   to the previous list of errors.
-runAppendErrs :: Monad m => CollectErrsT m a -> CollectErrsT m a
-runAppendErrs f = do
-    (v, errs) <- lift $ runStateT f []
-    appendErrs errs
-    return v
+       else return $ Aeson.object
+           [ ("data", dat)
+           , ("errors", Aeson.toJSON $ reverse errors)
+           ]
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@ -1,6 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
    ( execute
@ -8,14 +5,15 @@ module Language.GraphQL.Execute
    ) where

 import qualified Data.Aeson as Aeson
+import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Sequence (Seq(..))
 import Data.Text (Text)
-import Language.GraphQL.AST.Document
-import qualified Language.GraphQL.AST.Core as AST.Core
+import Language.GraphQL.AST.Document (Document, Name)
 import Language.GraphQL.Execute.Coerce
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
+import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Schema as Schema
 import qualified Language.GraphQL.Type.Out as Out
 import Language.GraphQL.Type.Schema
@ -56,22 +54,18 @@ executeRequest :: (Monad m, VariableValue a)
 executeRequest schema operationName subs document =
    case Transform.document schema operationName subs document of
        Left queryError -> pure $ singleError $ Transform.queryError queryError
-        Right (Transform.Document rootObjectType operation)
-          | (AST.Core.Query _ fields) <- operation ->
-              executeOperation rootObjectType fields
-          | (AST.Core.Mutation _ fields) <- operation ->
-              executeOperation rootObjectType fields
+        Right (Transform.Document types' rootObjectType operation)
+          | (Transform.Query _ fields) <- operation ->
+              executeOperation types' rootObjectType fields
+          | (Transform.Mutation _ fields) <- operation ->
+              executeOperation types' rootObjectType fields

 -- This is actually executeMutation, but we don't distinguish between queries
 -- and mutations yet.
 executeOperation :: Monad m
-    => Out.ObjectType m
-    -> Seq AST.Core.Selection
+    => HashMap Name (Type m)
+    -> Out.ObjectType m
+    -> Seq (Transform.Selection m)
    -> m Aeson.Value
-executeOperation (Out.ObjectType _ _ _ objectFields) fields
-    = runCollectErrs
-    $ flip Schema.resolve fields
-    $ fmap getResolver
-    $ objectFields
-  where
-    getResolver (Out.Field _ _ _ resolver) = resolver
+executeOperation types' objectType fields =
+    runCollectErrs types' $ Schema.resolve Null objectType fields
--- a/src/Language/GraphQL/Execute/Coerce.hs
+++ b/src/Language/GraphQL/Execute/Coerce.hs
@ -16,7 +16,6 @@ import qualified Data.Text.Lazy.Builder.Int as Text.Builder
 import Data.Scientific (toBoundedInteger, toRealFloat)
 import Language.GraphQL.AST.Document (Name)
 import qualified Language.GraphQL.Type.In as In
-import Language.GraphQL.Schema
 import Language.GraphQL.Type.Definition

 -- | Since variables are passed separately from the query, in an independent
@ -46,26 +45,26 @@ class VariableValue a where
    coerceVariableValue
        :: In.Type -- ^ Expected type (variable type given in the query).
        -> a -- ^ Variable value being coerced.
-        -> Maybe In.Value -- ^ Coerced value on success, 'Nothing' otherwise.
+        -> Maybe Value -- ^ Coerced value on success, 'Nothing' otherwise.

 instance VariableValue Aeson.Value where
-    coerceVariableValue _ Aeson.Null = Just In.Null
+    coerceVariableValue _ Aeson.Null = Just Null
    coerceVariableValue (In.ScalarBaseType scalarType) value
-        | (Aeson.String stringValue) <- value = Just $ In.String stringValue
-        | (Aeson.Bool booleanValue) <- value = Just $ In.Boolean booleanValue
+        | (Aeson.String stringValue) <- value = Just $ String stringValue
+        | (Aeson.Bool booleanValue) <- value = Just $ Boolean booleanValue
        | (Aeson.Number numberValue) <- value
        , (ScalarType "Float" _) <- scalarType =
-            Just $ In.Float $ toRealFloat numberValue
+            Just $ Float $ toRealFloat numberValue
        | (Aeson.Number numberValue) <- value = -- ID or Int
-            In.Int <$> toBoundedInteger numberValue
+            Int <$> toBoundedInteger numberValue
    coerceVariableValue (In.EnumBaseType _) (Aeson.String stringValue) =
-        Just $ In.Enum stringValue
+        Just $ Enum stringValue
    coerceVariableValue (In.InputObjectBaseType objectType) value
        | (Aeson.Object objectValue) <- value = do
            let (In.InputObjectType _ _ inputFields) = objectType
            (newObjectValue, resultMap) <- foldWithKey objectValue inputFields
            if HashMap.null newObjectValue
-                then Just $ In.Object resultMap
+                then Just $ Object resultMap
                else Nothing
      where
        foldWithKey objectValue = HashMap.foldrWithKey matchFieldValues
@ -81,7 +80,7 @@ instance VariableValue Aeson.Value where
                        pure (newObjectValue, insert coerced)
                    Nothing -> Just (objectValue, resultMap)
    coerceVariableValue (In.ListBaseType listType) value
-        | (Aeson.Array arrayValue) <- value = In.List
+        | (Aeson.Array arrayValue) <- value = List
            <$> foldr foldVector (Just []) arrayValue
        | otherwise = coerceVariableValue listType value
      where
@ -95,7 +94,7 @@ instance VariableValue Aeson.Value where
 --   corresponding types.
 coerceInputLiterals
    :: HashMap Name In.Type
-    -> HashMap Name In.Value
+    -> HashMap Name Value
    -> Maybe Subs
 coerceInputLiterals variableTypes variableValues =
    foldWithKey operator variableTypes
@ -105,34 +104,34 @@ coerceInputLiterals variableTypes variableValues =
        <$> (lookupVariable variableName >>= coerceInputLiteral variableType)
        <*> resultMap
    coerceInputLiteral (In.NamedScalarType type') value
-        | (In.String stringValue) <- value
-        , (ScalarType "String" _) <- type' = Just $ In.String stringValue
-        | (In.Boolean booleanValue) <- value
-        , (ScalarType "Boolean" _) <- type' = Just $ In.Boolean booleanValue
-        | (In.Int intValue) <- value
-        , (ScalarType "Int" _) <- type' = Just $ In.Int intValue
-        | (In.Float floatValue) <- value
-        , (ScalarType "Float" _) <- type' = Just $ In.Float floatValue
-        | (In.Int intValue) <- value
+        | (String stringValue) <- value
+        , (ScalarType "String" _) <- type' = Just $ String stringValue
+        | (Boolean booleanValue) <- value
+        , (ScalarType "Boolean" _) <- type' = Just $ Boolean booleanValue
+        | (Int intValue) <- value
+        , (ScalarType "Int" _) <- type' = Just $ Int intValue
+        | (Float floatValue) <- value
+        , (ScalarType "Float" _) <- type' = Just $ Float floatValue
+        | (Int intValue) <- value
        , (ScalarType "Float" _) <- type' =
-            Just $ In.Float $ fromIntegral intValue
-        | (In.String stringValue) <- value
-        , (ScalarType "ID" _) <- type' = Just $ In.String stringValue
-        | (In.Int intValue) <- value
+            Just $ Float $ fromIntegral intValue
+        | (String stringValue) <- value
+        , (ScalarType "ID" _) <- type' = Just $ String stringValue
+        | (Int intValue) <- value
        , (ScalarType "ID" _) <- type' = Just $ decimal intValue
-    coerceInputLiteral (In.NamedEnumType type') (In.Enum enumValue)
-        | member enumValue type' = Just $ In.Enum enumValue
-    coerceInputLiteral (In.NamedInputObjectType type') (In.Object _) = 
+    coerceInputLiteral (In.NamedEnumType type') (Enum enumValue)
+        | member enumValue type' = Just $ Enum enumValue
+    coerceInputLiteral (In.NamedInputObjectType type') (Object _) = 
        let (In.InputObjectType _ _ inputFields) = type'
-            in In.Object <$> foldWithKey matchFieldValues inputFields
+            in Object <$> foldWithKey matchFieldValues inputFields
    coerceInputLiteral _ _ = Nothing
    member value (EnumType _ _ members) = Set.member value members
    matchFieldValues fieldName (In.InputField _ type' defaultValue) resultMap =
        case lookupVariable fieldName of
-            Just In.Null
+            Just Null
                | In.isNonNullType type' -> Nothing
                | otherwise ->
-                    HashMap.insert fieldName In.Null <$> resultMap
+                    HashMap.insert fieldName Null <$> resultMap
            Just variableValue -> HashMap.insert fieldName
                <$> coerceInputLiteral type' variableValue
                <*> resultMap
@ -144,7 +143,7 @@ coerceInputLiterals variableTypes variableValues =
                | otherwise -> resultMap
    lookupVariable = flip HashMap.lookup variableValues
    foldWithKey f = HashMap.foldrWithKey f (Just HashMap.empty)
-    decimal = In.String
+    decimal = String
        . Text.Lazy.toStrict
        . Text.Builder.toLazyText
        . Text.Builder.decimal
--- a/src/Language/GraphQL/Execute/Execution.hs
+++ b/src/Language/GraphQL/Execute/Execution.hs
@ -0,0 +1,58 @@
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.Execute.Execution
+    ( aliasOrName
+    , collectFields
+    ) where
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.Execute.Transform
+import qualified Language.GraphQL.Type.Out as Out
+import Language.GraphQL.Type.Schema
+
+collectFields :: Monad m
+    => Out.ObjectType m
+    -> Seq (Selection m)
+    -> Map Name (Seq (Field m))
+collectFields objectType = foldl forEach Map.empty
+  where
+    forEach groupedFields (SelectionField field) =
+        let responseKey = aliasOrName field
+         in Map.insertWith (<>) responseKey (Seq.singleton field) groupedFields
+    forEach groupedFields (SelectionFragment selectionFragment)
+        | Fragment fragmentType fragmentSelectionSet <- selectionFragment
+        , doesFragmentTypeApply fragmentType objectType =
+            let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
+             in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
+        | otherwise = groupedFields
+
+aliasOrName :: forall m. Field m -> Name
+aliasOrName (Field alias name _ _) = fromMaybe name alias
+
+doesFragmentTypeApply :: forall m
+    . CompositeType m
+    -> Out.ObjectType m
+    -> Bool
+doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
+    let Out.ObjectType fragmentName _ _ _ = fragmentType
+        Out.ObjectType objectName _ _ _ = objectType
+     in fragmentName == objectName
+doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
+    let Out.ObjectType _ _ interfaces _ = objectType
+     in foldr instanceOf False interfaces
+  where
+    instanceOf (Out.InterfaceType that _ interfaces _) acc =
+        let Out.InterfaceType this _ _ _ = fragmentType
+         in acc || foldr instanceOf (this == that) interfaces
+doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
+    let Out.UnionType _ _ members = fragmentType
+     in foldr instanceOf False members
+  where
+    instanceOf (Out.ObjectType that _ _ _) acc =
+        let Out.ObjectType this _ _ _ = objectType
+         in acc || this == that
--- a/src/Language/GraphQL/Execute/Transform.hs
+++ b/src/Language/GraphQL/Execute/Transform.hs
@ -12,12 +12,17 @@
 --   replaced by the selection set they represent. Invalid (recursive and
 --   non-existing) fragments are skipped. The most fragments are inlined, so the
 --   executor doesn't have to perform additional lookups later.
+--   * Evaluating directives (@\@include@ and @\@skip@).
 --
 -- This module is also responsible for smaller rewrites that touch only parts of
 -- the original AST.
 module Language.GraphQL.Execute.Transform
    ( Document(..)
+    , Fragment(..)
    , QueryError(..)
+    , Operation(..)
+    , Selection(..)
+    , Field(..)
    , document
    , queryError
    ) where
@ -36,26 +41,48 @@ import Data.Sequence (Seq, (<|), (><))
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Language.GraphQL.AST as Full
-import qualified Language.GraphQL.AST.Core as Core
+import Language.GraphQL.AST.Core
 import Language.GraphQL.Execute.Coerce
-import qualified Language.GraphQL.Schema as Schema
 import qualified Language.GraphQL.Type.Directive as Directive
+import Language.GraphQL.Type.Definition (Subs, Value(..))
+import qualified Language.GraphQL.AST.Core as Core
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
+import qualified Language.GraphQL.Type.Directive as Core
 import Language.GraphQL.Type.Schema

 -- | Associates a fragment name with a list of 'Core.Field's.
 data Replacement m = Replacement
-    { fragments :: HashMap Core.Name Core.Fragment
+    { fragments :: HashMap Full.Name (Fragment m)
    , fragmentDefinitions :: FragmentDefinitions
-    , variableValues :: Schema.Subs
+    , variableValues :: Subs
    , types :: HashMap Full.Name (Type m)
    }

 type FragmentDefinitions = HashMap Full.Name Full.FragmentDefinition

+-- | Represents fragments and inline fragments.
+data Fragment m
+    = Fragment (CompositeType m) (Seq (Selection m))
+
+-- | Single selection element.
+data Selection m
+    = SelectionFragment (Fragment m)
+    | SelectionField (Field m)
+
+-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
+--
+-- Currently only queries and mutations are supported.
+data Operation m
+    = Query (Maybe Text) (Seq (Selection m))
+    | Mutation (Maybe Text) (Seq (Selection m))
+
+-- | Single GraphQL field.
+data Field m = Field (Maybe Full.Name) Full.Name Arguments (Seq (Selection m))
+
 -- | Contains the operation to be executed along with its root type.
-data Document m = Document (Out.ObjectType m) Core.Operation
+data Document m = Document
+    (HashMap Full.Name (Type m)) (Out.ObjectType m) (Operation m)

 data OperationDefinition = OperationDefinition
    Full.OperationType
@ -131,7 +158,7 @@ coerceVariableValues :: VariableValue a
    . HashMap Full.Name (Type m)
    -> OperationDefinition
    -> HashMap.HashMap Full.Name a
-    -> Either QueryError Schema.Subs
+    -> Either QueryError Subs
 coerceVariableValues types operationDefinition variableValues' =
    let OperationDefinition _ _ variableDefinitions _ _ = operationDefinition
     in maybe (Left CoercionError) Right
@ -149,23 +176,23 @@ coerceVariableValues types operationDefinition variableValues' =
            <*> coercedValues
    choose Nothing defaultValue variableType
        | Just _ <- defaultValue = defaultValue
-        | not (In.isNonNullType variableType) = Just In.Null
+        | not (In.isNonNullType variableType) = Just Null
    choose (Just value') _ variableType
        | Just coercedValue <- coerceVariableValue variableType value'
-        , not (In.isNonNullType variableType) || coercedValue /= In.Null =
+        , not (In.isNonNullType variableType) || coercedValue /= Null =
            Just coercedValue
    choose _ _ _ = Nothing

-constValue :: Full.ConstValue -> In.Value
-constValue (Full.ConstInt i) = In.Int i
-constValue (Full.ConstFloat f) = In.Float f
-constValue (Full.ConstString x) = In.String x
-constValue (Full.ConstBoolean b) = In.Boolean b
-constValue Full.ConstNull = In.Null
-constValue (Full.ConstEnum e) = In.Enum e
-constValue (Full.ConstList l) = In.List $ constValue <$> l
+constValue :: Full.ConstValue -> Value
+constValue (Full.ConstInt i) = Int i
+constValue (Full.ConstFloat f) = Float f
+constValue (Full.ConstString x) = String x
+constValue (Full.ConstBoolean b) = Boolean b
+constValue Full.ConstNull = Null
+constValue (Full.ConstEnum e) = Enum e
+constValue (Full.ConstList l) = List $ constValue <$> l
 constValue (Full.ConstObject o) =
-    In.Object $ HashMap.fromList $ constObjectField <$> o
+    Object $ HashMap.fromList $ constObjectField <$> o
  where
    constObjectField (Full.ObjectField key value') = (key, constValue value')

@ -193,12 +220,12 @@ document schema operationName subs ast = do
            }
    case chosenOperation of
        OperationDefinition Full.Query _ _ _ _ ->
-            pure $ Document (query schema)
-                $ operation (query schema) chosenOperation replacement
+            pure $ Document referencedTypes (query schema)
+                $ operation chosenOperation replacement
        OperationDefinition Full.Mutation _ _ _ _
            | Just mutationType <- mutation schema ->
-                pure $ Document mutationType
-                    $ operation mutationType chosenOperation replacement
+                pure $ Document referencedTypes mutationType
+                    $ operation chosenOperation replacement
        _ -> Left UnsupportedRootOperation

 defragment
@ -227,72 +254,73 @@ defragment ast =

 -- * Operation

-operation :: forall m
-    . Out.ObjectType m
-    -> OperationDefinition
-    -> Replacement m
-    -> Core.Operation
-operation rootType operationDefinition replacement
+operation :: OperationDefinition -> Replacement m -> Operation m
+operation operationDefinition replacement
    = runIdentity
-    $ evalStateT (collectFragments rootType >> transform operationDefinition) replacement
+    $ evalStateT (collectFragments >> transform operationDefinition) replacement
  where
    transform (OperationDefinition Full.Query name _ _ sels) =
-        Core.Query name <$> appendSelection sels rootType
+        Query name <$> appendSelection sels
    transform (OperationDefinition Full.Mutation name _ _ sels) =
-        Core.Mutation name <$> appendSelection sels rootType
+        Mutation name <$> appendSelection sels

 -- * Selection

-selection :: forall m
-    . Full.Selection
-    -> Out.ObjectType m
-    -> State (Replacement m) (Either (Seq Core.Selection) Core.Selection)
-selection (Full.Field alias name arguments' directives' selections) objectType =
-    maybe (Left mempty) (Right . Core.SelectionField) <$> do
+selection
+    :: Full.Selection
+    ->  State (Replacement m) (Either (Seq (Selection m)) (Selection m))
+selection (Full.Field alias name arguments' directives' selections) =
+    maybe (Left mempty) (Right . SelectionField) <$> do
        fieldArguments <- arguments arguments'
-        fieldSelections <- appendSelection selections objectType
+        fieldSelections <- appendSelection selections
        fieldDirectives <- Directive.selection <$> directives directives'
-        let field' = Core.Field alias name fieldArguments fieldSelections
+        let field' = Field alias name fieldArguments fieldSelections
        pure $ field' <$ fieldDirectives
-selection (Full.FragmentSpread name directives') objectType =
-    maybe (Left mempty) (Right . Core.SelectionFragment) <$> do
+selection (Full.FragmentSpread name directives') =
+    maybe (Left mempty) (Right . SelectionFragment) <$> do
        spreadDirectives <- Directive.selection <$> directives directives'
        fragments' <- gets fragments

        fragmentDefinitions' <- gets fragmentDefinitions
        case HashMap.lookup name fragments' of
            Just definition -> lift $ pure $ definition <$ spreadDirectives
-            Nothing -> case HashMap.lookup name fragmentDefinitions' of
-                         Just definition -> do
-                             fragment <- fragmentDefinition definition objectType
-                             lift $ pure $ fragment <$ spreadDirectives
-                         Nothing -> lift $ pure  Nothing
-selection (Full.InlineFragment type' directives' selections) objectType = do
+            Nothing
+                | Just definition <- HashMap.lookup name fragmentDefinitions' -> do
+                    fragDef <- fragmentDefinition definition
+                    case fragDef of
+                        Just fragment -> lift $ pure $ fragment <$ spreadDirectives
+                        _ -> lift $ pure  Nothing
+                | otherwise -> lift $ pure  Nothing
+selection (Full.InlineFragment type' directives' selections) = do
    fragmentDirectives <- Directive.selection <$> directives directives'
    case fragmentDirectives of
        Nothing -> pure $ Left mempty
        _ -> do
-            fragmentSelectionSet <- appendSelection selections objectType
-            pure $ maybe Left selectionFragment type' fragmentSelectionSet
+            fragmentSelectionSet <- appendSelection selections
+
+            case type' of
+                Nothing -> pure $ Left fragmentSelectionSet
+                Just typeName -> do
+                    typeCondition' <- lookupTypeCondition typeName
+                    case typeCondition' of
+                        Just typeCondition -> pure $
+                            selectionFragment typeCondition fragmentSelectionSet
+                        Nothing -> pure $ Left mempty
  where
    selectionFragment typeName = Right
-        . Core.SelectionFragment
-        . Core.Fragment typeName
+        . SelectionFragment
+        . Fragment typeName

 appendSelection :: Traversable t
-    => forall m
-    . t Full.Selection
-    -> Out.ObjectType m
-    -> State (Replacement m) (Seq Core.Selection)
-appendSelection selectionSet objectType = foldM go mempty selectionSet
+    => t Full.Selection
+    ->  State (Replacement m) (Seq (Selection m))
+appendSelection = foldM go mempty
  where
-    go acc sel = append acc <$> selection sel objectType
+    go acc sel = append acc <$> selection sel
    append acc (Left list) = list >< acc
    append acc (Right one) = one <| acc

-directives :: forall m
-    . [Full.Directive]
-    -> State (Replacement m) [Core.Directive]
+directives :: [Full.Directive] ->  State (Replacement m) [Core.Directive]
 directives = traverse directive
  where
    directive (Full.Directive directiveName directiveArguments) =
@ -301,24 +329,40 @@ directives = traverse directive
 -- * Fragment replacement

 -- | Extract fragment definitions into a single 'HashMap'.
-collectFragments :: forall m. Out.ObjectType m -> State (Replacement m) ()
-collectFragments objectType = do
+collectFragments ::  State (Replacement m) ()
+collectFragments = do
    fragDefs <- gets fragmentDefinitions
    let nextValue = head $ HashMap.elems fragDefs
    unless (HashMap.null fragDefs) $ do
-        _ <- fragmentDefinition nextValue objectType
-        collectFragments objectType
+        _ <- fragmentDefinition nextValue
+        collectFragments

-fragmentDefinition :: forall m
-    . Full.FragmentDefinition
-    -> Out.ObjectType m
-    -> State (Replacement m) Core.Fragment
-fragmentDefinition (Full.FragmentDefinition name type' _ selections) objectType = do
+lookupTypeCondition :: Full.Name -> State (Replacement m) (Maybe (CompositeType m))
+lookupTypeCondition type' = do
+    types' <- gets types
+    case HashMap.lookup type' types' of
+        Just (ObjectType objectType) ->
+            lift $ pure $ Just $ CompositeObjectType objectType
+        Just (UnionType unionType) ->
+            lift $ pure $ Just $ CompositeUnionType unionType
+        Just (InterfaceType interfaceType) ->
+            lift $ pure $ Just $ CompositeInterfaceType interfaceType
+        _ -> lift $ pure Nothing
+
+fragmentDefinition
+    :: Full.FragmentDefinition
+    ->  State (Replacement m) (Maybe (Fragment m))
+fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
    modify deleteFragmentDefinition
-    fragmentSelection <- appendSelection selections objectType
-    let newValue = Core.Fragment type' fragmentSelection
-    modify $ insertFragment newValue
-    lift $ pure newValue
+    fragmentSelection <- appendSelection selections
+    compositeType <- lookupTypeCondition type'
+
+    case compositeType of
+        Just compositeType' -> do
+            let newValue = Fragment compositeType' fragmentSelection
+            modify $ insertFragment newValue
+            lift $ pure $ Just newValue
+        _ -> lift $ pure Nothing
  where
    deleteFragmentDefinition replacement@Replacement{..} =
        let newDefinitions = HashMap.delete name fragmentDefinitions
@ -327,27 +371,27 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) objectType
        let newFragments = HashMap.insert name newValue fragments
         in replacement{ fragments = newFragments }

-arguments :: forall m. [Full.Argument] -> State (Replacement m) Core.Arguments
+arguments :: [Full.Argument] -> State (Replacement m) Core.Arguments
 arguments = fmap Core.Arguments . foldM go HashMap.empty
  where
    go arguments' (Full.Argument name value') = do
        substitutedValue <- value value'
        return $ HashMap.insert name substitutedValue arguments'

-value :: forall m. Full.Value -> State (Replacement m) In.Value
+value :: Full.Value -> State (Replacement m) Value
 value (Full.Variable name) =
-    gets $ fromMaybe In.Null . HashMap.lookup name . variableValues
-value (Full.Int i) = pure $ In.Int i
-value (Full.Float f) = pure $ In.Float f
-value (Full.String x) = pure $ In.String x
-value (Full.Boolean b) = pure $ In.Boolean b
-value Full.Null = pure   In.Null
-value (Full.Enum e) = pure $ In.Enum e
-value (Full.List l) = In.List <$> traverse value l
+    gets $ fromMaybe Null . HashMap.lookup name . variableValues
+value (Full.Int i) = pure $ Int i
+value (Full.Float f) = pure $ Float f
+value (Full.String x) = pure $ String x
+value (Full.Boolean b) = pure $ Boolean b
+value Full.Null = pure   Null
+value (Full.Enum e) = pure $ Enum e
+value (Full.List l) = List <$> traverse value l
 value (Full.Object o) =
-    In.Object . HashMap.fromList <$> traverse objectField o
+    Object . HashMap.fromList <$> traverse objectField o

-objectField :: forall m
-    . Full.ObjectField Full.Value
-    -> State (Replacement m) (Core.Name, In.Value)
+objectField
+    :: Full.ObjectField Full.Value
+    -> State (Replacement m) (Full.Name, Value)
 objectField (Full.ObjectField name value') = (name,) <$> value value'
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@ -5,27 +5,24 @@
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Schema
    ( Resolver(..)
-    , Subs
-    , object
    , resolve
-    , resolversToMap
    ) where

 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Except (runExceptT)
 import Control.Monad.Trans.Reader (runReaderT)
-import Data.Foldable (fold, toList)
-import Data.Maybe (fromMaybe)
 import qualified Data.Aeson as Aeson
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Data.Sequence (Seq)
+import qualified Data.Map.Strict as Map
+import Data.Sequence (Seq(..))
 import Data.Text (Text)
-import qualified Data.Text as T
-import Language.GraphQL.AST.Core
+import qualified Data.Text as Text
+import Language.GraphQL.AST.Document (Name)
 import Language.GraphQL.Error
+import Language.GraphQL.Execute.Execution
+import Language.GraphQL.Execute.Transform
 import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type.In as In
+import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.Out as Out

 -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
@ -35,82 +32,74 @@ import qualified Language.GraphQL.Type.Out as Out
 -- Resolving a field can result in a leaf value or an object, which is
 -- represented as a list of nested resolvers, used to resolve the fields of that
 -- object.
-data Resolver m = Resolver Name (ActionT m (Out.Value m))
+data Resolver m = Resolver Name (ActionT m Value)

-- | Converts resolvers to a map.
-resolversToMap :: (Foldable f, Functor f)
-    => forall m
-    . f (Resolver m)
-    -> HashMap Text (ActionT m (Out.Value m))
-resolversToMap = HashMap.fromList . toList . fmap toKV
-  where
-    toKV (Resolver name r) = (name, r)
-
-- | Contains variables for the query. The key of the map is a variable name,
--   and the value is the variable value.
-type Subs = HashMap Name In.Value
-
-- | Create a new 'Resolver' with the given 'Name' from the given
-- Resolver's.
-object :: Monad m => [Resolver m] -> Out.Value m
-object = Out.Object . resolversToMap
-
-resolveFieldValue :: Monad m => Field -> ActionT m a -> m (Either Text a)
-resolveFieldValue field@(Field _ _ args _) =
-    flip runReaderT (Context {arguments=args, info=field})
+resolveFieldValue :: Monad m => Value -> Field m -> ActionT m a -> m (Either Text a)
+resolveFieldValue result (Field _ _ args _) =
+    flip runReaderT (Context {arguments=args, values=result})
    . runExceptT
    . runActionT

-withField :: Monad m
-    => Field
-    -> ActionT m (Out.Value m)
-    -> CollectErrsT m Aeson.Object
-withField field resolver = do
-    answer <- lift $ resolveFieldValue field resolver
+executeField :: Monad m
+    => Value
+    -> Out.Field m
+    -> Field m
+    -> CollectErrsT m Aeson.Value
+executeField prev (Out.Field _ fieldType _ resolver) field = do
+    answer <- lift $ resolveFieldValue prev field resolver
    case answer of
-        Right result -> HashMap.singleton (aliasOrName field)
-            <$> toJSON field result
-        Left errorMessage -> errmsg field errorMessage
+        Right result -> completeValue fieldType field result
+        Left errorMessage -> errmsg errorMessage

-toJSON :: Monad m => Field -> Out.Value m -> CollectErrsT m Aeson.Value
-toJSON _ Out.Null = pure Aeson.Null
-toJSON _ (Out.Int integer) = pure $ Aeson.toJSON integer
-toJSON _ (Out.Boolean boolean) = pure $ Aeson.Bool boolean
-toJSON _ (Out.Float float) = pure $ Aeson.toJSON float
-toJSON _ (Out.Enum enum) = pure $ Aeson.String enum
-toJSON _ (Out.String string) = pure $ Aeson.String string
-toJSON field (Out.List list) = Aeson.toJSON <$> traverse (toJSON field) list
-toJSON (Field _ _ _ seqSelection) (Out.Object map') =
-    map' `resolve` seqSelection
+completeValue :: Monad m
+    => Out.Type m
+    -> Field m
+    -> Value
+    -> CollectErrsT m Aeson.Value
+completeValue _ _ Null = pure Aeson.Null
+completeValue _ _ (Int integer) = pure $ Aeson.toJSON integer
+completeValue _ _ (Boolean boolean') = pure $ Aeson.Bool boolean'
+completeValue _ _ (Float float') = pure $ Aeson.toJSON float'
+completeValue _ _ (Enum enum) = pure $ Aeson.String enum
+completeValue _ _ (String string') = pure $ Aeson.String string'
+completeValue (Out.ObjectBaseType objectType) (Field _ _ _ seqSelection) result =
+    resolve result objectType seqSelection
+completeValue (Out.ListBaseType listType) selectionField (List list) =
+    Aeson.toJSON <$> traverse (completeValue listType selectionField) list
+completeValue _ _ _ = errmsg "Value completion failed."

-errmsg :: Monad m => Field -> Text -> CollectErrsT m (HashMap Text Aeson.Value)
-errmsg field errorMessage = do
-    addErrMsg errorMessage
-    pure $ HashMap.singleton (aliasOrName field) Aeson.Null
+errmsg :: Monad m => Text -> CollectErrsT m Aeson.Value
+errmsg errorMessage = addErrMsg errorMessage >> pure Aeson.Null

 -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
 -- 'Resolver' to each 'Field'. Resolves into a value containing the
 -- resolved 'Field', or a null value and error information.
-resolve :: Monad m
-    => HashMap Text (ActionT m (Out.Value m))
-    -> Seq Selection
+resolve :: Monad m -- executeSelectionSet
+    => Value
+    -> Out.ObjectType m
+    -> Seq (Selection m)
    -> CollectErrsT m Aeson.Value
-resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
+resolve result objectType@(Out.ObjectType _ _ _ resolvers) selectionSet = do
+    resolvedValues <- Map.traverseMaybeWithKey forEach
+        $ collectFields objectType selectionSet
+    pure $ Aeson.toJSON resolvedValues
  where
+    forEach _responseKey (field :<| _) =
+        tryResolvers field >>= lift . pure . pure
+    forEach _ _ = pure Nothing
    lookupResolver = flip HashMap.lookup resolvers
-    tryResolvers (SelectionField fld@(Field _ name _ _))
-        | (Just resolver) <- lookupResolver name = withField fld resolver
-        | otherwise = errmsg fld $ T.unwords ["field", name, "not resolved."]
-    tryResolvers (SelectionFragment (Fragment typeCondition selections'))
-        | Just resolver <- lookupResolver "__typename" = do
-            let fakeField = Field Nothing "__typename" mempty mempty
-            that <- lift $ resolveFieldValue fakeField resolver
+    tryResolvers fld@(Field _ name _ _)
+        | Just typeField <- lookupResolver name =
+            executeField result typeField fld
+        | otherwise = errmsg $ Text.unwords ["field", name, "not resolved."]
+    {-tryResolvers (Out.SelectionFragment (Out.Fragment typeCondition selections'))
+        | Just (Out.Field _ _ _ resolver) <- lookupResolver "__typename" = do
+            let fakeField = Out.Field Nothing "__typename" mempty mempty
+            that <- lift $ resolveFieldValue result fakeField resolver
            case that of
-                Right (Out.String typeCondition')
-                    | typeCondition' == typeCondition ->
+                Right (String typeCondition')
+                    | (Out.CompositeObjectType (Out.ObjectType n _ _ _)) <- typeCondition
+                    , typeCondition' == n ->
                        fmap fold . traverse tryResolvers $ selections'
                _ -> pure mempty
-        | otherwise = fmap fold . traverse tryResolvers $ selections'
-
-aliasOrName :: Field -> Text
-aliasOrName (Field alias name _ _) = fromMaybe name alias
+        | otherwise = fmap fold . traverse tryResolvers $ selections'-}
--- a/src/Language/GraphQL/Trans.hs
+++ b/src/Language/GraphQL/Trans.hs
@ -1,8 +1,8 @@
 -- | Monad transformer stack used by the @GraphQL@ resolvers.
 module Language.GraphQL.Trans
-    ( ActionT(..)
+    ( argument
+    , ActionT(..)
    , Context(..)
-    , argument
    ) where

 import Control.Applicative (Alternative(..))
@ -15,13 +15,13 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Language.GraphQL.AST.Core
-import qualified Language.GraphQL.Type.In as In
+import Language.GraphQL.Type.Definition
 import Prelude hiding (lookup)

 -- | Resolution context holds resolver arguments.
 data Context = Context
    { arguments :: Arguments
-    , info :: Field
+    , values :: Value
    }

 -- | Monad transformer stack used by the resolvers to provide error handling
@ -56,11 +56,11 @@ instance Monad m => MonadPlus (ActionT m) where
    mplus = (<|>)

 -- | Retrieves an argument by its name. If the argument with this name couldn't
--   be found, returns 'In.Null' (i.e. the argument is assumed to
+--   be found, returns 'Null' (i.e. the argument is assumed to
 --   be optional then).
-argument :: Monad m => Name -> ActionT m In.Value
+argument :: Monad m => Name -> ActionT m Value
 argument argumentName = do
    argumentValue <- ActionT $ lift $ asks $ lookup . arguments
-    pure $ fromMaybe In.Null argumentValue
+    pure $ fromMaybe Null argumentValue
  where
    lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@ -4,6 +4,8 @@
 module Language.GraphQL.Type.Definition
    ( EnumType(..)
    , ScalarType(..)
+    , Subs
+    , Value(..)
    , boolean
    , float
    , id
@ -11,11 +13,33 @@ module Language.GraphQL.Type.Definition
    , string
    ) where

+import Data.Int (Int32)
+import Data.HashMap.Strict (HashMap)
 import Data.Set (Set)
+import Data.String (IsString(..))
 import Data.Text (Text)
 import Language.GraphQL.AST.Document (Name)
 import Prelude hiding (id)

+-- | Represents accordingly typed GraphQL values.
+data Value
+    = Int Int32
+    | Float Double -- ^ GraphQL Float is double precision.
+    | String Text
+    | Boolean Bool
+    | Null
+    | Enum Name
+    | List [Value] -- ^ Arbitrary nested list.
+    | Object (HashMap Name Value)
+    deriving (Eq, Show)
+
+instance IsString Value where
+    fromString = String . fromString
+
+-- | Contains variables for the query. The key of the map is a variable name,
+--   and the value is the variable value.
+type Subs = HashMap Name Value
+
 -- | Scalar type definition.
 --
 -- The leaf values of any request and input values to arguments are Scalars (or
--- a/src/Language/GraphQL/Type/Directive.hs
+++ b/src/Language/GraphQL/Type/Directive.hs
@ -1,12 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}

 module Language.GraphQL.Type.Directive
-    ( selection
+    ( Directive(..)
+    , selection
    ) where

 import qualified Data.HashMap.Strict as HashMap
 import Language.GraphQL.AST.Core
-import qualified Language.GraphQL.Type.In as In
+import Language.GraphQL.Type.Definition
+
+-- | Directive.
+data Directive = Directive Name Arguments
+    deriving (Eq, Show)

 -- | Directive processing status.
 data Status
@ -37,7 +42,7 @@ skip = handle skip'
  where
    skip' directive'@(Directive "skip" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
-            (Just (In.Boolean True)) -> Skip
+            (Just (Boolean True)) -> Skip
            _ -> Include directive'
    skip' directive' = Continue directive'

@ -46,6 +51,6 @@ include = handle include'
  where
    include' directive'@(Directive "include" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
-            (Just (In.Boolean True)) -> Include directive'
+            (Just (Boolean True)) -> Include directive'
            _ -> Skip
    include' directive' = Continue directive'
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@ -10,7 +10,6 @@ module Language.GraphQL.Type.In
    , InputField(..)
    , InputObjectType(..)
    , Type(..)
-    , Value(..)
    , isNonNullType
    , pattern EnumBaseType
    , pattern ListBaseType
@ -19,8 +18,6 @@ module Language.GraphQL.Type.In
    ) where

 import Data.HashMap.Strict (HashMap)
-import Data.Int (Int32)
-import Data.String (IsString(..))
 import Data.Text (Text)
 import Language.GraphQL.AST.Document (Name)
 import Language.GraphQL.Type.Definition
@ -36,6 +33,10 @@ data InputObjectType = InputObjectType
    Name (Maybe Text) (HashMap Name InputField)

 -- | These types may be used as input types for arguments and directives.
+--
+-- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
+-- type can wrap other wrapping or named types. Wrapping types are lists and
+-- Non-Null types (named types are nullable by default).
 data Type
    = NamedScalarType ScalarType
    | NamedEnumType EnumType
@ -46,21 +47,6 @@ data Type
    | NonNullInputObjectType InputObjectType
    | NonNullListType Type

-- | Represents accordingly typed GraphQL values.
-data Value
-    = Int Int32
-    | Float Double -- ^ GraphQL Float is double precision
-    | String Text
-    | Boolean Bool
-    | Null
-    | Enum Name
-    | List [Value]
-    | Object (HashMap Name Value)
-    deriving (Eq, Show)
-
-instance IsString Value where
-    fromString = String . fromString
-
 -- | Field argument definition.
 data Argument = Argument (Maybe Text) Type (Maybe Value)

--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@ -1,5 +1,4 @@
 {-# LANGUAGE ExplicitForAll #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}

@ -13,7 +12,6 @@ module Language.GraphQL.Type.Out
    , ObjectType(..)
    , Type(..)
    , UnionType(..)
-    , Value(..)
    , isNonNullType
    , pattern EnumBaseType
    , pattern InterfaceBaseType
@ -24,12 +22,8 @@ module Language.GraphQL.Type.Out
    ) where

 import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import Data.Int (Int32)
-import Data.String (IsString(..))
 import Data.Text (Text)
-import qualified Data.Text as Text
-import Language.GraphQL.AST.Document (Name)
+import Language.GraphQL.AST.Core
 import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
@ -60,9 +54,13 @@ data Field m = Field
    (Maybe Text) -- ^ Description.
    (Type m) -- ^ Field type.
    (HashMap Name In.Argument) -- ^ Arguments.
-    (ActionT m (Value m)) -- ^ Resolver.
+    (ActionT m Value) -- ^ Resolver.

 -- | These types may be used as output types as the result of fields.
+--
+-- GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
+-- type can wrap other wrapping or named types. Wrapping types are lists and
+-- Non-Null types (named types are nullable by default).
 data Type m
    = NamedScalarType ScalarType
    | NamedEnumType EnumType
@ -77,48 +75,6 @@ data Type m
    | NonNullUnionType (UnionType m)
    | NonNullListType (Type m)

-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping
-- type can wrap other wrapping or named types. Wrapping types are lists and
-- Non-Null types (named types are nullable by default).
--
-- This 'Value' type doesn\'t reflect this distinction exactly but it is used
-- in the resolvers to take into account that the returned value can be nullable
-- or an (arbitrary nested) list.
-data Value m
-    = Int Int32
-    | Float Double
-    | String Text
-    | Boolean Bool
-    | Null
-    | Enum Name
-    | List [Value m] -- ^ Arbitrary nested list.
-    | Object (HashMap Name (ActionT m (Value m)))
-
-instance IsString (Value m) where
-    fromString = String . fromString
-
-instance Show (Value m) where
-    show (Int integer) = "Int " ++ show integer
-    show (Float float') = "Float " ++ show float'
-    show (String text) = Text.unpack $ "String " <> text
-    show (Boolean True) = "Boolean True"
-    show (Boolean False) = "Boolean False"
-    show Null = "Null"
-    show (Enum enum) = Text.unpack $ "Enum " <> enum
-    show (List list) = show list
-    show (Object object) = Text.unpack
-        $ "Object [" <> Text.intercalate ", " (HashMap.keys object) <> "]"
-
-instance Eq (Value m) where
-    (Int this) == (Int that) = this == that
-    (Float this) == (Float that) = this == that
-    (String this) == (String that) = this == that
-    (Boolean this) == (Boolean that) = this == that
-    (Enum this) == (Enum that) = this == that
-    (List this) == (List that) = this == that
-    (Object this) == (Object that) = HashMap.keys this == HashMap.keys that
-    _ == _ = False
-
 -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
 pattern ScalarBaseType :: forall m. ScalarType -> Type m
 pattern ScalarBaseType scalarType <- (isScalarType -> Just scalarType)
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@ -2,14 +2,15 @@

 -- | Schema Definition.
 module Language.GraphQL.Type.Schema
-    ( Schema(..)
+    ( CompositeType(..)
+    , Schema(..)
    , Type(..)
    , collectReferencedTypes
    ) where

 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Language.GraphQL.AST.Core (Name)
+import Language.GraphQL.AST.Document (Name)
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.In as In
 import qualified Language.GraphQL.Type.Out as Out
@ -23,6 +24,12 @@ data Type m
    | InterfaceType (Out.InterfaceType m)
    | UnionType (Out.UnionType m)

+-- | These types may describe the parent context of a selection set.
+data CompositeType m
+    = CompositeUnionType (Out.UnionType m)
+    | CompositeObjectType (Out.ObjectType m)
+    | CompositeInterfaceType (Out.InterfaceType m)
+
 -- | A Schema is created by supplying the root types of each type of operation,
 --   query and mutation (optional). A schema definition is then supplied to the
 --   validator and executor.