Fix #16411 by making dataConCannotMatch aware of (~~)

The `dataConCannotMatch` function (which powers the
`-Wpartial-fields` warning, among other things) had special reasoning
for explicit equality constraints of the form `a ~ b`, but it did
not extend that reasoning to `a ~~ b` constraints, leading to #16411.
Easily fixed.

3 files changed, 22 insertions, 4 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 8baf43c7d3..690ed6854f 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -1403,10 +1403,13 @@ dataConCannotMatch tys con
 
     -- TODO: could gather equalities from superclasses too
     predEqs pred = case classifyPredType pred of
-                     EqPred NomEq ty1 ty2       -> [(ty1, ty2)]
-                     ClassPred eq [_, ty1, ty2]
-                       | eq `hasKey` eqTyConKey -> [(ty1, ty2)]
-                     _                          -> []
+                     EqPred NomEq ty1 ty2         -> [(ty1, ty2)]
+                     ClassPred eq args
+                       | eq `hasKey` eqTyConKey
+                       , [_, ty1, ty2] <- args    -> [(ty1, ty2)]
+                       | eq `hasKey` heqTyConKey
+                       , [_, _, ty1, ty2] <- args -> [(ty1, ty2)]
+                     _                            -> []
 
 -- | Were the type variables of the data con written in a different order
 -- than the regular order (universal tyvars followed by existential tyvars)?
diff --git a/testsuite/tests/typecheck/should_compile/T16411.hs b/testsuite/tests/typecheck/should_compile/T16411.hs
new file mode 100644
index 0000000000..5cbd255086
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T16411.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -Wpartial-fields #-}
+module T16411 where
+
+import Data.Type.Equality
+
+data T1 z where
+  MkT1a :: { rec1 :: () } -> T1 Int
+  MkT1b :: (z ~ Bool) => T1 z
+
+data T2 z where
+  MkT2a :: { rec2 :: () } -> T2 Int
+  MkT2b :: (z ~~ Bool) => T2 z
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index b94f021058..81a63c594f 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -670,3 +670,4 @@ test('T16204a', normal, compile, [''])
 test('T16204b', normal, compile, [''])
 test('T16225', normal, compile, [''])
 test('T13951', normal, compile, [''])
+test('T16411', normal, compile, [''])