Add basic output object type support

6 files changed, 126 insertions, 111 deletions

diff --git a/tests/Test/DirectiveSpec.hs b/tests/Test/DirectiveSpec.hs
index b4cf364..f39c9c0 100644
--- a/tests/Test/DirectiveSpec.hs
+++ b/tests/Test/DirectiveSpec.hs
@@ -5,18 +5,22 @@ module Test.DirectiveSpec
     ) where
 
 import Data.Aeson (Value(..), object, (.=))
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema (Schema(..))
 import Test.Hspec (Spec, describe, it, shouldBe)
 import Text.RawString.QQ (r)
 
-experimentalResolver :: HashMap Text (NonEmpty (Schema.Resolver IO))
-experimentalResolver = HashMap.singleton "Query"
-    $ Schema.scalar "experimentalField" (pure (5 :: Int)) :| []
+experimentalResolver :: Schema IO
+experimentalResolver = Schema { query = queryType, mutation = Nothing }
+  where
+    queryType = ObjectType "Query"
+        $ HashMap.singleton "experimentalField"
+        $ Schema.ValueResolver
+        $ pure
+        $ Number 5
 
 emptyObject :: Value
 emptyObject = object
@@ -27,17 +31,17 @@ spec :: Spec
 spec =
     describe "Directive executor" $ do
         it "should be able to @skip fields" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 experimentalField @skip(if: true)
               }
             |]
 
-            actual <- graphql experimentalResolver query
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldBe` emptyObject
 
         it "should not skip fields if @skip is false" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 experimentalField @skip(if: false)
               }
@@ -48,21 +52,21 @@ spec =
                         ]
                     ]
 
-            actual <- graphql experimentalResolver query
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldBe` expected
 
         it "should skip fields if @include is false" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 experimentalField @include(if: false)
               }
             |]
 
-            actual <- graphql experimentalResolver query
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldBe` emptyObject
 
         it "should be able to @skip a fragment spread" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 ...experimentalFragment @skip(if: true)
               }
@@ -72,11 +76,11 @@ spec =
               }
             |]
 
-            actual <- graphql experimentalResolver query
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldBe` emptyObject
 
         it "should be able to @skip an inline fragment" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 ... on ExperimentalType @skip(if: true) {
                   experimentalField
@@ -84,5 +88,5 @@ spec =
               }
             |]
 
-            actual <- graphql experimentalResolver query
+            actual <- graphql experimentalResolver sourceQuery
             actual `shouldBe` emptyObject
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 99c0715..879a9b7 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -10,13 +10,16 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Text (Text)
 import Language.GraphQL
 import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec ( Spec
-                  , describe
-                  , it
-                  , shouldBe
-                  , shouldSatisfy
-                  , shouldNotSatisfy
-                  )
+import Test.Hspec
+    ( Spec
+    , describe
+    , it
+    , shouldBe
+    , shouldSatisfy
+    , shouldNotSatisfy
+    )
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
 import Text.RawString.QQ (r)
 
 size :: Schema.Resolver IO
