diff --git a/Control/Monad/Trans/List.hs b/Control/Monad/Trans/List.hs index 919898e47c80b944781d80bf21ea5a030851beff..0bdbcc732e8340e0cd0730088f0c2fc22b7cc375 100644 --- a/Control/Monad/Trans/List.hs +++ b/Control/Monad/Trans/List.hs @@ -146,7 +146,7 @@ instance (Monad m) => MonadPlus (ListT m) where instance (MonadFix m) => MonadFix (ListT m) where mfix f = ListT $ mfix (runListT . f . head) >>= \ xs -> case xs of [] -> return [] - x:_ -> liftM (x:) (runListT (mfix (mapListT (fmap tail) . f))) + x:_ -> liftM (x:) (runListT (mfix (mapListT (liftM tail) . f))) {-# INLINE mfix #-} instance MonadTrans ListT where