Fix a bad interaction between GADTs and COMPLETE sets

As observed in #14059 (starting at comment 5), the error
messages surrounding a program involving GADTs and a `COMPLETE` set
became worse between 8.2 and 8.4. The culprit was a new validity
check in 8.4 which filters out `COMPLETE` set candidates if a return
type of any conlike in the set doesn't match the type of the
scrutinee. However, this check was too conservative, since it removed
perfectly valid `COMPLETE` sets that contained GADT constructors,
which quite often have return types that don't match the type of a
scrutinee.

To fix this, I adopted the most straightforward possible solution of
only performing this validity check on //pattern synonym//
constructors, not //data// constructors.

Note that this does not fix #14059 entirely, but instead simply fixes
a particular buglet that was discovered in that ticket.

Test Plan: make test TEST=T14059

Reviewers: bgamari, mpickering

Reviewed By: mpickering

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14059

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

3 files changed, 32 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.hs b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs
new file mode 100644
index 0000000000..6128a8beaa
--- /dev/null
+++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wincomplete-patterns #-}
+module T14059a where
+
+data SBool (z :: Bool) where
+  SFalse :: SBool False
+  STrue  :: SBool True
+
+pattern STooGoodToBeTrue :: forall (z :: Bool). ()
+                         => z ~ True
+                         => SBool z
+pattern STooGoodToBeTrue = STrue
+{-# COMPLETE SFalse, STooGoodToBeTrue #-}
+
+wibble :: SBool z -> Bool
+wibble STrue = True
+
+wobble :: SBool z -> Bool
+wobble STooGoodToBeTrue = True
diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr
new file mode 100644
index 0000000000..4a52c97dfe
--- /dev/null
+++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr
@@ -0,0 +1,8 @@
+
+T14059a.hs:20:1: warning: [-Wincomplete-patterns (in -Wextra)]
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘wibble’: Patterns not matched: SFalse
+
+T14059a.hs:23:1: warning: [-Wincomplete-patterns (in -Wextra)]
+    Pattern match(es) are non-exhaustive
+    In an equation for ‘wobble’: Patterns not matched: SFalse
diff --git a/testsuite/tests/pmcheck/complete_sigs/all.T b/testsuite/tests/pmcheck/complete_sigs/all.T
index 7e47877c1b..d58c182f8e 100644
--- a/testsuite/tests/pmcheck/complete_sigs/all.T
+++ b/testsuite/tests/pmcheck/complete_sigs/all.T
@@ -13,4 +13,5 @@ test('completesig12', normal, compile, [''])
 test('completesig13', normal, compile, [''])
 test('completesig14', normal, compile, [''])
 test('completesig15', normal, compile_fail, [''])
+test('T14059a', normal, compile, [''])
 test('T14253', expect_broken(14253), compile, [''])