@@ -47,11 +50,18 @@ hasErrors :: Value -> Bool
 hasErrors (Object object') = HashMap.member "errors" object'
 hasErrors _ = True
 
+toSchema :: Schema.Resolver IO -> Schema IO
+toSchema resolver = Schema { query = queryType, mutation = Nothing }
+  where
+    queryType = ObjectType "Query"
+        $ Schema.resolversToMap
+        $ resolver :| []
+
 spec :: Spec
 spec = do
     describe "Inline fragment executor" $ do
         it "chooses the first selection if the type matches" $ do
-            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) inlineQuery
+            actual <- graphql (toSchema $ garment "Hat") inlineQuery
             let expected = object
                     [ "data" .= object
                         [ "garment" .= object
@@ -62,7 +72,7 @@ spec = do
              in actual `shouldBe` expected
 
         it "chooses the last selection if the type matches" $ do
-            actual <- graphql (HashMap.singleton "Query" $ garment "Shirt" :| []) inlineQuery
+            actual <- graphql (toSchema $ garment "Shirt") inlineQuery
             let expected = object
                     [ "data" .= object
                         [ "garment" .= object
@@ -73,7 +83,7 @@ spec = do
              in actual `shouldBe` expected
 
         it "embeds inline fragments without type" $ do
-            let query = [r|{
+            let sourceQuery = [r|{
               garment {
                 circumference
                 ... {
@@ -83,7 +93,7 @@ spec = do
             }|]
                 resolvers = Schema.object "garment" $ return [circumference,  size]
 
-            actual <- graphql (HashMap.singleton "Query" $ resolvers :| []) query
+            actual <- graphql (toSchema resolvers) sourceQuery
             let expected = object
                     [ "data" .= object
                         [ "garment" .= object
@@ -95,18 +105,18 @@ spec = do
              in actual `shouldBe` expected
 
         it "evaluates fragments on Query" $ do
-            let query = [r|{
+            let sourceQuery = [r|{
               ... {
                 size
               }
             }|]
 
-            actual <- graphql (HashMap.singleton "Query" $ size :| []) query
+            actual <- graphql (toSchema size) sourceQuery
             actual `shouldNotSatisfy` hasErrors
 
     describe "Fragment spread executor" $ do
         it "evaluates fragment spreads" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 ...circumferenceFragment
               }
@@ -116,7 +126,7 @@ spec = do
               }
             |]
 
-            actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
+            actual <- graphql (toSchema circumference) sourceQuery
             let expected = object
                     [ "data" .= object
                         [ "circumference" .= (60 :: Int)
@@ -125,7 +135,7 @@ spec = do
              in actual `shouldBe` expected
 
         it "evaluates nested fragments" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 garment {
                   ...circumferenceFragment
@@ -141,7 +151,7 @@ spec = do
               }
             |]
 
-            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
+            actual <- graphql (toSchema $ garment "Hat") sourceQuery
             let expected = object
                     [ "data" .= object
                         [ "garment" .= object
@@ -152,7 +162,7 @@ spec = do
              in actual `shouldBe` expected
 
         it "rejects recursive fragments" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 ...circumferenceFragment
               }
@@ -162,11 +172,11 @@ spec = do
               }
             |]
 
-            actual <- graphql (HashMap.singleton "Query" $ circumference :| []) query
+            actual <- graphql (toSchema circumference) sourceQuery
             actual `shouldSatisfy` hasErrors
 
         it "considers type condition" $ do
-            let query = [r|
+            let sourceQuery = [r|
               {
                 garment {
                   ...circumferenceFragment
@@ -187,29 +197,5 @@ spec = do
                             ]
                         ]
                     ]
-            actual <- graphql (HashMap.singleton "Query" $ garment "Hat" :| []) query
-            actual `shouldBe` expected
-
-        it "test1" $ do
-            let query = [r|
-              {
-                garment {
-                  circumference
-                }
-              }
-            |]
-                expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-                    ]
-            actual <- graphql schema query
+            actual <- graphql (toSchema $ garment "Hat") sourceQuery
             actual `shouldBe` expected
-          where
-            schema = HashMap.singleton "Query" $ garment' :| []
-            garment' = Schema.object "garment" $ return
-                [ circumference'
-                ]
-            circumference' = Schema.scalar "circumference" $ pure (60 :: Int)
diff --git a/tests/Test/QuerySpec.hs b/tests/Test/QuerySpec.hs
deleted file mode 100644
index 95608b0..0000000
--- a/tests/Test/QuerySpec.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Test.QuerySpec
-    ( spec
-    ) where
-
-import Data.Aeson ((.=), object)
-import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
-import Language.GraphQL
-import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec (Spec, describe, it, shouldBe)
-import Text.RawString.QQ (r)
-
-spec :: Spec
-spec =
-    describe "Query executor" $
-        it "returns objects from the root resolvers" $ do
-            let query = [r|
-              {
-                garment {
-                  circumference
-                }
-              }
-            |]
-                expected = object
-                    [ "data" .= object
-                        [ "garment" .= object
-                            [ "circumference" .= (60 :: Int)
-                            ]
-                        ]
-                    ]
-            actual <- graphql schema query
-            actual `shouldBe` expected
-          where
-            schema = HashMap.singleton "Query" $ garment' :| []
-            garment' = Schema.object "garment" $ return
-                [ circumference'
-                ]
-            circumference' = Schema.scalar "circumference" $ pure (60 :: Int)
diff --git a/tests/Test/RootOperationSpec.hs b/tests/Test/RootOperationSpec.hs
new file mode 100644
index 0000000..fc86d04
--- /dev/null
+++ b/tests/Test/RootOperationSpec.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Test.RootOperationSpec
+    ( spec
+    ) where
+
+import Data.Aeson ((.=), object)
+import Data.List.NonEmpty (NonEmpty(..))
+import Language.GraphQL
+import qualified Language.GraphQL.Schema as Schema
+import Test.Hspec (Spec, describe, it, shouldBe)
+import Text.RawString.QQ (r)
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
+
+schema :: Schema IO
+schema = Schema
+    (ObjectType "Query" queryResolvers)
+    (Just $ ObjectType "Mutation" mutationResolvers)
+  where
+    queryResolvers = Schema.resolversToMap $ garment :| []
+    mutationResolvers = Schema.resolversToMap $ increment :| []
+    garment = Schema.object "garment" $ pure
+        [ Schema.scalar "circumference" $ pure (60 :: Int)
+        ]
+    increment = Schema.scalar "incrementCircumference"
+        $ pure (61 :: Int)
+
+spec :: Spec
+spec =
+    describe "Root operation type" $ do
+        it "returns objects from the root resolvers" $ do
+            let querySource = [r|
+              {
+                garment {
+                  circumference
+                }
+              }
+            |]
+                expected = object
+                    [ "data" .= object
+                        [ "garment" .= object
+                            [ "circumference" .= (60 :: Int)
+                            ]
+                        ]
+                    ]
+            actual <- graphql schema querySource
+            actual `shouldBe` expected
+
+        it "chooses Mutation" $ do
+            let querySource = [r|
+              mutation {
+                incrementCircumference
+              }
+            |]
+                expected = object
+                    [ "data" .= object
+                        [ "incrementCircumference" .= (61 :: Int)
+                        ]
+                    ]
+            actual <- graphql schema querySource
+            actual `shouldBe` expected
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 9466991..3cc8945 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -11,7 +11,7 @@ module Test.StarWars.Data
     , getHuman
     , id_
     , homePlanet
-    , name
+    , name_
     , secretBackstory
     , typeName
     ) where
@@ -55,9 +55,9 @@ id_ :: Character -> ID
 id_ (Left  x) = _id_ . _droidChar $ x
 id_ (Right x) = _id_ . _humanChar $ x
 
-name :: Character -> Text
-name (Left  x) = _name . _droidChar $ x
-name (Right x) = _name . _humanChar $ x
+name_ :: Character -> Text
+name_ (Left  x) = _name . _droidChar $ x
+name_ (Right x) = _name . _humanChar $ x
 
 friends :: Character -> [ID]
 friends (Left  x) = _friends . _droidChar $ x
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cd25599..8b65e22 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -10,20 +10,23 @@ module Test.StarWars.Schema
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Data.Functor.Identity (Identity)
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
-import Data.Text (Text)
 import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
+import Language.GraphQL.Type.Definition
 import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Type.Schema
 import Test.StarWars.Data
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
-schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
-schema = HashMap.singleton "Query" $ hero :| [human, droid]
+schema :: Schema Identity
+schema = Schema { query = queryType, mutation = Nothing }
+  where
+    queryType = ObjectType "Query"
+        $ Schema.resolversToMap
+        $ hero :| [human, droid]
 
 hero :: Schema.Resolver Identity
 hero = Schema.object "hero" $ do
@@ -55,7 +58,7 @@ droid = Schema.object "droid" $ do
 character :: Character -> ActionT Identity [Schema.Resolver Identity]
 character char = return
     [ Schema.scalar "id" $ return $ id_ char
-    , Schema.scalar "name" $ return $ name char
+    , Schema.scalar "name" $ return $ name_ char
     , Schema.wrappedObject "friends"
         $ traverse character $ Type.List $ Type.Named <$> getFriends char
     , Schema.wrappedScalar "appearsIn" $ return . Type.List