Replace MonadIO constraint with just Monad

And make the tests use Identity instead of IO.

3 files changed, 14 insertions, 18 deletions

diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 4854f8f..0318d78 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -8,7 +8,6 @@ module Test.StarWars.Data
     , getEpisode
     , getFriends
     , getHero
-    , getHeroIO
     , getHuman
     , id_
     , homePlanet
@@ -18,10 +17,8 @@ module Test.StarWars.Data
     ) where
 
 import Data.Monoid (mempty)
-import Control.Applicative ( Alternative(..)
-                           , liftA2 
-                           )
-import Control.Monad.IO.Class (MonadIO(..))
+import Data.Functor.Identity (Identity)
+import Control.Applicative (Alternative(..), liftA2)
 import Control.Monad.Trans.Except (throwE)
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
@@ -71,7 +68,7 @@ appearsIn :: Character -> [Int]
 appearsIn (Left  x) = _appearsIn . _droidChar $ x
 appearsIn (Right x) = _appearsIn . _humanChar $ x
 
-secretBackstory :: MonadIO m => Character -> ActionT m Text
+secretBackstory :: Character -> ActionT Identity Text
 secretBackstory = const $ ActionT $ throwE "secretBackstory is secret."
 
 typeName :: Character -> Text
@@ -166,9 +163,6 @@ getHero :: Int -> Character
 getHero 5 = luke
 getHero _ = artoo
 
-getHeroIO :: Int -> IO Character
-getHeroIO = pure . getHero
-
 getHuman :: Alternative f => ID -> f Character
 getHuman = fmap Right . getHuman'
 
diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs
index 4f92801..45fcf42 100644
--- a/tests/Test/StarWars/QuerySpec.hs
+++ b/tests/Test/StarWars/QuerySpec.hs
@@ -6,6 +6,7 @@ module Test.StarWars.QuerySpec
 
 import qualified Data.Aeson as Aeson
 import Data.Aeson ((.=))
+import Data.Functor.Identity (Identity(..))
 import qualified Data.HashMap.Strict as HashMap
 import Data.Text (Text)
 import Language.GraphQL
@@ -357,7 +358,8 @@ spec = describe "Star Wars Query Tests" $ do
     alderaan = "homePlanet" .= ("Alderaan" :: Text)
 
 testQuery :: Text -> Aeson.Value -> Expectation
-testQuery q expected = graphql schema q >>= flip shouldBe expected
+testQuery q expected = runIdentity (graphql schema q) `shouldBe` expected
 
 testQueryParams :: Subs -> Text -> Aeson.Value -> Expectation
-testQueryParams f q expected = graphqlSubs schema f q >>= flip shouldBe expected
+testQueryParams f q expected =
+    runIdentity (graphqlSubs schema f q) `shouldBe` expected
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index e45d7ff..7986a30 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -7,9 +7,9 @@ module Test.StarWars.Schema
     , schema
     ) where
 
-import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
+import Data.Functor.Identity (Identity)
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
 import qualified Language.GraphQL.Schema as Schema
@@ -19,10 +19,10 @@ import Test.StarWars.Data
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
-schema :: MonadIO m => NonEmpty (Schema.Resolver m)
+schema :: NonEmpty (Schema.Resolver Identity)
 schema = hero :| [human, droid]
 
-hero :: MonadIO m => Schema.Resolver m
+hero :: Schema.Resolver Identity
 hero = Schema.object "hero" $ do
   episode <- argument "episode"
   character $ case episode of
@@ -31,7 +31,7 @@ hero = Schema.object "hero" $ do
       Schema.Enum "JEDI" -> getHero 6
       _ -> artoo
 
-human :: MonadIO m => Schema.Resolver m
+human :: Schema.Resolver Identity
 human = Schema.wrappedObject "human" $ do
     id' <- argument "id"
     case id' of
@@ -42,14 +42,14 @@ human = Schema.wrappedObject "human" $ do
                 Just e -> Type.Named <$> character e
         _ -> ActionT $ throwE "Invalid arguments."
 
-droid :: MonadIO m => Schema.Resolver m
+droid :: Schema.Resolver Identity
 droid = Schema.object "droid" $ do
     id' <- argument "id"
     case id' of
-        Schema.String i -> character =<< liftIO (getDroid i)
+        Schema.String i -> character =<< getDroid i
         _ -> ActionT $ throwE "Invalid arguments."
 
-character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
+character :: Character -> ActionT Identity [Schema.Resolver Identity]
 character char = return
     [ Schema.scalar "id" $ return $ id_ char
     , Schema.scalar "name" $ return $ name char