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.
---
 tests/Test/FragmentSpec.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

(limited to 'tests/Test/FragmentSpec.hs')

diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 94cc76c..af1812c 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -64,12 +64,14 @@ hatType = Out.ObjectType "Hat" Nothing []
         , ("circumference", circumferenceFieldType)
         ]
 
-circumferenceFieldType :: Out.Field IO
-circumferenceFieldType = Out.Field Nothing (Out.NamedScalarType int) mempty
+circumferenceFieldType :: Out.Resolver IO
+circumferenceFieldType
+    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType int) mempty)
     $ pure $ snd circumference
 
-sizeFieldType :: Out.Field IO
-sizeFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+sizeFieldType :: Out.Resolver IO
+sizeFieldType
+    = Out.ValueResolver (Out.Field Nothing (Out.NamedScalarType string) mempty)
     $ pure $ snd size
 
 toSchema :: Text -> (Text, Value) -> Schema IO
@@ -78,17 +80,15 @@ toSchema t (_, resolve) = Schema
   where
     unionMember = if t == "Hat" then hatType else shirtType
     typeNameField = Out.Field Nothing (Out.NamedScalarType string) mempty
-        $ pure $ String "Shirt"
     garmentField = Out.Field Nothing (Out.NamedObjectType unionMember) mempty
-        $ pure resolve
     queryType =
         case t of
             "circumference" -> hatType
             "size" -> shirtType
             _ -> Out.ObjectType "Query" Nothing []
                 $ HashMap.fromList
-                    [ ("garment", garmentField)
-                    , ("__typename", typeNameField)
+                    [ ("garment", ValueResolver garmentField (pure resolve))
+                    , ("__typename", ValueResolver typeNameField (pure $ String "Shirt"))
                     ]
 
 spec :: Spec
-- 
cgit v1.2.3