From 93a04032886976b540f5fdb1417bd085a642f772 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Wed, 3 Jun 2020 07:20:38 +0200
Subject: Resolve abstract types

Objects that can be a part of an union or interface should return
__typename as string.
---
 src/Language/GraphQL/Type/Out.hs    | 13 +++++++++++--
 src/Language/GraphQL/Type/Schema.hs | 23 ++++++++++++++++-------
 2 files changed, 27 insertions(+), 9 deletions(-)

(limited to 'src/Language/GraphQL/Type')

diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs
index 4808d09..acd348c 100644
--- a/src/Language/GraphQL/Type/Out.hs
+++ b/src/Language/GraphQL/Type/Out.hs
@@ -10,6 +10,7 @@ module Language.GraphQL.Type.Out
     ( Field(..)
     , InterfaceType(..)
     , ObjectType(..)
+    , Resolver(..)
     , Type(..)
     , UnionType(..)
     , isNonNullType
@@ -27,13 +28,22 @@ import Language.GraphQL.AST.Core
 import Language.GraphQL.Trans
 import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type.In as In
+
+-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
+-- information (if an error has occurred). @m@ is an arbitrary monad, usually
+-- 'IO'.
 --
+-- 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 (Field m) (ActionT m Value)
+
 -- | Object type definition.
 --
 --   Almost all of the GraphQL types you define will be object types. Object
 --   types have a name, but most importantly describe their fields.
 data ObjectType m = ObjectType
-    Name (Maybe Text) [InterfaceType m] (HashMap Name (Field m))
+    Name (Maybe Text) [InterfaceType m] (HashMap Name (Resolver m))
 
 -- | Interface Type Definition.
 --
@@ -54,7 +64,6 @@ data Field m = Field
     (Maybe Text) -- ^ Description.
     (Type m) -- ^ Field type.
     (HashMap Name In.Argument) -- ^ Arguments.
-    (ActionT m Value) -- ^ Resolver.
 
 -- | These types may be used as output types as the result of fields.
 --
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
index b6055c5..ff7b5cc 100644
--- a/src/Language/GraphQL/Type/Schema.hs
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE ExplicitForAll #-}
 
--- | Schema Definition.
+-- | This module provides a representation of a @GraphQL@ Schema in addition to
+-- functions for defining and manipulating schemas.
 module Language.GraphQL.Type.Schema
-    ( CompositeType(..)
+    ( AbstractType(..)
+    , CompositeType(..)
     , Schema(..)
     , Type(..)
     , collectReferencedTypes
@@ -30,6 +32,11 @@ data CompositeType m
     | CompositeObjectType (Out.ObjectType m)
     | CompositeInterfaceType (Out.InterfaceType m)
 
+-- | These types may describe the parent context of a selection set.
+data AbstractType m
+    = AbstractUnionType (Out.UnionType m)
+    | AbstractInterfaceType (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.
@@ -51,7 +58,7 @@ collectReferencedTypes schema =
     collect traverser typeName element foundTypes
         | HashMap.member typeName foundTypes = foundTypes
         | otherwise = traverser $ HashMap.insert typeName element foundTypes
-    visitFields (Out.Field _ outputType arguments _) foundTypes
+    visitFields (Out.Field _ outputType arguments) foundTypes
         = traverseOutputType outputType
         $ foldr visitArguments foundTypes arguments
     visitArguments (In.Argument _ inputType _) = traverseInputType inputType
@@ -86,15 +93,17 @@ collectReferencedTypes schema =
         let (Definition.EnumType typeName _ _) = enumType
          in collect Prelude.id typeName (EnumType enumType)
     traverseObjectType objectType foundTypes =
-        let (Out.ObjectType typeName _ interfaces fields) = objectType
+        let (Out.ObjectType typeName _ interfaces resolvers) = objectType
             element = ObjectType objectType
-            traverser = polymorphicTypeTraverser interfaces fields
+            fields = extractObjectField <$> resolvers
+            traverser = polymorphicTraverser interfaces fields
          in collect traverser typeName element foundTypes
     traverseInterfaceType interfaceType foundTypes =
         let (Out.InterfaceType typeName _ interfaces fields) = interfaceType
             element = InterfaceType interfaceType
-            traverser = polymorphicTypeTraverser interfaces fields
+            traverser = polymorphicTraverser interfaces fields
          in collect traverser typeName element foundTypes
-    polymorphicTypeTraverser interfaces fields
+    polymorphicTraverser interfaces fields
         = flip (foldr visitFields) fields
         . flip (foldr traverseInterfaceType) interfaces
+    extractObjectField (Out.Resolver field _) = field
-- 
cgit v1.2.3