diff options
Diffstat (limited to 'tests/Test')
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 26 | ||||
| -rw-r--r-- | tests/Test/StarWars/QueryTests.hs | 15 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 14 |
3 files changed, 27 insertions, 28 deletions
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 1305de3..5ceeb82 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -2,8 +2,10 @@ module Test.StarWars.Data where import Data.Monoid (mempty) -import Control.Applicative (liftA2) -import Control.Monad (MonadPlus(..)) +import Control.Applicative ( Alternative(..) + , liftA2 + ) +import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Except (throwE) import Data.Maybe (catMaybes) import Data.Text (Text) @@ -52,7 +54,7 @@ appearsIn :: Character -> [Int] appearsIn (Left x) = _appearsIn . _droidChar $ x appearsIn (Right x) = _appearsIn . _humanChar $ x -secretBackstory :: MonadPlus m => Character -> ActionT m Text +secretBackstory :: MonadIO m => Character -> ActionT m Text secretBackstory = const $ ActionT $ throwE "secretBackstory is secret." typeName :: Character -> Text @@ -150,30 +152,30 @@ getHero _ = artoo getHeroIO :: Int -> IO Character getHeroIO = pure . getHero -getHuman :: MonadPlus m => ID -> m Character +getHuman :: Alternative f => ID -> f Character getHuman = fmap Right . getHuman' -getHuman' :: MonadPlus m => ID -> m Human +getHuman' :: Alternative f => ID -> f Human getHuman' "1000" = pure luke' getHuman' "1001" = pure vader getHuman' "1002" = pure han getHuman' "1003" = pure leia getHuman' "1004" = pure tarkin -getHuman' _ = mzero +getHuman' _ = empty -getDroid :: MonadPlus m => ID -> m Character +getDroid :: Alternative f => ID -> f Character getDroid = fmap Left . getDroid' -getDroid' :: MonadPlus m => ID -> m Droid +getDroid' :: Alternative f => ID -> f Droid getDroid' "2000" = pure threepio getDroid' "2001" = pure artoo' -getDroid' _ = mzero +getDroid' _ = empty getFriends :: Character -> [Character] -getFriends char = catMaybes $ liftA2 mplus getDroid getHuman <$> friends char +getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char -getEpisode :: MonadPlus m => Int -> m Text +getEpisode :: Alternative f => Int -> f Text getEpisode 4 = pure "NEWHOPE" getEpisode 5 = pure "EMPIRE" getEpisode 6 = pure "JEDI" -getEpisode _ = mzero +getEpisode _ = empty diff --git a/tests/Test/StarWars/QueryTests.hs b/tests/Test/StarWars/QueryTests.hs index 27e66ea..3a6ca75 100644 --- a/tests/Test/StarWars/QueryTests.hs +++ b/tests/Test/StarWars/QueryTests.hs @@ -11,7 +11,10 @@ import Language.GraphQL import Language.GraphQL.Schema (Subs) import Text.RawString.QQ (r) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (Assertion, testCase, (@?=)) +import Test.Tasty.HUnit ( Assertion + , testCase + , (@?=) + ) import Test.StarWars.Schema -- * Test @@ -344,13 +347,7 @@ test = testGroup "Star Wars Query Tests" alderaan = "homePlanet" .= ("Alderaan" :: Text) testQuery :: Text -> Aeson.Value -> Assertion -testQuery q expected = graphql schema q @?= Just expected - --- testFail :: Text -> Assertion --- testFail q = graphql schema q @?= Nothing +testQuery q expected = graphql schema q >>= (@?= expected) testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion -testQueryParams f q expected = graphqlSubs schema f q @?= Just expected - --- testFailParams :: Subs -> Text -> Assertion --- testFailParams f q = graphqlSubs schema f q @?= Nothing +testQueryParams f q expected = graphqlSubs schema f q >>= (@?= expected) diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 6615d09..3cc34fd 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -2,9 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} module Test.StarWars.Schema where -import Control.Monad (MonadPlus(..)) import Control.Monad.Trans.Except (throwE) import Control.Monad.Trans.Class (lift) +import Control.Monad.IO.Class (MonadIO(..)) import Data.List.NonEmpty (NonEmpty((:|))) import Language.GraphQL.Schema ( Schema , Resolver @@ -19,10 +19,10 @@ import Test.StarWars.Data -- * Schema -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js -schema :: MonadPlus m => Schema m +schema :: MonadIO m => Schema m schema = hero :| [human, droid] -hero :: MonadPlus m => Resolver m +hero :: MonadIO m => Resolver m hero = Schema.objectA "hero" $ \case [] -> character artoo [Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4 @@ -30,7 +30,7 @@ hero = Schema.objectA "hero" $ \case [Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6 _ -> ActionT $ throwE "Invalid arguments." -human :: MonadPlus m => Resolver m +human :: MonadIO m => Resolver m human = Schema.wrappedObjectA "human" $ \case [Argument "id" (ValueString i)] -> do humanCharacter <- lift $ return $ getHuman i >>= Just @@ -39,12 +39,12 @@ human = Schema.wrappedObjectA "human" $ \case Just e -> Named <$> character e _ -> ActionT $ throwE "Invalid arguments." -droid :: MonadPlus m => Resolver m +droid :: MonadIO m => Resolver m droid = Schema.objectA "droid" $ \case - [Argument "id" (ValueString i)] -> character =<< lift (getDroid i) + [Argument "id" (ValueString i)] -> character =<< liftIO (getDroid i) _ -> ActionT $ throwE "Invalid arguments." -character :: MonadPlus m => Character -> ActionT m [Resolver m] +character :: MonadIO m => Character -> ActionT m [Resolver m] character char = return [ Schema.scalar "id" $ return $ id_ char , Schema.scalar "name" $ return $ name char |
