Add basic output object type support

13 files changed, 231 insertions, 151 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 0f2012c..e249e19 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -13,6 +13,12 @@ and this project adheres to
   execution. `FieldResolver` is executed in `ActionT` and the current `Field` is
   passed in the reader and not as an explicit argument.
 
+### Added
+- `Type.Definition` and `Type.Schema` modules. Both contain the first types (but
+  not all yet) to describe a schema. Public functions that execute queries
+  accept a `Schema` now instead of a `HashMap`. The execution fails if the root
+  operation doesn't match the root Query type in the schema.
+
 ## [0.7.0.0] - 2020-05-11
 ### Fixed
 - Result of null encoding
diff --git a/docs/tutorial/tutorial.lhs b/docs/tutorial/tutorial.lhs
index edaf7f2..afef8d0 100644
--- a/docs/tutorial/tutorial.lhs
+++ b/docs/tutorial/tutorial.lhs
@@ -17,14 +17,14 @@ Since this file is a literate haskell file, we start by importing some dependenc
 > import Control.Monad.IO.Class (liftIO)
 > import Data.Aeson (encode)
 > import Data.ByteString.Lazy.Char8 (putStrLn)
-> import Data.HashMap.Strict (HashMap)
-> import qualified Data.HashMap.Strict as HashMap
 > import Data.List.NonEmpty (NonEmpty(..))
 > import Data.Text (Text)
 > import Data.Time (getCurrentTime)
 >
 > import Language.GraphQL
 > import qualified Language.GraphQL.Schema as Schema
+> import Language.GraphQL.Type.Definition
+> import Language.GraphQL.Type.Schema
 >
 > import Prelude hiding (putStrLn)
 
@@ -35,8 +35,11 @@ example from [graphql.js](https://github.com/graphql/graphql-js).
 
 First we build a GraphQL schema.
 
-> schema1 :: HashMap Text (NonEmpty (Schema.Resolver IO))
-> schema1 = HashMap.singleton "Query" $ hello :| []
+> schema1 :: Schema IO
+> schema1 = Schema queryType Nothing
+>
+> queryType :: ObjectType IO
+> queryType = ObjectType "Query" $ Schema.resolversToMap $ hello :| []
 >
 > hello :: Schema.Resolver IO
 > hello = Schema.scalar "hello" (return ("it's me" :: Text))
@@ -65,8 +68,11 @@ returning
 
 For this example, we're going to be using time.
 
-> schema2 :: HashMap Text (NonEmpty (Schema.Resolver IO))
-> schema2 = HashMap.singleton "Query" $ time :| []
+> schema2 :: Schema IO
+> schema2 = Schema queryType2 Nothing
+>
+> queryType2 :: ObjectType IO
+> queryType2 = ObjectType "Query" $ Schema.resolversToMap $ time :| []
 >
 > time :: Schema.Resolver IO
 > time = Schema.scalar "time" $ do
@@ -124,8 +130,11 @@ This will fail
 
 Now that we have two resolvers, we can define a schema which uses them both.
 
-> schema3 :: HashMap Text (NonEmpty (Schema.Resolver IO))
-> schema3 = HashMap.singleton "Query" $ hello :| [time]
+> schema3 :: Schema IO
+> schema3 = Schema queryType3 Nothing
+>
+> queryType3 :: ObjectType IO
+> queryType3 = ObjectType "Query" $ Schema.resolversToMap $ hello :| [time]
 >
 > query3 :: Text
 > query3 = "query timeAndHello { time hello }"
diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs
index 73f9bdc..fff378d 100644
--- a/src/Language/GraphQL.hs
+++ b/src/Language/GraphQL.hs
@@ -5,19 +5,18 @@ module Language.GraphQL
     ) where
 
 import qualified Data.Aeson as Aeson
-import Data.List.NonEmpty (NonEmpty)
-import Data.HashMap.Strict (HashMap)
 import Data.Text (Text)
 import Language.GraphQL.Error
 import Language.GraphQL.Execute
 import Language.GraphQL.AST.Parser
 import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type.Schema
 import Text.Megaparsec (parse)
 
 -- | If the text parses correctly as a @GraphQL@ query the query is
 -- executed using the given 'Schema.Resolver's.
 graphql :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
+    => Schema m -- ^ Resolvers.
     -> Text -- ^ Text representing a @GraphQL@ request document.
     -> m Aeson.Value -- ^ Response.
 graphql = flip graphqlSubs mempty
@@ -26,7 +25,7 @@ graphql = flip graphqlSubs mempty
 -- applied to the query and the query is then executed using to the given
 -- 'Schema.Resolver's.
 graphqlSubs :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
+    => Schema m -- ^ Resolvers.
     -> Schema.Subs -- ^ Variable substitution function.
     -> Text -- ^ Text representing a @GraphQL@ request document.
     -> m Aeson.Value -- ^ Response.
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 204d08c..e1bacbc 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 -- | This module provides functions to execute a @GraphQL@ request.
 module Language.GraphQL.Execute
@@ -7,10 +8,8 @@ module Language.GraphQL.Execute
     ) where
 
 import qualified Data.Aeson as Aeson
+import Data.Foldable (find)
 import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
@@ -18,6 +17,18 @@ import qualified Language.GraphQL.AST.Core as AST.Core
 import qualified Language.GraphQL.Execute.Transform as Transform
 import Language.GraphQL.Error
 import qualified Language.GraphQL.Schema as Schema
+import Language.GraphQL.Type.Definition
+import Language.GraphQL.Type.Schema
+
+-- | Query error types.
+data QueryError
+    = OperationNotFound Text
+    | OperationNameRequired
+
+queryError :: QueryError -> Text
+queryError (OperationNotFound operationName) = Text.unwords
+    ["Operation", operationName, "couldn't be found in the document."]
+queryError OperationNameRequired = "Missing operation name."
 
 -- | The substitution is applied to the document, and the resolvers are applied
 -- to the resulting fields.
