MonadFail proposal, phase 1

This implements phase 1 of the MonadFail proposal (MFP, #10751).

- MonadFail warnings are all issued as desired, tunable with two new flags
- GHC was *not* made warning-free with `-fwarn-missing-monadfail-warnings`
  (but it's disabled by default right now)

Credits/thanks to
- Franz Thoma, whose help was crucial to implementing this
- My employer TNG Technology Consulting GmbH for partially funding us
  for this work

Reviewers: goldfire, austin, #core_libraries_committee, hvr, bgamari, fmthoma

Reviewed By: hvr, bgamari, fmthoma

Subscribers: thomie

Projects: #ghc

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

GHC Trac Issues: #10751

8 files changed, 453 insertions, 0 deletions

diff --git a/testsuite/tests/monadfail/MonadFailErrors.hs b/testsuite/tests/monadfail/MonadFailErrors.hs
new file mode 100644
index 0000000000..f9db31e5a0
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailErrors.hs
@@ -0,0 +1,95 @@
+-- Test purpose:
+-- Break properly if MonadFail is live
+
+{-# LANGUAGE MonadFailDesugaring #-}
+
+module MonadFailWarnings where
+
+import Control.Monad.Fail
+import Control.Monad.ST
+import Data.Functor.Identity
+
+
+
+general :: Monad m => m a
+general = do
+    Just x <- undefined
+    undefined
+
+
+
+general' :: MonadFail m => m a
+general' = do
+    Just x <- undefined
+    undefined
+
+
+
+identity :: Identity a
+identity = do
+    Just x <- undefined
+    undefined
+
+
+
+io :: IO a
+io = do
+    Just x <- undefined
+    undefined
+
+
+
+st :: ST s a
+st = do
+    Just x <- undefined
+    undefined
+
+
+
+reader :: r -> a
+reader = do
+    Just x <- undefined
+    undefined
+
+
+
+newtype Newtype a = Newtype a
+newtypeMatch :: Identity a
+newtypeMatch = do
+    Newtype x <- undefined
+    undefined
+
+
+
+data Data a = Data a
+singleConMatch :: Identity a
+singleConMatch = do
+    Data x <- undefined
+    undefined
+
+
+
+data Maybe' a = Nothing' | Just' a
+instance Functor Maybe' where fmap = undefined
+instance Applicative Maybe' where pure = undefined; (<*>) = undefined
+instance Monad Maybe' where (>>=) = undefined
+instance MonadFail Maybe' where fail = undefined
+customFailable :: Maybe' a
+customFailable = do
+    Just x <- undefined
+    undefined
+
+
+wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a
+wildcardx = do
+    x <- undefined
+    undefined
+explicitlyIrrefutable = do
+    ~(x:y) <- undefined
+    undefined
+wildcard_ = do
+    _ <- undefined
+    undefined
+tuple = do
+    (a,b) <- undefined
+    undefined
diff --git a/testsuite/tests/monadfail/MonadFailErrors.stderr b/testsuite/tests/monadfail/MonadFailErrors.stderr
new file mode 100644
index 0000000000..ad661772c7
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailErrors.stderr
@@ -0,0 +1,74 @@
+
+MonadFailErrors.hs:16:5: error:
+    Could not deduce (MonadFail m) arising from a do statement
+    from the context: Monad m
+      bound by the type signature for:
+                 general :: Monad m => m a
+      at MonadFailErrors.hs:14:12-25
+    Possible fix:
+      add (MonadFail m) to the context of
+        the type signature for:
+          general :: Monad m => m a
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘general’:
+        general
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailErrors.hs:30:5: error:
+    No instance for (MonadFail Identity) arising from a do statement
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘identity’:
+        identity
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailErrors.hs:44:5: error:
+    No instance for (MonadFail (ST s)) arising from a do statement
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘st’:
+        st
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailErrors.hs:51:5: error:
+    No instance for (MonadFail ((->) r)) arising from a do statement
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘reader’:
+        reader
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailErrors.hs:59:5: error:
+    No instance for (MonadFail Identity) arising from a do statement
+    In a stmt of a 'do' block: Newtype x <- undefined
+    In the expression:
+      do { Newtype x <- undefined;
+           undefined }
+    In an equation for ‘newtypeMatch’:
+        newtypeMatch
+          = do { Newtype x <- undefined;
+                 undefined }
+
+MonadFailErrors.hs:67:5: error:
+    No instance for (MonadFail Identity) arising from a do statement
+    In a stmt of a 'do' block: Data x <- undefined
+    In the expression:
+      do { Data x <- undefined;
+           undefined }
+    In an equation for ‘singleConMatch’:
+        singleConMatch
+          = do { Data x <- undefined;
+                 undefined }
diff --git a/testsuite/tests/monadfail/MonadFailWarnings.hs b/testsuite/tests/monadfail/MonadFailWarnings.hs
new file mode 100644
index 0000000000..3b786cc8c7
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailWarnings.hs
@@ -0,0 +1,107 @@
+-- Test purpose:
+-- Ensure that MonadFail warnings are issued correctly if the warning flag
+-- is enabled
+
+{-# OPTIONS_GHC -fwarn-missing-monadfail-instance #-}
+
+module MonadFailWarnings where
+
+import Control.Monad.Fail
+import Control.Monad.ST
+import Data.Functor.Identity
+
+
+
+-- should warn, because the do-block gets a general Monad constraint,
+-- but should have MonadFail
+general :: Monad m => m a
+general = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should NOT warn, because the constraint is correct
+general' :: MonadFail m => m a
+general' = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should warn, because Identity isn't MonadFail
+identity :: Identity a
+identity = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should NOT warn, because IO is MonadFail
+io :: IO a
+io = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should warn, because (ST s) is not MonadFail
+st :: ST s a
+st = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should warn, because (r ->) is not MonadFail
+reader :: r -> a
+reader = do
+    Just x <- undefined
+    undefined
+
+
+
+-- should NOT warn, because matching against newtype
+newtype Newtype a = Newtype a
+newtypeMatch :: Identity a
+newtypeMatch = do
+    Newtype x <- undefined
+    undefined
+
+
+
+-- should NOT warn, because Data has only one constructor
+data Data a = Data a
+singleConMatch :: Identity a
+singleConMatch = do
+    Data x <- undefined
+    undefined
+
+
+
+-- should NOT warn, because Maybe' has a MonadFail instance
+data Maybe' a = Nothing' | Just' a
+instance Functor Maybe' where fmap = undefined
+instance Applicative Maybe' where pure = undefined; (<*>) = undefined
+instance Monad Maybe' where (>>=) = undefined
+instance MonadFail Maybe' where fail = undefined
+customFailable :: Maybe' a
+customFailable = do
+    Just x <- undefined
+    undefined
+
+
+-- should NOT warn, because patterns always match
+wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a
+wildcardx = do
+    x <- undefined
+    undefined
+explicitlyIrrefutable = do
+    ~(x:y) <- undefined
+    undefined
+wildcard_ = do
+    _ <- undefined
+    undefined
+tuple = do
+    (a,b) <- undefined
+    undefined
diff --git a/testsuite/tests/monadfail/MonadFailWarnings.stderr b/testsuite/tests/monadfail/MonadFailWarnings.stderr
new file mode 100644
index 0000000000..94858c1945
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailWarnings.stderr
@@ -0,0 +1,60 @@
+
+MonadFailWarnings.hs:19:5: warning:
+    Could not deduce (MonadFail m)
+      arising from the failable pattern ‘Just x’
+                   (this will become an error a future GHC release)
+    from the context: Monad m
+      bound by the type signature for:
+                 general :: Monad m => m a
+      at MonadFailWarnings.hs:17:12-25
+    Possible fix:
+      add (MonadFail m) to the context of
+        the type signature for:
+          general :: Monad m => m a
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘general’:
+        general
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailWarnings.hs:35:5: warning:
+    No instance for (MonadFail Identity)
+      arising from the failable pattern ‘Just x’
+                   (this will become an error a future GHC release)
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘identity’:
+        identity
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailWarnings.hs:51:5: warning:
+    No instance for (MonadFail (ST s))
+      arising from the failable pattern ‘Just x’
+                   (this will become an error a future GHC release)
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘st’:
+        st
+          = do { Just x <- undefined;
+                 undefined }
+
+MonadFailWarnings.hs:59:5: warning:
+    No instance for (MonadFail ((->) r))
+      arising from the failable pattern ‘Just x’
+                   (this will become an error a future GHC release)
+    In a stmt of a 'do' block: Just x <- undefined
+    In the expression:
+      do { Just x <- undefined;
+           undefined }
+    In an equation for ‘reader’:
+        reader
+          = do { Just x <- undefined;
+                 undefined }
diff --git a/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs b/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs
new file mode 100644
index 0000000000..d3df107a4a
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs
@@ -0,0 +1,94 @@
+-- Test purpose:
+-- Make sure that not enabling MonadFail warnings makes code compile just
+-- as it did in < 8.0
+
+module MonadFailWarnings where
+
+import Control.Monad.Fail
+import Control.Monad.ST
+import Data.Functor.Identity
+
+
+
+general :: Monad m => m a
+general = do
+    Just x <- undefined
+    undefined
+
+
+
+general' :: MonadFail m => m a
+general' = do
+    Just x <- undefined
+    undefined
+
+
+
+identity :: Identity a
+identity = do
+    Just x <- undefined
+    undefined
+
+
+
+io :: IO a
+io = do
+    Just x <- undefined
+    undefined
+
+
+
+st :: ST s a
+st = do
+    Just x <- undefined
+    undefined
+
+
+
+reader :: r -> a
+reader = do
+    Just x <- undefined
+    undefined
+
+
+
+newtype Newtype a = Newtype a
+newtypeMatch :: Identity a
+newtypeMatch = do
+    Newtype x <- undefined
+    undefined
+
+
+
+data Data a = Data a
+singleConMatch :: Identity a
+singleConMatch = do
+    Data x <- undefined
+    undefined
+
+
+
+data Maybe' a = Nothing' | Just' a
+instance Functor Maybe' where fmap = undefined
+instance Applicative Maybe' where pure = undefined; (<*>) = undefined
+instance Monad Maybe' where (>>=) = undefined
+instance MonadFail Maybe' where fail = undefined
+customFailable :: Maybe' a
+customFailable = do
+    Just x <- undefined
+    undefined
+
+
+wildcardx, explicitlyIrrefutable, wildcard_, tuple :: Monad m => m a
+wildcardx = do
+    x <- undefined
+    undefined
+explicitlyIrrefutable = do
+    ~(x:y) <- undefined
+    undefined
+wildcard_ = do
+    _ <- undefined
+    undefined
+tuple = do
+    (a,b) <- undefined
+    undefined
diff --git a/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.hs b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.hs
new file mode 100644
index 0000000000..c9f25027f9
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.hs
@@ -0,0 +1,14 @@
+-- Test purpose:
+-- RebindableSyntax does not play that well with MonadFail, so here we ensure
+-- that when both settings are enabled we get the proper warning.
+
+{-# OPTIONS_GHC -fwarn-missing-monadfail-instance #-}
+{-# LANGUAGE RebindableSyntax #-}
+
+module MonadFailWarningsWithRebindableSyntax where
+
+import Prelude
+
+test1 f g = do
+    Just x <- f
+    g
diff --git a/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr
new file mode 100644
index 0000000000..819c878dc9
--- /dev/null
+++ b/testsuite/tests/monadfail/MonadFailWarningsWithRebindableSyntax.stderr
@@ -0,0 +1,5 @@
+
+MonadFailWarningsWithRebindableSyntax.hs:13:5: warning:
+    The failable pattern ‘Just x’
+      is used together with -XRebindableSyntax. If this is intentional,
+      compile with -fno-warn-missing-monadfail-instance.
diff --git a/testsuite/tests/monadfail/all.T b/testsuite/tests/monadfail/all.T
new file mode 100644
index 0000000000..32eddb9e98
--- /dev/null
+++ b/testsuite/tests/monadfail/all.T
@@ -0,0 +1,4 @@
+test('MonadFailWarnings', normal, compile, [''])
+test('MonadFailErrors', normal, compile_fail, [''])
+test('MonadFailWarningsDisabled', normal, compile, [''])
+test('MonadFailWarningsWithRebindableSyntax', normal, compile, [''])