Report better suggestion for GADT data constructor

This addresses issue #16427. An easy fix.

5 files changed, 26 insertions, 17 deletions

diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index a3e39adfe4..1ac12b096b 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -3021,9 +3021,8 @@ checkValidDataCon dflags existential_ok tc con
               , ppr orig_res_ty <+> dcolon <+> ppr (tcTypeKind orig_res_ty)])
 
 
-        ; checkTc (isJust (tcMatchTy res_ty_tmpl
-                                     orig_res_ty))
-                  (badDataConTyCon con res_ty_tmpl orig_res_ty)
+        ; checkTc (isJust (tcMatchTy res_ty_tmpl orig_res_ty))
+                  (badDataConTyCon con res_ty_tmpl)
             -- Note that checkTc aborts if it finds an error. This is
             -- critical to avoid panicking when we call dataConUserType
             -- on an un-rejiggable datacon!
@@ -3745,9 +3744,9 @@ noClassTyVarErr clas fam_tc
         , text "mentions none of the type or kind variables of the class" <+>
                 quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))]
 
-badDataConTyCon :: DataCon -> Type -> Type -> SDoc
-badDataConTyCon data_con res_ty_tmpl actual_res_ty
-  | ASSERT( all isTyVar actual_ex_tvs )
+badDataConTyCon :: DataCon -> Type -> SDoc
+badDataConTyCon data_con res_ty_tmpl
+  | ASSERT( all isTyVar tvs )
     tcIsForAllTy actual_res_ty
   = nested_foralls_contexts_suggestion
   | isJust (tcSplitPredFunTy_maybe actual_res_ty)
@@ -3757,6 +3756,8 @@ badDataConTyCon data_con res_ty_tmpl actual_res_ty
                 text "returns type" <+> quotes (ppr actual_res_ty))
        2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl))
   where
+    actual_res_ty = dataConOrigResTy data_con
+
     -- This suggestion is useful for suggesting how to correct code like what
     -- was reported in #12087:
     --
@@ -3786,13 +3787,8 @@ badDataConTyCon data_con res_ty_tmpl actual_res_ty
     --    underneath the nested foralls and contexts.
     -- 3) Smash together the type variables and class predicates from 1) and
     --    2), and prepend them to the rho type from 2).
-    actual_ex_tvs = dataConExTyCoVars data_con
-    actual_theta  = dataConTheta data_con
-    (actual_res_tvs, actual_res_theta, actual_res_rho)
-      = tcSplitNestedSigmaTys actual_res_ty
-    suggested_ty = mkSpecForAllTys (actual_ex_tvs ++ actual_res_tvs) $
-                   mkPhiTy (actual_theta ++ actual_res_theta)
-                   actual_res_rho
+    (tvs, theta, rho) = tcSplitNestedSigmaTys (dataConUserType data_con)
+    suggested_ty = mkSpecSigmaTy tvs theta rho
 
 badGadtDecl :: Name -> SDoc
 badGadtDecl tc_name
diff --git a/testsuite/tests/gadt/T12087.stderr b/testsuite/tests/gadt/T12087.stderr
index 03f2465c7a..0039e98657 100644
--- a/testsuite/tests/gadt/T12087.stderr
+++ b/testsuite/tests/gadt/T12087.stderr
@@ -9,27 +9,27 @@ T12087.hs:6:3: error:
 T12087.hs:9:3: error:
     • GADT constructor type signature cannot contain nested ‘forall’s or contexts
       Suggestion: instead use this type signature:
-        MkF2 :: forall a. (Ord a, Eq a) => F2 a
+        MkF2 :: forall a. (Ord a, Eq a) => a -> F2 a
     • In the definition of data constructor ‘MkF2’
       In the data type declaration for ‘F2’
 
 T12087.hs:12:3: error:
     • GADT constructor type signature cannot contain nested ‘forall’s or contexts
       Suggestion: instead use this type signature:
-        MkF3 :: forall a b. (Eq a, Eq b) => b -> F3 a
+        MkF3 :: forall a b. (Eq a, Eq b) => a -> b -> F3 a
     • In the definition of data constructor ‘MkF3’
       In the data type declaration for ‘F3’
 
 T12087.hs:15:3: error:
     • GADT constructor type signature cannot contain nested ‘forall’s or contexts
       Suggestion: instead use this type signature:
-        MkF4 :: forall a b. (Eq a, Eq b) => b -> F4 a
+        MkF4 :: forall a b. (Eq a, Eq b) => a -> b -> F4 a
     • In the definition of data constructor ‘MkF4’
       In the data type declaration for ‘F4’
 
 T12087.hs:18:3: error:
     • GADT constructor type signature cannot contain nested ‘forall’s or contexts
       Suggestion: instead use this type signature:
-        MkF5 :: forall a b. a -> Int -> Int -> b -> F5 a
+        MkF5 :: forall a b. Int -> Int -> a -> Int -> Int -> b -> F5 a
     • In the definition of data constructor ‘MkF5’
       In the data type declaration for ‘F5’
diff --git a/testsuite/tests/gadt/T16427.hs b/testsuite/tests/gadt/T16427.hs
new file mode 100644
index 0000000000..3bcbb7a464
--- /dev/null
+++ b/testsuite/tests/gadt/T16427.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RankNTypes, GADTs #-}
+
+module T16427 where
+
+data D where C :: Int -> forall b . b -> D
diff --git a/testsuite/tests/gadt/T16427.stderr b/testsuite/tests/gadt/T16427.stderr
new file mode 100644
index 0000000000..1c80190e29
--- /dev/null
+++ b/testsuite/tests/gadt/T16427.stderr
@@ -0,0 +1,7 @@
+
+T16427.hs:5:14: error:
+    • GADT constructor type signature cannot contain nested ‘forall’s or contexts
+      Suggestion: instead use this type signature:
+        C :: forall b. Int -> b -> D
+    • In the definition of data constructor ‘C’
+      In the data type declaration for ‘D’
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 86a9b0c910..bffb34ac00 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -119,3 +119,4 @@ test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret'])
 test('T14808', normal, compile, [''])
 test('T15009', normal, compile, [''])
 test('T15558', normal, compile, [''])
+test('T16427', normal, compile_fail, [''])