From 3be86bf69e0825c2df65862479d663b08f60e8ce Mon Sep 17 00:00:00 2001
From: Lupino <lmjubuntu@gmail.com>
Date: Thu, 23 Feb 2017 11:03:08 +0800
Subject: [PATCH] Enable Monad for array and object resolver

When I use facebook/haxl, I can not find any way to the sub resolver.
so I add Monad resolver to support it.
---
 Data/GraphQL/Schema.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs
index b8668d9..d9689e9 100644
--- a/Data/GraphQL/Schema.hs
+++ b/Data/GraphQL/Schema.hs
@@ -7,11 +7,15 @@ module Data.GraphQL.Schema
   , Resolver
   , Subs
   , object
+  , object'
   , objectA
+  , objectA'
   , scalar
   , scalarA
   , array
+  , array'
   , arrayA
+  , arrayA'
   , enum
   , enumA
   , resolvers
@@ -61,6 +65,21 @@ objectA
 objectA name f fld@(Field _ _ args _ sels) =
     withField name (resolvers (f args) $ fields sels) fld
 
+-- | Create a named 'Resolver' from a list of 'Resolver's.
+object' :: (Alternative f, Monad f)=> Text -> f [Resolver f] -> Resolver f
+object' name resolvs = objectA' name $ \case
+     [] -> resolvs
+     _  -> empty
+
+-- | Like 'object'' but also taking 'Argument's.
+objectA'
+  :: (Alternative f, Monad f)
+  => Text -> ([Argument] -> f [Resolver f]) -> Resolver f
+objectA' name f fld@(Field _ _ args _ sels) = do
+    resolvs <- f args
+    withField name (resolvers resolvs $ fields sels) fld
+
+
 -- | A scalar represents a primitive value, like a string or an integer.
 scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f
 scalar name s = scalarA name $ \case
@@ -87,6 +106,20 @@ arrayA
 arrayA name f fld@(Field _ _ args _ sels) =
      withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ f args) fld
 
+-- | Like 'object'' but taking lists of 'Resolver's instead of a single list.
+array' :: (Alternative f, Monad f) => Text -> f [[Resolver f]] -> Resolver f
+array' name resolvs = arrayA' name $ \case
+    [] -> resolvs
+    _  -> empty
+
+-- | Like 'array'' but also taking 'Argument's.
+arrayA'
+  :: (Alternative f, Monad f)
+  => Text -> ([Argument] -> f [[Resolver f]]) -> Resolver f
+arrayA' name f fld@(Field _ _ args _ sels) = do
+     resolvs <- f args
+     withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ resolvs) fld
+
 -- | Represents one of a finite set of possible values.
 --   Used in place of a 'scalar' when the possible responses are easily enumerable.
 enum :: Alternative f => Text -> f [Text] -> Resolver f