Generalise `Control.Monad.{foldM,foldM_}` to `Foldable` (#9586)

With this change `Control.Monad.foldM` becomes an alias for
`Data.Foldable.foldlM`.

Reviewed By: austin, ekmett

Differential Revision: https://phabricator.haskell.org/D251

4 files changed, 26 insertions, 21 deletions

diff --git a/libraries/base/Control/Monad.hs b/libraries/base/Control/Monad.hs
index db46dea699..07b011a6c3 100644
--- a/libraries/base/Control/Monad.hs
+++ b/libraries/base/Control/Monad.hs
@@ -75,7 +75,7 @@ module Control.Monad
     , (<$!>)
     ) where
 
-import Data.Foldable ( sequence_, msum, mapM_, forM_ )
+import Data.Foldable ( Foldable, sequence_, msum, mapM_, foldlM, forM_ )
 import Data.Functor ( void )
 import Data.Traversable ( forM, mapM, sequence )
 
@@ -156,21 +156,22 @@ function' are not commutative.
 >         f am xm
 
 If right-to-left evaluation is required, the input list should be reversed.
+
+Note: 'foldM' is the same as 'foldlM'
 -}
 
-foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM          :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
 {-# INLINEABLE foldM #-}
 {-# SPECIALISE foldM :: (a -> b -> IO a) -> a -> [b] -> IO a #-}
 {-# SPECIALISE foldM :: (a -> b -> Maybe a) -> a -> [b] -> Maybe a #-}
-foldM _ a []      =  return a
-foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs
+foldM          = foldlM
 
 -- | Like 'foldM', but discards the result.
-foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()
+foldM_         :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m ()
 {-# INLINEABLE foldM_ #-}
 {-# SPECIALISE foldM_ :: (a -> b -> IO a) -> a -> [b] -> IO () #-}
 {-# SPECIALISE foldM_ :: (a -> b -> Maybe a) -> a -> [b] -> Maybe () #-}
-foldM_ f a xs     = foldM f a xs >> return ()
+foldM_ f a xs  = foldlM f a xs >> return ()
 
 -- | @'replicateM' n act@ performs the action @n@ times,
 -- gathering the results.
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 52a076ba53..ed93b465c8 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -69,6 +69,8 @@
   * Generalise `Control.Monad.{when,unless,guard}` from `Monad` to
     `Applicative` and from `MonadPlus` to `Alternative` respectively.
 
+  * Generalise `Control.Monad.{foldM,foldM_}` to `Foldable`
+
   * New module `Data.OldList` containing only list-specialised versions of
     the functions from `Data.List` (in other words, `Data.OldList` corresponds
     to `base-4.7.0.1`'s `Data.List`)
diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
index 6372bd9fba..785f21ad89 100644
--- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr
@@ -1,14 +1,16 @@
-

-T1897b.hs:16:1:

-    Could not deduce (Depend a0 ~ Depend a)

-    from the context (Bug a)

-      bound by the inferred type for ‘isValid’:

-                 Bug a => [Depend a] -> Bool

-      at T1897b.hs:16:1-41

-    NB: ‘Depend’ is a type function, and may not be injective

-    The type variable ‘a0’ is ambiguous

-    Expected type: [Depend a] -> Bool

-      Actual type: [Depend a0] -> Bool

-    When checking that ‘isValid’ has the inferred type

-      isValid :: forall a. Bug a => [Depend a] -> Bool

-    Probable cause: the inferred type is ambiguous

+
+T1897b.hs:16:1:
+    Could not deduce (Depend a0 ~ Depend a)
+    from the context (Bug a, Foldable t)
+      bound by the inferred type for ‘isValid’:
+                 (Bug a, Foldable t) => t (Depend a) -> Bool
+      at T1897b.hs:16:1-41
+    NB: ‘Depend’ is a type function, and may not be injective
+    The type variable ‘a0’ is ambiguous
+    Expected type: t (Depend a) -> Bool
+      Actual type: t (Depend a0) -> Bool
+    When checking that ‘isValid’ has the inferred type
+      isValid :: forall a (t :: * -> *).
+                 (Bug a, Foldable t) =>
+                 t (Depend a) -> Bool
+    Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_compile/T4969.hs b/testsuite/tests/typecheck/should_compile/T4969.hs
index 2bdd4a7e98..e35b37eb27 100644
--- a/testsuite/tests/typecheck/should_compile/T4969.hs
+++ b/testsuite/tests/typecheck/should_compile/T4969.hs
@@ -63,7 +63,7 @@ instance ToAbstract LetDef [ALetBinding] where
                                undefined
         where letToAbstract = do
                   localToAbstract lhsArgs $ \args ->
-                          foldM lambda undefined undefined
+                          foldM lambda undefined (undefined :: [a])
               lambda _ _ = do x <- freshNoName undefined
                               return undefined
               lambda _ _ = typeError $ NotAValidLetBinding d