diff --git a/src/Control/Monad/Trans/Free/Church.hs b/src/Control/Monad/Trans/Free/Church.hs index bd21171..0bea52b 100644 --- a/src/Control/Monad/Trans/Free/Church.hs +++ b/src/Control/Monad/Trans/Free/Church.hs @@ -146,7 +146,7 @@ instance (Foldable f, Foldable m, Applicative m) => Foldable (FT f m) where {-# 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@. @@ -243,7 +243,7 @@ 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 :: (Applicative m, Traversable f) => FT f m a -> m (F f a) -joinFT (FT m) = m (pure . pure) (\xg -> fmap wrap . traverse xg) +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 (pure . pure) (\xg -> fmap wrap . traverse 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 -- |