Don't fail on invalid fragments and variables

tests/Test/StarWars/Data.hs

@@ -22,7 +22,6 @@ import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
 import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type as Type
 
 -- * Data
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@@ -184,8 +183,8 @@ getDroid' _      = empty
 getFriends :: Character -> [Character]
 getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
 
-getEpisode :: Int -> Maybe (Type.Wrapping Text)
-getEpisode 4 = pure $ Type.Named "NEWHOPE"
-getEpisode 5 = pure $ Type.Named "EMPIRE"
-getEpisode 6 = pure $ Type.Named "JEDI"
+getEpisode :: Int -> Maybe Text
+getEpisode 4 = pure $ "NEWHOPE"
+getEpisode 5 = pure $ "EMPIRE"
+getEpisode 6 = pure $ "JEDI"
 getEpisode _ = empty

tests/Test/StarWars/QuerySpec.hs

@@ -39,7 +39,7 @@ spec = describe "Star Wars Query Tests" $ do
                 id
                 name
                 friends {
-                name
+                  name
                 }
             }
             }

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
     ]