base: Remove `Monad(fail)` method and reexport `MonadFail(fail)` instead

As per https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail

Coauthored-by: Ben Gamari <ben@well-typed.com>

13 files changed, 53 insertions, 49 deletions

diff --git a/testsuite/tests/rebindable/DoRestrictedM.hs b/testsuite/tests/rebindable/DoRestrictedM.hs
index 2e982c1532..de28079769 100644
--- a/testsuite/tests/rebindable/DoRestrictedM.hs
+++ b/testsuite/tests/rebindable/DoRestrictedM.hs
@@ -30,11 +30,11 @@ m1 >> m2 = m1 >>= (const m2)
 
 newtype RegularM m a = RegularM{unRM :: m a}
 
-instance Prelude.Monad m => MN2 (RegularM m) a where
+instance Prelude.MonadFail m => MN2 (RegularM m) a where
     return = RegularM . Prelude.return
-    fail   = RegularM . Prelude.fail
+    fail = fail
 
-instance Prelude.Monad m => MN3 (RegularM m) a b where
+instance Prelude.MonadFail m => MN3 (RegularM m) a b where
     m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))
 
 -- We try to inject Maybe (as the regular monad) into Restricted Monad
diff --git a/testsuite/tests/rebindable/RebindableFailA.hs b/testsuite/tests/rebindable/RebindableFailA.hs
new file mode 100644
index 0000000000..0fc6444190
--- /dev/null
+++ b/testsuite/tests/rebindable/RebindableFailA.hs
@@ -0,0 +1,19 @@
+-- Test that RebindableSyntax and the new MonadFail interact correctly.
+--
+-- This should fail with the message "Failed with error".
+
+{-# LANGUAGE RebindableSyntax #-}
+
+import Prelude hiding (fail)
+
+fail :: String -> a
+fail _ = error "Failed with error"
+
+f :: Maybe Int -> Maybe ()
+f x = do
+  42 <- x
+  return ()
+{-# NOINLINE f #-}
+
+main = print (f (Just 55))
+
diff --git a/testsuite/tests/rebindable/RebindableFailA.stderr b/testsuite/tests/rebindable/RebindableFailA.stderr
new file mode 100644
index 0000000000..dfc52f42b0
--- /dev/null
+++ b/testsuite/tests/rebindable/RebindableFailA.stderr
@@ -0,0 +1,3 @@
+RebindableFailA: Failed with error
+CallStack (from HasCallStack):
+  error, called at RebindableFailA.hs:10:10 in main:Main
diff --git a/testsuite/tests/rebindable/RebindableFailB.hs b/testsuite/tests/rebindable/RebindableFailB.hs
new file mode 100644
index 0000000000..6c25864685
--- /dev/null
+++ b/testsuite/tests/rebindable/RebindableFailB.hs
@@ -0,0 +1,20 @@
+-- Test that RebindableSyntax and the new MonadFail interact correctly.
+--
+-- This should print "Just ()"
+
+{-# LANGUAGE RebindableSyntax #-}
+
+import Prelude hiding (fail)
+
+fail :: String -> a
+fail _ = error "Failed with error"
+
+f :: Maybe Int -> Maybe ()
+f x = do
+  42 <- x
+  return ()
+{-# NOINLINE f #-}
+
+main = print (f (Just 42))
+
+
diff --git a/testsuite/tests/rebindable/RebindableFailB.stdout b/testsuite/tests/rebindable/RebindableFailB.stdout
new file mode 100644
index 0000000000..7c2c1d94b9
--- /dev/null
+++ b/testsuite/tests/rebindable/RebindableFailB.stdout
@@ -0,0 +1 @@
+Just ()
diff --git a/testsuite/tests/rebindable/T5908.hs b/testsuite/tests/rebindable/T5908.hs
index 2666c3371a..ff5da8949a 100644
--- a/testsuite/tests/rebindable/T5908.hs
+++ b/testsuite/tests/rebindable/T5908.hs
@@ -25,11 +25,9 @@ class Monad m where
   (>>=) :: forall e ex x a b . m e ex a -> (a -> m ex x b) -> m e x b
   (>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b
   return :: a -> m ex ex a
-  fail :: String -> m e x a
 
   {-# INLINE (>>) #-}
   m >> k = m >>= \ _ -> k
-  fail = error
 
 type Writer w = WriterT w Identity
 
@@ -60,9 +58,6 @@ instance (Category w, Prelude.Monad m) => Monad (WriterT w m) where
     where
       (>>=) = (Prelude.>>=)
       return = Prelude.return
-  fail msg = WriterT $ fail msg
-    where
-      fail = Prelude.fail
 
 tell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()
 tell w = WriterT $ return ((), w)
diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T
index 7c8caea438..2caa486d9b 100644
--- a/testsuite/tests/rebindable/all.T
+++ b/testsuite/tests/rebindable/all.T
@@ -20,10 +20,8 @@ test('rebindable7', normal, compile_and_run, [''])
 test('rebindable8', normal, compile, [''])
 test('rebindable9', normal, compile, [''])
 test('rebindable10', normal, compile_and_run, [''])
-
-# Test rebindable clash warnings
-test('rebindable11', normal, compile, [''])
-test('rebindable12', normal, compile_fail, [''])
+test('RebindableFailA', exit_code(1), compile_and_run, [''])
+test('RebindableFailB', normal, compile_and_run, [''])
 
 test('T303', normal, compile, [''])
 
diff --git a/testsuite/tests/rebindable/rebindable1.hs b/testsuite/tests/rebindable/rebindable1.hs
index fcbe52fbc1..f966624710 100644
--- a/testsuite/tests/rebindable/rebindable1.hs
+++ b/testsuite/tests/rebindable/rebindable1.hs
@@ -1,5 +1,4 @@
-{-# OPTIONS_GHC -Wno-missing-monadfail-instances #-}
-{-# LANGUAGE RebindableSyntax, NPlusKPatterns, NoMonadFailDesugaring #-}
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}
 
 module RebindableCase1 where
         {
diff --git a/testsuite/tests/rebindable/rebindable11.hs b/testsuite/tests/rebindable/rebindable11.hs
deleted file mode 100644
index 13e1b2dd3d..0000000000
--- a/testsuite/tests/rebindable/rebindable11.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-{-# LANGUAGE RebindableSyntax, MonadFailDesugaring #-}
-{-# OPTIONS_GHC -Wno-missing-monadfail-instances #-}
-
--- Test that rebindable clash warnings are not displayed. This program
--- should not generate anything on stderr at compile time.
-
-module Main where
-
-import Prelude
-
-catMaybes xs = do
-    Just x <- xs
-    return x
-
-main = return ()
diff --git a/testsuite/tests/rebindable/rebindable11.stderr b/testsuite/tests/rebindable/rebindable11.stderr
deleted file mode 100644
index e69de29bb2..0000000000
--- a/testsuite/tests/rebindable/rebindable11.stderr
+++ /dev/null
diff --git a/testsuite/tests/rebindable/rebindable12.hs b/testsuite/tests/rebindable/rebindable12.hs
deleted file mode 100644
index fd2e1c7bb3..0000000000
--- a/testsuite/tests/rebindable/rebindable12.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE RebindableSyntax, MonadFailDesugaring #-}
-{-# OPTIONS_GHC -Wmissing-monadfail-instances #-}
-
--- Test that rebindable clash warnings are displayed.
-
-module Main where
-
-import Prelude
-
-catMaybes xs = do
-    Just x <- xs
-    return x
-
-main = return ()
diff --git a/testsuite/tests/rebindable/rebindable12.stderr b/testsuite/tests/rebindable/rebindable12.stderr
deleted file mode 100644
index 722a95c293..0000000000
--- a/testsuite/tests/rebindable/rebindable12.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-rebindable12.hs:11:5: error: [-Wmissing-monadfail-instances (in -Wcompat), -Werror=missing-monadfail-instances]
-    The failable pattern ‘Just x’
-      is used together with -XRebindableSyntax. If this is intentional,
-      compile with -Wno-missing-monadfail-instances.
diff --git a/testsuite/tests/rebindable/rebindable2.hs b/testsuite/tests/rebindable/rebindable2.hs
index 9fe15150f4..3858d2b9f3 100644
--- a/testsuite/tests/rebindable/rebindable2.hs
+++ b/testsuite/tests/rebindable/rebindable2.hs
@@ -8,7 +8,7 @@ module Main where
         import Prelude(String,undefined,Maybe(..),IO,putStrLn,
                 Integer,(++),Rational, (==), (>=) );
 
-        import Prelude(Monad(..),Applicative(..),Functor(..));
+        import Prelude(Monad(..),Applicative(..),Functor(..),MonadFail(..));
         import Control.Monad(ap, liftM);
 
         debugFunc :: String -> IO a -> IO a;
@@ -35,7 +35,9 @@ module Main where
                 (>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a))));
 
                 (>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb)));
-
+                };
+        instance (MonadFail TM) where
+                {
                 fail s = MkTM (debugFunc "fail" (Prelude.return undefined));
                 };