From 8aeb5d080f33a571b8e4d16618513b28e4e9f7f0 Mon Sep 17 00:00:00 2001 From: hololeap Date: Fri, 18 Jan 2019 16:41:36 -0700 Subject: [PATCH] Compatibility fixup for Control.Monad.Trans.Free --- src/Control/Monad/Trans/Free.hs | 24 ++++++++++++------------ src/Control/Monad/Trans/Iter.hs | 4 ++-- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs index abb62f6..5d47662 100644 --- a/src/Control/Monad/Trans/Free.hs +++ b/src/Control/Monad/Trans/Free.hs @@ -314,14 +314,14 @@ 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 #-} @@ -329,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) @@ -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 index 25c8239..663c125 100644 --- 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