diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
index 555cc91..71f35ab 100644
--- a/src/Control/Monad/Trans/Free.hs
+++ b/src/Control/Monad/Trans/Free.hs
@@ -53,7 +53,7 @@ module Control.Monad.Trans.Free
   ) where
 
 import Control.Applicative
-import Control.Monad (liftM, MonadPlus(..), ap, join)
+import Control.Monad (liftM, MonadPlus(..), join)
 import Control.Monad.Base (MonadBase(..))
 import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
 import Control.Monad.Trans.Class
@@ -284,24 +284,28 @@ instance (Functor f, Read1 f, Functor m, Read1 m, Read a) => Read (FreeT f m a)
 #endif
   readsPrec = readsPrec1
 
-instance (Functor f, Monad m) => Functor (FreeT f m) where
-  fmap f (FreeT m) = FreeT (liftM f' m) where
+instance (Functor f, Functor m) => Functor (FreeT f m) where
+  fmap f (FreeT m) = FreeT (fmap f' m) where
     f' (Pure a)  = Pure (f a)
     f' (Free as) = Free (fmap (fmap f) as)
 
-instance (Functor f, Monad m) => Applicative (FreeT f m) where
-  pure a = FreeT (return (Pure a))
+instance (Functor f, Functor m, Applicative m) => Applicative (FreeT f m) where
+  pure a = FreeT (pure (Pure a))
   {-# INLINE pure #-}
-  (<*>) = ap
+  FreeT mf <*> FreeT mx = FreeT $ liftA2 q mf mx
+    where
+      Pure a `q` Pure b  = Pure $ a b
+      Pure a `q` Free b  = Free $ fmap a <$> b
+      Free a `q` b       = Free $ (<*> FreeT (pure b)) <$> a
   {-# INLINE (<*>) #-}
 
-instance (Functor f, Monad m) => Apply (FreeT f m) where
+instance (Functor f, Functor m, Applicative m) => Apply (FreeT f m) where
   (<.>) = (<*>)
 
-instance (Functor f, Monad m) => Bind (FreeT f m) where
+instance (Functor f, Functor m, Applicative m, Monad m) => Bind (FreeT f m) where
   (>>-) = (>>=)
 
-instance (Functor f, Monad m) => Monad (FreeT f m) where
+instance (Functor f, Functor m, Applicative m, Monad m) => Monad (FreeT f m) where
   return = pure
   {-# INLINE return #-}
   FreeT m >>= f = FreeT $ m >>= \v -> case v of
@@ -310,14 +314,14 @@ instance (Functor f, Monad m) => Monad (FreeT f m) where
 
   fail = Fail.fail
 
-instance (Functor f, Monad m) => Fail.MonadFail (FreeT f m) where
+instance (Functor f, Applicative m, Monad m) => Fail.MonadFail (FreeT f m) where
   fail e = FreeT (fail e)
 
 instance MonadTrans (FreeT f) where
   lift = FreeT . liftM Pure
   {-# INLINE lift #-}
 
-instance (Functor f, MonadIO m) => MonadIO (FreeT f m) where
+instance (Functor f, Applicative m, MonadIO m) => MonadIO (FreeT f m) where
   liftIO = lift . liftIO
   {-# INLINE liftIO #-}
 
@@ -325,13 +329,13 @@ instance (Functor f, MonadBase b m) => MonadBase b (FreeT f m) where
   liftBase = lift . liftBase
   {-# INLINE liftBase #-}
 
-instance (Functor f, MonadReader r m) => MonadReader r (FreeT f m) where
+instance (Functor f, Functor m, Applicative m, MonadReader r m) => MonadReader r (FreeT f m) where
   ask = lift ask
   {-# INLINE ask #-}
   local f = hoistFreeT (local f)
   {-# INLINE local #-}
 
-instance (Functor f, MonadWriter w m) => MonadWriter w (FreeT f m) where
+instance (Functor f, Functor m, Applicative m, MonadWriter w m) => MonadWriter w (FreeT f m) where
   tell = lift . tell
   {-# INLINE tell #-}
   listen (FreeT m) = FreeT $ liftM concat' $ listen (fmap listen `liftM` m)
@@ -349,7 +353,7 @@ instance (Functor f, MonadWriter w m) => MonadWriter w (FreeT f m) where
   {-# INLINE writer #-}
 #endif
 
-instance (Functor f, MonadState s m) => MonadState s (FreeT f m) where
+instance (Functor f, Applicative m, MonadState s m) => MonadState s (FreeT f m) where
   get = lift get
   {-# INLINE get #-}
   put = lift . put
@@ -359,34 +363,34 @@ instance (Functor f, MonadState s m) => MonadState s (FreeT f m) where
   {-# INLINE state #-}
 #endif
 
-instance (Functor f, MonadError e m) => MonadError e (FreeT f m) where
+instance (Functor f, Applicative m, MonadError e m) => MonadError e (FreeT f m) where
   throwError = lift . throwError
   {-# INLINE throwError #-}
   FreeT m `catchError` f = FreeT $ liftM (fmap (`catchError` f)) m `catchError` (runFreeT . f)
 
-instance (Functor f, MonadCont m) => MonadCont (FreeT f m) where
+instance (Functor f, Applicative m, MonadCont m) => MonadCont (FreeT f m) where
   callCC f = FreeT $ callCC (\k -> runFreeT $ f (lift . k . Pure))
 
-instance (Functor f, MonadPlus m) => Alternative (FreeT f m) where
+instance (Functor f, Applicative m, MonadPlus m) => Alternative (FreeT f m) where
   empty = FreeT mzero
   FreeT ma <|> FreeT mb = FreeT (mplus ma mb)
   {-# INLINE (<|>) #-}
 
-instance (Functor f, MonadPlus m) => MonadPlus (FreeT f m) where
+instance (Functor f, Applicative m, MonadPlus m) => MonadPlus (FreeT f m) where
   mzero = FreeT mzero
   {-# INLINE mzero #-}
   mplus (FreeT ma) (FreeT mb) = FreeT (mplus ma mb)
   {-# INLINE mplus #-}
 
-instance (Functor f, Monad m) => MonadFree f (FreeT f m) where
+instance (Functor f, Applicative m, Monad m) => MonadFree f (FreeT f m) where
   wrap = FreeT . return . Free
   {-# INLINE wrap #-}
 
-instance (Functor f, MonadThrow m) => MonadThrow (FreeT f m) where
+instance (Functor f, Applicative m, MonadThrow m) => MonadThrow (FreeT f m) where
   throwM = lift . throwM
   {-# INLINE throwM #-}
 
-instance (Functor f, MonadCatch m) => MonadCatch (FreeT f m) where
+instance (Functor f, Applicative m, MonadCatch m) => MonadCatch (FreeT f m) where
   FreeT m `catch` f = FreeT $ liftM (fmap (`Control.Monad.Catch.catch` f)) m
                                 `Control.Monad.Catch.catch` (runFreeT . f)
   {-# INLINE catch #-}
@@ -410,14 +414,14 @@ iterTM f (FreeT m) = do
 instance (Foldable m, Foldable f) => Foldable (FreeT f m) where
   foldMap f (FreeT m) = foldMap (bifoldMap f (foldMap f)) m
 
-instance (Monad m, Traversable m, Traversable f) => Traversable (FreeT f m) where
+instance (Applicative m, Traversable m, Traversable f) => Traversable (FreeT f m) where
   traverse f (FreeT m) = FreeT <$> traverse (bitraverse f (traverse f)) m
 
 -- | Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' f n@
 --
 -- @'hoistFreeT' :: ('Monad' m, 'Functor' f) => (m ~> n) -> 'FreeT' f m ~> 'FreeT' f n@
-hoistFreeT :: (Monad m, Functor f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
-hoistFreeT mh = FreeT . mh . liftM (fmap (hoistFreeT mh)) . runFreeT
+hoistFreeT :: (Functor m, Functor f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
+hoistFreeT mh = FreeT . mh . fmap (fmap (hoistFreeT mh)) . runFreeT
 
 -- | The very definition of a free monad transformer is that given a natural
 -- transformation you get a monad transformer homomorphism.
@@ -429,8 +433,8 @@ foldFreeT f (FreeT m) = lift m >>= foldFreeF
     foldFreeF (Free as) = f as >>= foldFreeT f
 
 -- | Lift a natural transformation from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g m@
-transFreeT :: (Monad m, Functor g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
-transFreeT nt = FreeT . liftM (fmap (transFreeT nt) . transFreeF nt) . runFreeT
+transFreeT :: (Functor m, Functor g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
+transFreeT nt = FreeT . fmap (fmap (transFreeT nt) . transFreeF nt) . runFreeT
 
 -- | Pull out and join @m@ layers of @'FreeT' f m a@.
 joinFreeT :: (Monad m, Traversable f) => FreeT f m a -> m (Free f a)
@@ -474,9 +478,9 @@ iterM phi = iterT phi . hoistFreeT (return . runIdentity)
 --
 -- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
 -- steps in the iteration is terminating.
-cutoff :: (Functor f, Monad m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
-cutoff n _ | n <= 0 = return Nothing
-cutoff n (FreeT m) = FreeT $ bimap Just (cutoff (n - 1)) `liftM` m
+cutoff :: (Functor f, Applicative m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
+cutoff n _ | n <= 0 = pure Nothing
+cutoff n (FreeT m) = FreeT $ bimap Just (cutoff (n - 1)) <$> m
 
 -- | @partialIterT n phi m@ interprets first @n@ layers of @m@ using @phi@.
 -- This is sort of the opposite for @'cutoff'@.
@@ -506,7 +510,7 @@ partialIterT n phi m
 -- 'intersperseT' f '.' 'lift'   ≡ 'lift'
 -- 'intersperseT' f '.' 'wrap'   ≡ 'wrap' '.' 'fmap' ('iterTM' ('wrap' '.' ('<$' f) '.' 'wrap'))
 -- @
-intersperseT :: (Monad m, Functor f) => f a -> FreeT f m b -> FreeT f m b
+intersperseT :: (Applicative m, Monad m, Functor f) => f a -> FreeT f m b -> FreeT f m b
 intersperseT f (FreeT m) = FreeT $ do
   val <- m
   case val of
diff --git a/src/Control/Monad/Trans/Free/Ap.hs b/src/Control/Monad/Trans/Free/Ap.hs
index f739d2b..1c3b541 100644
--- a/src/Control/Monad/Trans/Free/Ap.hs
+++ b/src/Control/Monad/Trans/Free/Ap.hs
@@ -44,7 +44,7 @@ module Control.Monad.Trans.Free.Ap
   ) where
 
 import Control.Applicative
-import Control.Monad (liftM, MonadPlus(..), join)
+import Control.Monad (MonadPlus(..), join, liftM)
 import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
 import Control.Monad.Trans.Class
 import qualified Control.Monad.Fail as Fail
@@ -274,13 +274,13 @@ instance (Functor f, Read1 f, Functor m, Read1 m, Read a) => Read (FreeT f m a)
 #endif
   readsPrec = readsPrec1
 
-instance (Functor f, Monad m) => Functor (FreeT f m) where
-  fmap f (FreeT m) = FreeT (liftM f' m) where
+instance (Functor f, Functor m) => Functor (FreeT f m) where
+  fmap f (FreeT m) = FreeT (fmap f' m) where
     f' (Pure a)  = Pure (f a)
     f' (Free as) = Free (fmap (fmap f) as)
 
-instance (Applicative f, Applicative m, Monad m) => Applicative (FreeT f m) where
-  pure a = FreeT (return (Pure a))
+instance (Applicative f, Applicative m) => Applicative (FreeT f m) where
+  pure a = FreeT (pure (Pure a))
   {-# INLINE pure #-}
   FreeT f <*> FreeT a = FreeT $ g <$> f <*> a where
     g (Pure f') (Pure a') = Pure (f' a')
@@ -289,14 +289,14 @@ instance (Applicative f, Applicative m, Monad m) => Applicative (FreeT f m) wher
     g (Free fs) (Free as) = Free $ (<*>) <$> fs <*> as
   {-# INLINE (<*>) #-}
 
-instance (Apply f, Apply m, Monad m) => Apply (FreeT f m) where
+instance (Apply f, Apply m, Applicative m) => Apply (FreeT f m) where
   FreeT f <.> FreeT a = FreeT $ g <$> f <.> a where
     g (Pure f') (Pure a') = Pure (f' a')
     g (Pure f') (Free as) = Free $ fmap f' <$> as
     g (Free fs) (Pure a') = Free $ fmap ($ a') <$> fs
     g (Free fs) (Free as) = Free $ (<.>) <$> fs <.> as
 
-instance (Apply f, Apply m, Monad m) => Bind (FreeT f m) where
+instance (Apply f, Apply m, Applicative m, Monad m) => Bind (FreeT f m) where
   FreeT m >>- f = FreeT $ m >>= \v -> case v of
     Pure a -> runFreeT (f a)
     Free w -> return (Free (fmap (>>- f) w))
@@ -329,14 +329,14 @@ instance (Applicative f, Applicative m, MonadReader r m) => MonadReader r (FreeT
 instance (Applicative f, Applicative m, MonadWriter w m) => MonadWriter w (FreeT f m) where
   tell = lift . tell
   {-# INLINE tell #-}
-  listen (FreeT m) = FreeT $ liftM concat' $ listen (fmap listen `liftM` m)
+  listen (FreeT m) = FreeT $ fmap concat' $ listen (fmap listen <$> m)
     where
       concat' (Pure x, w) = Pure (x, w)
       concat' (Free y, w) = Free $ fmap (second (w `mappend`)) <$> y
   pass m = FreeT . pass' . runFreeT . hoistFreeT clean $ listen m
     where
-      clean = pass . liftM (\x -> (x, const mempty))
-      pass' = join . liftM g
+      clean = pass . fmap (\x -> (x, const mempty))
+      pass' = join . fmap g
       g (Pure ((x, f), w)) = tell (f w) >> return (Pure x)
       g (Free f)           = return . Free . fmap (FreeT . pass' . runFreeT) $ f
 #if MIN_VERSION_mtl(2,1,1)
@@ -357,7 +357,7 @@ instance (Applicative f, Applicative m, MonadState s m) => MonadState s (FreeT f
 instance (Applicative f, Applicative m, MonadError e m) => MonadError e (FreeT f m) where
   throwError = lift . throwError
   {-# INLINE throwError #-}
-  FreeT m `catchError` f = FreeT $ liftM (fmap (`catchError` f)) m `catchError` (runFreeT . f)
+  FreeT m `catchError` f = FreeT $ fmap (fmap (`catchError` f)) m `catchError` (runFreeT . f)
 
 instance (Applicative f, Applicative m, MonadCont m) => MonadCont (FreeT f m) where
   callCC f = FreeT $ callCC (\k -> runFreeT $ f (lift . k . Pure))
@@ -382,7 +382,7 @@ instance (Applicative f, Applicative m, MonadThrow m) => MonadThrow (FreeT f m)
   {-# INLINE throwM #-}
 
 instance (Applicative f, Applicative m, MonadCatch m) => MonadCatch (FreeT f m) where
-  FreeT m `catch` f = FreeT $ liftM (fmap (`Control.Monad.Catch.catch` f)) m
+  FreeT m `catch` f = FreeT $ fmap (fmap (`Control.Monad.Catch.catch` f)) m
                                 `Control.Monad.Catch.catch` (runFreeT . f)
   {-# INLINE catch #-}
 
@@ -413,19 +413,19 @@ instance (Monad m, Traversable m, Traversable f) => Traversable (FreeT f m) wher
 -- | Lift a monad homomorphism from @m@ to @n@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' f n@
 --
 -- @'hoistFreeT' :: ('Monad' m, 'Functor' f) => (m ~> n) -> 'FreeT' f m ~> 'FreeT' f n@
-hoistFreeT :: (Monad m, Applicative f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
-hoistFreeT mh = FreeT . mh . liftM (fmap (hoistFreeT mh)) . runFreeT
+hoistFreeT :: (Functor m, Applicative f) => (forall a. m a -> n a) -> FreeT f m b -> FreeT f n b
+hoistFreeT mh = FreeT . mh . fmap (fmap (hoistFreeT mh)) . runFreeT
 
 -- | Lift an applicative homomorphism from @f@ to @g@ into a monad homomorphism from @'FreeT' f m@ to @'FreeT' g m@
-transFreeT :: (Monad m, Applicative g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
-transFreeT nt = FreeT . liftM (fmap (transFreeT nt) . transFreeF nt) . runFreeT
+transFreeT :: (Functor m, Applicative g) => (forall a. f a -> g a) -> FreeT f m b -> FreeT g m b
+transFreeT nt = FreeT . fmap (fmap (transFreeT nt) . transFreeF nt) . runFreeT
 
 -- | Pull out and join @m@ layers of @'FreeT' f m a@.
-joinFreeT :: (Monad m, Traversable f, Applicative f) => FreeT f m a -> m (Free f a)
+joinFreeT :: (Functor m, Monad m, Traversable f, Applicative f) => FreeT f m a -> m (Free f a)
 joinFreeT (FreeT m) = m >>= joinFreeF
   where
     joinFreeF (Pure x) = return (return x)
-    joinFreeF (Free f) = wrap `liftM` Data.Traversable.mapM joinFreeT f
+    joinFreeF (Free f) = wrap <$> Data.Traversable.mapM joinFreeT f
 
 -- |
 -- 'retract' is the left inverse of 'liftF'
@@ -462,9 +462,9 @@ iterM phi = iterT phi . hoistFreeT (return . runIdentity)
 --
 -- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
 -- steps in the iteration is terminating.
-cutoff :: (Applicative f, Applicative m, Monad m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
-cutoff n _ | n <= 0 = return Nothing
-cutoff n (FreeT m) = FreeT $ bimap Just (cutoff (n - 1)) `liftM` m
+cutoff :: (Applicative f, Applicative m) => Integer -> FreeT f m a -> FreeT f m (Maybe a)
+cutoff n _ | n <= 0 = pure Nothing
+cutoff n (FreeT m) = FreeT $ bimap Just (cutoff (n - 1)) <$> m
 
 -- | @partialIterT n phi m@ interprets first @n@ layers of @m@ using @phi@.
 -- This is sort of the opposite for @'cutoff'@.
diff --git a/src/Control/Monad/Trans/Free/Church.hs b/src/Control/Monad/Trans/Free/Church.hs
index d613300..238ae11 100644
--- a/src/Control/Monad/Trans/Free/Church.hs
+++ b/src/Control/Monad/Trans/Free/Church.hs
@@ -74,10 +74,10 @@ import Data.Traversable (Traversable)
 newtype FT f m a = FT { runFT :: forall r. (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r }
 
 #ifdef LIFTED_FUNCTOR_CLASSES
-instance (Functor f, Monad m, Eq1 f, Eq1 m) => Eq1 (FT f m) where
+instance (Functor f, Applicative m, Monad m, Eq1 f, Eq1 m) => Eq1 (FT f m) where
   liftEq eq x y = liftEq eq (fromFT x) (fromFT y)
 
-instance (Functor f, Monad m, Ord1 f, Ord1 m) => Ord1 (FT f m) where
+instance (Functor f, Applicative m, Monad m, Ord1 f, Ord1 m) => Ord1 (FT f m) where
   liftCompare cmp x y= liftCompare cmp (fromFT x) (fromFT y)
 #else
 instance ( Functor f, Monad m, Eq1 f, Eq1 m
@@ -132,21 +132,21 @@ instance MonadPlus m => MonadPlus (FT f m) where
   mzero = FT (\_ _ -> mzero)
   mplus (FT k1) (FT k2) = FT $ \a fr -> k1 a fr `mplus` k2 a fr
 
-instance (Foldable f, Foldable m, Monad m) => Foldable (FT f m) where
+instance (Foldable f, Foldable m, Applicative m) => Foldable (FT f m) where
   foldr f r xs = F.foldr (<<<) id inner r
     where
-      inner = runFT xs (return . f) (\xg xf -> F.foldr (liftM2 (<<<) . xg) (return id) xf)
+      inner = runFT xs (pure . f) (\xg xf -> F.foldr (liftA2 (<<<) . xg) (pure id) xf)
   {-# INLINE foldr #-}
 
 #if MIN_VERSION_base(4,6,0)
   foldl' f z xs = F.foldl' (!>>>) id inner z
     where
       (!>>>) h g = \r -> g $! h r
-      inner = runFT xs (return . flip f) (\xg xf -> F.foldr (liftM2 (>>>) . xg) (return id) xf)
+      inner = runFT xs (pure . flip f) (\xg xf -> F.foldr (liftA2 (>>>) . xg) (pure id) xf)
   {-# INLINE foldl' #-}
 #endif
 
-instance (Monad m, Traversable m, Traversable f) => Traversable (FT f m) where
+instance (Applicative m, Monad m, Traversable m, Traversable f) => Traversable (FT f m) where
   traverse f (FT k) = fmap (join . lift) . T.sequenceA $ k traversePure traverseFree
     where
       traversePure = return . fmap return . f
@@ -156,7 +156,7 @@ instance (MonadIO m) => MonadIO (FT f m) where
   liftIO = lift . liftIO
   {-# INLINE liftIO #-}
 
-instance (Functor f, MonadError e m) => MonadError e (FT f m) where
+instance (Functor f, Applicative m, MonadError e m) => MonadError e (FT f m) where
   throwError = lift . throwError
   {-# INLINE throwError #-}
   m `catchError` f = toFT $ fromFT m `catchError` (fromFT . f)
@@ -170,7 +170,7 @@ instance MonadReader r m => MonadReader r (FT f m) where
   local f = hoistFT (local f)
   {-# INLINE local #-}
 
-instance (Functor f, MonadWriter w m) => MonadWriter w (FT f m) where
+instance (Functor f, Applicative m, MonadWriter w m) => MonadWriter w (FT f m) where
   tell = lift . tell
   {-# INLINE tell #-}
   listen = toFT . listen . fromFT
@@ -194,7 +194,7 @@ instance MonadThrow m => MonadThrow (FT f m) where
   throwM = lift . throwM
   {-# INLINE throwM #-}
 
-instance (Functor f, MonadCatch m) => MonadCatch (FT f m) where
+instance (Functor f, Applicative m, MonadCatch m) => MonadCatch (FT f m) where
   catch m f = toFT $ fromFT m `Control.Monad.Catch.catch` (fromFT . f)
   {-# INLINE catch #-}
 
@@ -208,7 +208,7 @@ toFT (FreeT f) = FT $ \ka kfr -> do
     Free fb -> kfr (\x -> runFT (toFT x) ka kfr) fb
 
 -- | Convert to a 'FreeT' free monad representation.
-fromFT :: (Monad m, Functor f) => FT f m a -> FreeT f m a
+fromFT :: (Applicative m, Monad m, Functor f) => FT f m a -> FreeT f m a
 fromFT (FT k) = FreeT $ k (return . Pure) (\xg -> runFreeT . wrap . fmap (FreeT . xg))
 
 -- | The \"free monad\" for a functor @f@.
@@ -242,8 +242,8 @@ transFT :: (forall a. f a -> g a) -> FT f m b -> FT g m b
 transFT phi (FT m) = FT (\kp kf -> m kp (\xg -> kf xg . phi))
 
 -- | Pull out and join @m@ layers of @'FreeT' f m a@.
-joinFT :: (Monad m, Traversable f) => FT f m a -> m (F f a)
-joinFT (FT m) = m (return . return) (\xg -> liftM wrap . T.mapM xg)
+joinFT :: (Applicative m, Traversable f) => FT f m a -> m (F f a)
+joinFT (FT m) = m (pure . pure) (\xg -> fmap wrap . T.traverse xg)
 
 -- | Cuts off a tree of computations at a given depth.
 -- If the depth is 0 or less, no computation nor
@@ -258,7 +258,7 @@ joinFT (FT m) = m (return . return) (\xg -> liftM wrap . T.mapM xg)
 --
 -- Calling 'retract . cutoff n' is always terminating, provided each of the
 -- steps in the iteration is terminating.
-cutoff :: (Functor f, Monad m) => Integer -> FT f m a -> FT f m (Maybe a)
+cutoff :: (Functor f, Applicative m, Monad m) => Integer -> FT f m a -> FT f m (Maybe a)
 cutoff n = toFT . FreeT.cutoff n . fromFT
 
 -- |
@@ -316,7 +316,7 @@ improve m = fromF m
 -- with only binds and returns by using 'FT' behind the scenes.
 --
 -- Similar to 'improve'.
-improveT :: (Functor f, Monad m) => (forall t. MonadFree f (t m) => t m a) -> FreeT f m a
+improveT :: (Functor f, Applicative m, Monad m) => (forall t. MonadFree f (t m) => t m a) -> FreeT f m a
 improveT m = fromFT m
 {-# INLINE improveT #-}
 
diff --git a/src/Control/Monad/Trans/Iter.hs b/src/Control/Monad/Trans/Iter.hs
index 25c8239..a94f296 100644
--- a/src/Control/Monad/Trans/Iter.hs
+++ b/src/Control/Monad/Trans/Iter.hs
@@ -204,17 +204,17 @@ instance (Functor m, Read1 m, Read a) => Read (IterT m a) where
 #endif
   readsPrec = readsPrec1
 
-instance Monad m => Functor (IterT m) where
-  fmap f = IterT . liftM (bimap f (fmap f)) . runIterT
+instance Functor m => Functor (IterT m) where
+  fmap f = IterT . fmap (bimap f (fmap f)) . runIterT
   {-# INLINE fmap #-}
 
-instance Monad m => Applicative (IterT m) where
+instance (Functor m, Monad m) => Applicative (IterT m) where
   pure = IterT . return . Left
   {-# INLINE pure #-}
   (<*>) = ap
   {-# INLINE (<*>) #-}
 
-instance Monad m => Monad (IterT m) where
+instance (Functor m, Monad m) => Monad (IterT m) where
   return = pure
   {-# INLINE return #-}
   IterT m >>= k = IterT $ m >>= either (runIterT . k) (return . Right . (>>= k))
@@ -222,30 +222,30 @@ instance Monad m => Monad (IterT m) where
   fail = Fail.fail
   {-# INLINE fail #-}
 
-instance Monad m => Fail.MonadFail (IterT m) where
+instance (Functor m, Monad m) => Fail.MonadFail (IterT m) where
   fail _ = never
   {-# INLINE fail #-}
 
-instance Monad m => Apply (IterT m) where
+instance (Functor m, Monad m) => Apply (IterT m) where
   (<.>) = ap
   {-# INLINE (<.>) #-}
 
-instance Monad m => Bind (IterT m) where
+instance (Functor m, Monad m) => Bind (IterT m) where
   (>>-) = (>>=)
   {-# INLINE (>>-) #-}
 
-instance MonadFix m => MonadFix (IterT m) where
+instance (Functor m, MonadFix m) => MonadFix (IterT m) where
   mfix f = IterT $ mfix $ runIterT . f . either id (error "mfix (IterT m): Right")
   {-# INLINE mfix #-}
 
-instance Monad m => Alternative (IterT m) where
+instance (Functor m, Monad m) => Alternative (IterT m) where
   empty = mzero
   {-# INLINE empty #-}
   (<|>) = mplus
   {-# INLINE (<|>) #-}
 
 -- | Capretta's 'race' combinator. Satisfies left catch.
-instance Monad m => MonadPlus (IterT m) where
+instance (Functor m, Monad m) => MonadPlus (IterT m) where
   mzero = never
   {-# INLINE mzero #-}
   (IterT x) `mplus` (IterT y) = IterT $ x >>= either
@@ -275,13 +275,13 @@ instance (Monad m, Traversable1 m) => Traversable1 (IterT m) where
     go (Right a) = Right <$> traverse1 f a
   {-# INLINE traverse1 #-}
 
-instance MonadReader e m => MonadReader e (IterT m) where
+instance (Functor m, MonadReader e m) => MonadReader e (IterT m) where
   ask = lift ask
   {-# INLINE ask #-}
   local f = hoistIterT (local f)
   {-# INLINE local #-}
 
-instance MonadWriter w m => MonadWriter w (IterT m) where
+instance (Functor m, MonadWriter w m) => MonadWriter w (IterT m) where
   tell = lift . tell
   {-# INLINE tell #-}
   listen (IterT m) = IterT $ liftM concat' $ listen (fmap listen `liftM` m)
@@ -299,7 +299,7 @@ instance MonadWriter w m => MonadWriter w (IterT m) where
   {-# INLINE writer #-}
 #endif
 
-instance MonadState s m => MonadState s (IterT m) where
+instance (Functor m, MonadState s m) => MonadState s (IterT m) where
   get = lift get
   {-# INLINE get #-}
   put s = lift (put s)
@@ -309,26 +309,26 @@ instance MonadState s m => MonadState s (IterT m) where
   {-# INLINE state #-}
 #endif
 
-instance MonadError e m => MonadError e (IterT m) where
+instance (Functor m, MonadError e m) => MonadError e (IterT m) where
   throwError = lift . throwError
   {-# INLINE throwError #-}
   IterT m `catchError` f = IterT $ liftM (fmap (`catchError` f)) m `catchError` (runIterT . f)
 
-instance MonadIO m => MonadIO (IterT m) where
+instance (Functor m, MonadIO m) => MonadIO (IterT m) where
   liftIO = lift . liftIO
 
-instance MonadCont m => MonadCont (IterT m) where
+instance (Functor m, MonadCont m) => MonadCont (IterT m) where
   callCC f = IterT $ callCC (\k -> runIterT $ f (lift . k . Left))
 
-instance Monad m => MonadFree Identity (IterT m) where
+instance (Functor m, Monad m) => MonadFree Identity (IterT m) where
   wrap = IterT . return . Right . runIdentity
   {-# INLINE wrap #-}
 
-instance MonadThrow m => MonadThrow (IterT m) where
+instance (Functor m, MonadThrow m) => MonadThrow (IterT m) where
   throwM = lift . throwM
   {-# INLINE throwM #-}
 
-instance MonadCatch m => MonadCatch (IterT m) where
+instance (Functor m, MonadCatch m) => MonadCatch (IterT m) where
   catch (IterT m) f = IterT $ liftM (fmap (`Control.Monad.Catch.catch` f)) m `Control.Monad.Catch.catch` (runIterT . f)
   {-# INLINE catch #-}
 
@@ -383,7 +383,7 @@ never = delay never
 -- @
 -- 'retract' ('untilJust' genId) :: IO Id
 -- @
-untilJust :: (Monad m) => m (Maybe a) -> IterT m a
+untilJust :: (Functor m, Monad m) => m (Maybe a) -> IterT m a
 untilJust f = maybe (delay (untilJust f)) return =<< lift f
 {-# INLINE untilJust #-}
 
@@ -405,7 +405,7 @@ untilJust f = maybe (delay (untilJust f)) return =<< lift f
 --
 -- Calling @'retract' '.' 'cutoff' n@ is always terminating, provided each of the
 -- steps in the iteration is terminating.
-cutoff :: (Monad m) => Integer -> IterT m a -> IterT m (Maybe a)
+cutoff :: (Functor m, Monad m) => Integer -> IterT m a -> IterT m (Maybe a)
 cutoff n | n <= 0 = const $ return Nothing
 cutoff n          = IterT . liftM (either (Left . Just)
                                        (Right . cutoff (n - 1))) . runIterT
@@ -415,7 +415,7 @@ cutoff n          = IterT . liftM (either (Left . Just)
 --
 --   The resulting computation has as many steps as the longest computation
 --   in the list.
-interleave :: Monad m => [IterT m a] -> IterT m [a]
+interleave :: (Functor m, Monad m) => [IterT m a] -> IterT m [a]
 interleave ms = IterT $ do
   xs <- mapM runIterT ms
   if null (rights xs)
@@ -430,12 +430,12 @@ interleave ms = IterT $ do
 --   in the list.
 --
 --   Equivalent to @'void' '.' 'interleave'@.
-interleave_ :: (Monad m) => [IterT m a] -> IterT m ()
+interleave_ :: (Functor m, Monad m) => [IterT m a] -> IterT m ()
 interleave_ [] = return ()
 interleave_ xs = IterT $ liftM (Right . interleave_ . rights) $ mapM runIterT xs
 {-# INLINE interleave_ #-}
 
-instance (Monad m, Semigroup a, Monoid a) => Monoid (IterT m a) where
+instance (Functor m, Monad m, Semigroup a, Monoid a) => Monoid (IterT m a) where
   mempty = return mempty
   mappend = (<>)
   mconcat = mconcat' . map Right
@@ -457,7 +457,7 @@ instance (Monad m, Semigroup a, Monoid a) => Monoid (IterT m a) where
       compact' a (r@(Right _):xs) = (Left a):(r:(compact xs))
       compact' a (  (Left a'):xs) = compact' (a `mappend` a') xs
 
-instance (Monad m, Semigroup a) => Semigroup (IterT m a) where
+instance (Functor m, Monad m, Semigroup a) => Semigroup (IterT m a) where
   x <> y = IterT $ do
     x' <- runIterT x
     y' <- runIterT y