Add basic output object type support

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

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