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.

1 files changed, 58 insertions, 0 deletions

diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs
new file mode 100644
index 0000000..117df30
--- /dev/null
+++ 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