Compatibility fixup for Control.Monad.Trans.Free

ekmett · Jan 18, 2019 · 8aeb5d0 · 8aeb5d0
1 parent 1b8c193
commit 8aeb5d0
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 14 deletions.
diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
@@ -314,28 +314,28 @@ instance (Functor f, Functor m, Applicative m, Monad m) => Monad (FreeT f m) whe
 
   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 #-}
 
 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)
@@ -353,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
@@ -363,30 +363,30 @@ 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 #-}
 
@@ -510,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/Iter.hs b/src/Control/Monad/Trans/Iter.hs
@@ -204,8 +204,8 @@ 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