1 files changed, 69 insertions, 27 deletions
diff --git a/tests/Language/GraphQL/ExecuteSpec.hs b/tests/Language/GraphQL/ExecuteSpec.hs
index f994482..7aab6c5 100644
--- a/tests/Language/GraphQL/ExecuteSpec.hs
+++ b/tests/Language/GraphQL/ExecuteSpec.hs
@@ -1,3 +1,7 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   v. 2.0. If a copy of the MPL was not distributed with this file, You can
+   obtain one at https://mozilla.org/MPL/2.0/. -}
+
 {-# LANGUAGE OverloadedStrings #-}
 module Language.GraphQL.ExecuteSpec
     ( spec
@@ -5,6 +9,7 @@ module Language.GraphQL.ExecuteSpec
 
 import Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
+import Data.Conduit
 import Data.Either (fromRight)
 import Data.Functor.Identity (Identity(..))
 import Data.HashMap.Strict (HashMap)
@@ -15,11 +20,15 @@ import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import Language.GraphQL.Type as Type
 import Language.GraphQL.Type.Out as Out
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Hspec (Spec, context, describe, it, shouldBe)
 import Text.Megaparsec (parse)
 
 schema :: Schema Identity
-schema = Schema {query = queryType, mutation = Nothing}
+schema = Schema
+    { query = queryType
+    , mutation = Nothing
+    , subscription = Just subscriptionType
+    }
 
 queryType :: Out.ObjectType Identity
 queryType = Out.ObjectType "Query" Nothing []
@@ -45,33 +54,66 @@ philosopherType = Out.ObjectType "Philosopher" Nothing []
         = Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
     lastNameResolver = pure $ Type.String "Nietzsche"
 
+subscriptionType :: Out.ObjectType Identity
+subscriptionType = Out.ObjectType "Subscription" Nothing []
+    $ HashMap.singleton "newQuote"
+    $ EventStreamResolver quoteField (pure $ Type.Object mempty)
+    $ pure $ yield $ Type.Object mempty
+  where
+    quoteField =
+        Out.Field Nothing (Out.NonNullObjectType quoteType) HashMap.empty
+
+quoteType :: Out.ObjectType Identity
+quoteType = Out.ObjectType "Quote" Nothing []
+    $ HashMap.singleton "quote"
+    $ ValueResolver quoteField
+    $ pure "Naturam expelles furca, tamen usque recurret."
+  where
+    quoteField =
+        Out.Field Nothing (Out.NonNullScalarType string) HashMap.empty
+
 spec :: Spec
 spec =
     describe "execute" $ do
-        it "skips unknown fields" $
-            let data'' = Aeson.object
-                    [ "philosopher" .= Aeson.object
-                        [ "firstName" .= ("Friedrich" :: String)
+        context "Query" $ do
+            it "skips unknown fields" $
+                let data'' = Aeson.object
+                        [ "philosopher" .= Aeson.object
+                            [ "firstName" .= ("Friedrich" :: String)
+                            ]
+                        ]
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    actual = fromRight (singleError "")
+                        $ runIdentity
+                        $ either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher { firstName surname } }"
+                in actual `shouldBe` expected
+            it "merges selections" $
+                let data'' = Aeson.object
+                        [ "philosopher" .= Aeson.object
+                            [ "firstName" .= ("Friedrich" :: String)
+                            , "lastName" .= ("Nietzsche" :: String)
+                            ]
                         ]
-                    ]
-                expected = Response data'' mempty
-                execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
-                actual = fromRight (singleError "")
-                    $ runIdentity
-                    $ either (pure . parseError) execute'
-                    $ parse document "" "{ philosopher { firstName surname } }"
-             in actual `shouldBe` expected
-        it "merges selections" $
-            let data'' = Aeson.object
-                    [ "philosopher" .= Aeson.object
-                        [ "firstName" .= ("Friedrich" :: String)
-                        , "lastName" .= ("Nietzsche" :: String)
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    actual = fromRight (singleError "")
+                        $ runIdentity
+                        $ either (pure . parseError) execute'
+                        $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
+                in actual `shouldBe` expected
+        context "Subscription" $
+            it "subscribes" $
+                let data'' = Aeson.object
+                        [ "newQuote" .= Aeson.object
+                            [ "quote" .= ("Naturam expelles furca, tamen usque recurret." :: String)
+                            ]
                         ]
-                    ]
-                expected = Response data'' mempty
-                execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
-                actual = fromRight (singleError "")
-                    $ runIdentity
-                    $ either (pure . parseError) execute'
-                    $ parse document "" "{ philosopher { firstName } philosopher { lastName } }"
-             in actual `shouldBe` expected
+                    expected = Response data'' mempty
+                    execute' = execute schema Nothing (mempty :: HashMap Name Aeson.Value)
+                    Left stream = runIdentity
+                        $ either (pure . parseError) execute'
+                        $ parse document "" "subscription { newQuote { quote } }"
+                    Just actual = runConduitPure $ stream .| await
+                in actual `shouldBe` expected