From b9d5b1fb1bdf634137f463186585bc51e540353b Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 19 Jul 2020 07:36:06 +0200
Subject: Return a stream as well from graphql* functions

---
 src/Language/GraphQL.hs | 23 ++++++++++-------------
 1 file changed, 10 insertions(+), 13 deletions(-)

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

diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 1b8c562..be375ed 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -10,7 +10,7 @@ module Language.GraphQL
 import Control.Monad.Catch (MonadCatch)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
-import Data.Either (fromRight)
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Sequence as Seq
 import Data.Text (Text)
 import Language.GraphQL.AST
@@ -24,7 +24,7 @@ import Text.Megaparsec (parse)
 graphql :: MonadCatch m
     => Schema m -- ^ Resolvers.
     -> Text -- ^ Text representing a @GraphQL@ request document.
-    -> m Aeson.Value -- ^ Response.
+    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
 graphql schema = graphqlSubs schema mempty mempty
 
 -- | If the text parses correctly as a @GraphQL@ query the substitution is
@@ -35,18 +35,15 @@ graphqlSubs :: MonadCatch m
     -> Maybe Text -- ^ Operation name.
     -> Aeson.Object -- ^ Variable substitution function.
     -> Text -- ^ Text representing a @GraphQL@ request document.
-    -> m Aeson.Value -- ^ Response.
-graphqlSubs schema operationName variableValues document'
-    = either parseError executeRequest (parse document "" document')
-    >>= formatResponse
+    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
+graphqlSubs schema operationName variableValues document' =
+    case parse document "" document' of
+        Left errorBundle -> pure . formatResponse <$> parseError errorBundle
+        Right parsed -> fmap formatResponse
+            <$> execute schema operationName variableValues parsed
   where
-    executeRequest parsed
-      = fromRight streamReturned
-      <$> execute schema operationName variableValues parsed
-    streamReturned = singleError "This service does not support subscriptions."
-    formatResponse (Response data'' Seq.Empty) =
-        pure $ Aeson.object [("data", data'')]
-    formatResponse (Response data'' errors') = pure $ Aeson.object
+    formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
+    formatResponse (Response data'' errors') = HashMap.fromList
         [ ("data", data'')
         , ("errors", Aeson.toJSON $ fromError <$> errors')
         ]
-- 
cgit v1.2.3