@@ -25,7 +36,7 @@ import qualified Language.GraphQL.Schema as Schema
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
 execute :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers.
+    => Schema m -- ^ Resolvers.
     -> Schema.Subs -- ^ Variable substitution function.
     -> Document -- @GraphQL@ document.
     -> m Aeson.Value
@@ -42,45 +53,55 @@ execute schema subs doc =
 -- Returns the result of the query against the schema wrapped in a /data/
 -- field, or errors wrapped in an /errors/ field.
 executeWithName :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m)) -- ^ Resolvers
+    => Schema m -- ^ Resolvers
     -> Text -- ^ Operation name.
     -> Schema.Subs -- ^ Variable substitution function.
     -> Document -- ^ @GraphQL@ Document.
     -> m Aeson.Value
-executeWithName schema name subs doc =
-    maybe transformError (document schema $ Just name)
+executeWithName schema operationName subs doc =
+    maybe transformError (document schema $ Just operationName)
         $ Transform.document subs doc
   where
     transformError = return $ singleError "Schema transformation error."
 
+getOperation
+    :: Maybe Text
+    -> AST.Core.Document
+    -> Either QueryError AST.Core.Operation
+getOperation Nothing (operation' :| []) = pure operation'
+getOperation Nothing _ = Left OperationNameRequired
+getOperation (Just operationName) document'
+    | Just operation' <- find matchingName document' = pure operation'
+    | otherwise = Left $ OperationNotFound operationName
+  where
+    matchingName (AST.Core.Query (Just name') _) = operationName == name'
+    matchingName (AST.Core.Mutation (Just name') _) = operationName == name'
+    matchingName _ = False
+
 document :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m))
+    => Schema m
     -> Maybe Text
     -> AST.Core.Document
     -> m Aeson.Value
-document schema Nothing (op :| []) = operation schema op
-document schema (Just name) operations = case NonEmpty.dropWhile matchingName operations of
-    [] -> return $ singleError
-        $ Text.unwords ["Operation", name, "couldn't be found in the document."]
-    (op:_)  -> operation schema op
-  where
-    matchingName (AST.Core.Query (Just name') _) = name == name'
-    matchingName (AST.Core.Mutation (Just name') _) = name == name'
-    matchingName _ = False
-document _ _ _ = return $ singleError "Missing operation name."
+document schema operationName document' =
+    case getOperation operationName document' of
+        Left error' -> pure $ singleError $ queryError error'
+        Right operation' -> operation schema operation'
 
 operation :: Monad m
-    => HashMap Text (NonEmpty (Schema.Resolver m))
+    => Schema m
     -> AST.Core.Operation
     -> m Aeson.Value
-operation schema = schemaOperation
+operation = schemaOperation
   where
-    runResolver fields = runCollectErrs
-        . flip Schema.resolve fields
-        . Schema.resolversToMap
-    resolve fields queryType = maybe lookupError (runResolver fields)
-        $ HashMap.lookup queryType schema
+    resolve queryFields = runCollectErrs
+        . flip Schema.resolve queryFields
+        . fields
     lookupError = pure
         $ singleError "Root operation type couldn't be found in the schema."
-    schemaOperation (AST.Core.Query _ fields) = resolve fields "Query"
-    schemaOperation (AST.Core.Mutation _ fields) = resolve fields "Mutation"
+    schemaOperation Schema {query} (AST.Core.Query _ fields') =
+        resolve fields' query
+    schemaOperation Schema {mutation = Just mutation} (AST.Core.Mutation _ fields') =
+        resolve fields' mutation
+    schemaOperation Schema {mutation = Nothing} (AST.Core.Mutation _ _) =
+        lookupError
diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs
index 90a766c..e76b42e 100644
--- a/src/Language/GraphQL/Schema.hs
+++ b/src/Language/GraphQL/Schema.hs
@@ -3,7 +3,8 @@
 -- | This module provides a representation of a @GraphQL@ Schema in addition to
 -- functions for defining and manipulating schemas.
 module Language.GraphQL.Schema
-    ( Resolver(..)
+    ( FieldResolver(..)
+    , Resolver(..)
     , Subs
     , object
     , resolve
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
new file mode 100644
index 0000000..016eeb8
--- /dev/null
+++ b/src/Language/GraphQL/Type/Definition.hs
@@ -0,0 +1,18 @@
+module Language.GraphQL.Type.Definition
+    ( ObjectType(..)
+    ) where
+
+import Data.HashMap.Strict (HashMap)
+import Data.Text (Text)
+import Language.GraphQL.Schema
+
+type Fields m = HashMap Text (FieldResolver m)
+
+-- | Object Type Definition.
+--
+--   Almost all of the GraphQL types you define will be object types. Object
+--   types have a name, but most importantly describe their fields.
+data ObjectType m = ObjectType
+    { name :: Text
+    , fields :: Fields m
+    }
diff --git a/src/Language/GraphQL/Type/Schema.hs b/src/Language/GraphQL/Type/Schema.hs
new file mode 100644
index 0000000..f830c26
--- /dev/null
+++ b/src/Language/GraphQL/Type/Schema.hs
@@ -0,0 +1,11 @@
+module Language.GraphQL.Type.Schema
+    ( Schema(..)
+    ) where
+
+import Language.GraphQL.Type.Definition
+
+-- | Schema Definition
+data Schema m = Schema
+    { query :: ObjectType m
+    , mutation :: Maybe (ObjectType m)
+    }
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