diff options
Diffstat (limited to 'tests/Test/StarWars')
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 9 | ||||
| -rw-r--r-- | tests/Test/StarWars/QuerySpec.hs | 2 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 53 |
3 files changed, 34 insertions, 30 deletions
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 3cc8945..30a4cef 100644 --- a/tests/Test/StarWars/Data.hs +++ b/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 diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs index e9147ff..39d6a27 100644 --- a/tests/Test/StarWars/QuerySpec.hs +++ b/tests/Test/StarWars/QuerySpec.hs @@ -39,7 +39,7 @@ spec = describe "Star Wars Query Tests" $ do id name friends { - name + name } } } 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 ] |
