From ae2210f6598f166116abebc1163e1523d3bc627c Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 14 Jul 2020 19:37:56 +0200
Subject: Support subscriptions

This is experimental support.
The implementation is based on conduit and is boring. There is a new
resolver data constructor that should create a source event stream. The
executor receives the events, pipes them through the normal execution
and puts them into the response stream which is returned to the user.

- Tests are missing.
- The executor should check field value resolver on subscription types.
- The graphql function should probably return (Either
  ResponseEventStream Response), but I'm not sure about this. It will
  make the usage more complicated if no subscriptions are involved, but
  with the current API implementing subscriptions is more
  difficult than it should be.
---
 src/Language/GraphQL/Execute.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

(limited to 'src/Language/GraphQL/Execute.hs')

diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 471cd00..08aa5ab 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -7,13 +7,13 @@ module Language.GraphQL.Execute
     ) where
 
 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 (Document, Name)
 import Language.GraphQL.Execute.Coerce
 import Language.GraphQL.Execute.Execution
 import qualified Language.GraphQL.Execute.Transform as Transform
+import qualified Language.GraphQL.Execute.Subscribe as Subscribe
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Type.Definition as Definition
 import qualified Language.GraphQL.Type.Out as Out
@@ -28,24 +28,28 @@ import Language.GraphQL.Type.Schema
 execute :: (Monad m, VariableValue a, Serialize b)
     => Schema m -- ^ Resolvers.
     -> Maybe Text -- ^ Operation name.
-    -> HashMap.HashMap Name a -- ^ Variable substitution function.
+    -> HashMap Name a -- ^ Variable substitution function.
     -> Document -- @GraphQL@ document.
-    -> m (Response b)
+    -> m (Either (ResponseEventStream m b) (Response b))
 execute schema operationName subs document =
     case Transform.document schema operationName subs document of
-        Left queryError -> pure $ singleError $ Transform.queryError queryError
+        Left queryError -> pure
+            $ Right
+            $ singleError
+            $ Transform.queryError queryError
         Right transformed -> executeRequest transformed
 
 executeRequest :: (Monad m, Serialize a)
     => Transform.Document m
-    -> m (Response a)
+    -> m (Either (ResponseEventStream m a) (Response a))
 executeRequest (Transform.Document types' rootObjectType operation)
     | (Transform.Query _ fields) <- operation =
-        executeOperation types' rootObjectType fields
+        Right <$> executeOperation types' rootObjectType fields
     | (Transform.Mutation _ fields) <- operation =
-        executeOperation types' rootObjectType fields
-    | otherwise =
-        pure $ singleError "This service does not support subscriptions."
+        Right <$> executeOperation types' rootObjectType fields
+    | (Transform.Subscription _ fields) <- operation
+        = either (Right . singleError) Left
+        <$> Subscribe.subscribe types' rootObjectType fields
 
 -- This is actually executeMutation, but we don't distinguish between queries
 -- and mutations yet.
-- 
cgit v1.2.3