Don't fail on invalid fragments and variables

1 files changed, 29 insertions, 24 deletions

diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index 253c6ca..5e702e0 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -10,7 +10,7 @@ module Test.StarWars.Schema
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Data.Functor.Identity (Identity)
-import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.HashMap.Strict as HashMap
 import Data.Maybe (catMaybes)
 import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
@@ -24,46 +24,51 @@ import Test.StarWars.Data
 schema :: Schema Identity
 schema = Schema { query = queryType, mutation = Nothing }
   where
-    queryType = ObjectType "Query"
-        $ Field Nothing (ScalarOutputType string) mempty
-        <$> Schema.resolversToMap (hero :| [human, droid])
+    queryType = ObjectType "Query" Nothing $ HashMap.fromList
+        [ ("hero", Field Nothing (ScalarOutputType string) mempty hero)
+        , ("human", Field Nothing (ScalarOutputType string) mempty human)
+        , ("droid", Field Nothing (ScalarOutputType string) mempty droid)
+        ]
 
-hero :: Schema.Resolver Identity
-hero = Schema.object "hero" $ do
+hero :: FieldResolver Identity
+hero = NestingResolver $ do
   episode <- argument "episode"
-  character $ case episode of
+  pure $ character $ case episode of
       Schema.Enum "NEWHOPE" -> getHero 4
       Schema.Enum "EMPIRE" -> getHero 5
       Schema.Enum "JEDI" -> getHero 6
       _ -> artoo
 
-human :: Schema.Resolver Identity
-human = Schema.wrappedObject "human" $ do
+human :: FieldResolver Identity
+human = NestingResolver $ do
     id' <- argument "id"
     case id' of
         Schema.String i -> do
             humanCharacter <- lift $ return $ getHuman i >>= Just
             case humanCharacter of
-                Nothing -> return Type.Null
-                Just e -> Type.Named <$> character e
+                Nothing -> pure Type.Null
+                Just e -> pure $ character e
         _ -> ActionT $ throwE "Invalid arguments."
 
-droid :: Schema.Resolver Identity
-droid = Schema.object "droid" $ do
+droid :: FieldResolver Identity
+droid = NestingResolver $ do
     id' <- argument "id"
     case id' of
-        Schema.String i -> character =<< getDroid i
+        Schema.String i -> getDroid i >>= pure . character
         _ -> ActionT $ throwE "Invalid arguments."
 
-character :: Character -> ActionT Identity [Schema.Resolver Identity]
-character char = return
-    [ Schema.scalar "id" $ return $ id_ char
-    , Schema.scalar "name" $ return $ name_ char
+character :: Character -> Type.Wrapping (FieldResolver Identity)
+character char = Schema.object
+    [ Schema.wrappedObject "id" $ pure $ Type.S $ id_ char
+    , Schema.wrappedObject "name" $ pure $ Type.S $ name_ char
     , Schema.wrappedObject "friends"
-        $ traverse character $ Type.List $ Type.Named <$> getFriends char
-    , Schema.wrappedScalar "appearsIn" $ return . Type.List
-        $ catMaybes (getEpisode <$> appearsIn char)
-    , Schema.scalar "secretBackstory" $ secretBackstory char
-    , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
-    , Schema.scalar "__typename" $ return $ typeName char
+        $ pure
+        $ Type.List
+        $ fmap character
+        $ getFriends char
+    , Schema.wrappedObject "appearsIn" $ pure
+        $ Type.List $ Type.E <$> catMaybes (getEpisode <$> appearsIn char)
+    , Schema.wrappedObject "secretBackstory" $ Type.S <$> secretBackstory char
+    , Schema.wrappedObject "homePlanet" $ pure $ Type.S $ either mempty homePlanet char
+    , Schema.wrappedObject "__typename" $ pure $ Type.S $ typeName char
     ]