Show missing field types (#18869)

13 files changed, 100 insertions, 30 deletions

diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 8f5240af48..e5d23948f1 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -1629,23 +1629,27 @@ mixedSelectors _ _ = panic "GHC.Tc.Gen.Expr: mixedSelectors emptylists"
 
 missingStrictFields :: ConLike -> [FieldLabelString] -> SDoc
 missingStrictFields con fields
-  = header <> rest
+  = vcat [header, nest 2 rest]
   where
+    pprField f = ppr f <+> text "::" <+> ppr (conLikeFieldType con f)
     rest | null fields = Outputable.empty  -- Happens for non-record constructors
                                            -- with strict fields
-         | otherwise   = colon <+> pprWithCommas ppr fields
+         | otherwise   = vcat (fmap pprField fields)
 
     header = text "Constructor" <+> quotes (ppr con) <+>
-             text "does not have the required strict field(s)"
+             text "does not have the required strict field(s)" <>
+             if null fields then Outputable.empty else colon
 
 missingFields :: ConLike -> [FieldLabelString] -> SDoc
 missingFields con fields
-  = header <> rest
+  = vcat [header, nest 2 rest]
   where
+    pprField f = ppr f <+> text "::" <+> ppr (conLikeFieldType con f)
     rest | null fields = Outputable.empty
-         | otherwise = colon <+> pprWithCommas ppr fields
+         | otherwise   = vcat (fmap pprField fields)
     header = text "Fields of" <+> quotes (ppr con) <+>
-             text "not initialised"
+             text "not initialised" <>
+             if null fields then Outputable.empty else colon
 
 -- callCtxt fun args = text "In the call" <+> parens (ppr (foldl' mkHsApp fun args))
 
diff --git a/testsuite/tests/deSugar/should_compile/T13870.stderr b/testsuite/tests/deSugar/should_compile/T13870.stderr
index 55868069d3..9f24693a65 100644
--- a/testsuite/tests/deSugar/should_compile/T13870.stderr
+++ b/testsuite/tests/deSugar/should_compile/T13870.stderr
@@ -5,6 +5,7 @@ T13870.hs:8:9: warning: [-Wmissing-fields (in -Wdefault)]
       In an equation for ‘test1’: test1 = Just {}
 
 T13870.hs:14:9: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘Identity’ not initialised: runIdentity
+    • Fields of ‘Identity’ not initialised:
+        runIdentity :: a
     • In the expression: Identity {}
       In an equation for ‘test3’: test3 = Identity {}
diff --git a/testsuite/tests/deSugar/should_compile/ds041.stderr b/testsuite/tests/deSugar/should_compile/ds041.stderr
index 5580c5eda3..5c90513ed1 100644
--- a/testsuite/tests/deSugar/should_compile/ds041.stderr
+++ b/testsuite/tests/deSugar/should_compile/ds041.stderr
@@ -3,6 +3,7 @@ ds041.hs:1:14: warning:
     -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
 
 ds041.hs:16:7: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘Foo’ not initialised: x
+    • Fields of ‘Foo’ not initialised:
+        x :: a
     • In the expression: Foo {}
       In an equation for ‘foo’: foo = Foo {}
diff --git a/testsuite/tests/patsyn/should_compile/T11283.stderr b/testsuite/tests/patsyn/should_compile/T11283.stderr
index 15b5bd033c..5339bd699a 100644
--- a/testsuite/tests/patsyn/should_compile/T11283.stderr
+++ b/testsuite/tests/patsyn/should_compile/T11283.stderr
@@ -1,5 +1,6 @@
 
 T11283.hs:6:5: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘S’ not initialised: x
+    • Fields of ‘S’ not initialised:
+        x :: Bool
     • In the expression: S {..}
       In an equation for ‘e’: e = S {..}
diff --git a/testsuite/tests/rename/should_compile/T5334.stderr b/testsuite/tests/rename/should_compile/T5334.stderr
index 3e15e5b9f0..ef22a01608 100644
--- a/testsuite/tests/rename/should_compile/T5334.stderr
+++ b/testsuite/tests/rename/should_compile/T5334.stderr
@@ -1,6 +1,7 @@
 
 T5334.hs:7:5: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘T’ not initialised: b
+    • Fields of ‘T’ not initialised:
+        b :: Int
     • In the expression: T {..}
       In an equation for ‘t’:
           t = T {..}
@@ -8,6 +9,7 @@ T5334.hs:7:5: warning: [-Wmissing-fields (in -Wdefault)]
                 a = 1
 
 T5334.hs:14:5: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘S’ not initialised: y
+    • Fields of ‘S’ not initialised:
+        y :: Int
     • In the expression: S {x = 1}
       In an equation for ‘s’: s = S {x = 1}
diff --git a/testsuite/tests/rename/should_fail/T12229.stderr b/testsuite/tests/rename/should_fail/T12229.stderr
index 4fc8678c5c..6eb4de53e2 100644
--- a/testsuite/tests/rename/should_fail/T12229.stderr
+++ b/testsuite/tests/rename/should_fail/T12229.stderr
@@ -1,5 +1,6 @@
 
 T12229.hs:7:7: warning: [-Wmissing-fields (in -Wdefault)]
-    • Fields of ‘MkT’ not initialised: pi
+    • Fields of ‘MkT’ not initialised:
+        pi :: Float
     • In the expression: MkT {..}
       In an equation for ‘f’: f x = MkT {..}
diff --git a/testsuite/tests/rename/should_fail/T5892a.stderr b/testsuite/tests/rename/should_fail/T5892a.stderr
index f1041796d9..23e9deb18b 100644
--- a/testsuite/tests/rename/should_fail/T5892a.stderr
+++ b/testsuite/tests/rename/should_fail/T5892a.stderr
@@ -1,6 +1,7 @@
 
 T5892a.hs:12:8: error: [-Wmissing-fields (in -Wdefault), -Werror=missing-fields]
-    • Fields of ‘Node’ not initialised: subForest
+    • Fields of ‘Node’ not initialised:
+        subForest :: [Tree a]
     • In the expression: Node {..}
       In the expression: let rootLabel = [] in Node {..}
       In an equation for ‘foo’:
diff --git a/testsuite/tests/typecheck/should_fail/T18869.hs b/testsuite/tests/typecheck/should_fail/T18869.hs
new file mode 100644
index 0000000000..b76ea79251
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T18869.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T18869 where
+
+data Foo where
+  MkFoo :: { foo :: !a } -> Foo
+
+testFoo :: Foo
+testFoo = MkFoo {}
+
+data Bar where
+  MkBar :: ( a ~ Int ) => { bar :: !a } -> Bar
+
+testBar :: Bar
+testBar = MkBar {}
+
+data Baz where
+  MkBaz :: { baz1 :: !a, baz2 :: !a } -> Baz
+
+testBaz :: Baz
+testBaz = MkBaz { baz1 = False }
+
+type family TQuux x where
+  TQuux Int = Bool
+data Quux a where
+  MkQuux :: { quux :: !( TQuux a ) } -> Quux a
+
+testQuux :: Quux Int
+testQuux = MkQuux {}
diff --git a/testsuite/tests/typecheck/should_fail/T18869.stderr b/testsuite/tests/typecheck/should_fail/T18869.stderr
new file mode 100644
index 0000000000..11c11f397e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T18869.stderr
@@ -0,0 +1,24 @@
+
+T18869.hs:10:11: error:
+    • Constructor ‘MkFoo’ does not have the required strict field(s):
+        foo :: a
+    • In the expression: MkFoo {}
+      In an equation for ‘testFoo’: testFoo = MkFoo {}
+
+T18869.hs:16:11: error:
+    • Constructor ‘MkBar’ does not have the required strict field(s):
+        bar :: a
+    • In the expression: MkBar {}
+      In an equation for ‘testBar’: testBar = MkBar {}
+
+T18869.hs:22:11: error:
+    • Constructor ‘MkBaz’ does not have the required strict field(s):
+        baz2 :: a
+    • In the expression: MkBaz {baz1 = False}
+      In an equation for ‘testBaz’: testBaz = MkBaz {baz1 = False}
+
+T18869.hs:30:12: error:
+    • Constructor ‘MkQuux’ does not have the required strict field(s):
+        quux :: TQuux a
+    • In the expression: MkQuux {}
+      In an equation for ‘testQuux’: testQuux = MkQuux {}
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index c9318dd18f..76f99f81c6 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -611,3 +611,4 @@ test('TyAppPat_PatternBindingExistential', normal, compile_fail, [''])
 test('TyAppPat_ScopedTyVarConflict', normal, compile_fail, [''])
 test('TyAppPat_TooMany', normal, compile_fail, [''])
 test('T12178a', normal, compile_fail, [''])
+test('T18869', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail085.stderr b/testsuite/tests/typecheck/should_fail/tcfail085.stderr
index 6c2e9bd913..f82cce8a6f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail085.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail085.stderr
@@ -1,5 +1,6 @@
 
-tcfail085.hs:9:5:
-    Constructor ‘F’ does not have the required strict field(s): y
-    In the expression: F {x = 2}
-    In an equation for ‘z’: z = F {x = 2}
+tcfail085.hs:9:5: error:
+    • Constructor ‘F’ does not have the required strict field(s):
+        y :: Int
+    • In the expression: F {x = 2}
+      In an equation for ‘z’: z = F {x = 2}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail112.stderr b/testsuite/tests/typecheck/should_fail/tcfail112.stderr
index a90cdfefe6..a3e81d0adb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail112.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail112.stderr
@@ -1,15 +1,17 @@
 
-tcfail112.hs:11:6:
-    Constructor ‘S’ does not have the required strict field(s): y
-    In the expression: S {}
-    In an equation for ‘s1’: s1 = S {}
+tcfail112.hs:11:6: error:
+    • Constructor ‘S’ does not have the required strict field(s):
+        y :: Int
+    • In the expression: S {}
+      In an equation for ‘s1’: s1 = S {}
 
-tcfail112.hs:12:6:
-    Constructor ‘S’ does not have the required strict field(s): y
-    In the expression: S {x = 3}
-    In an equation for ‘s2’: s2 = S {x = 3}
+tcfail112.hs:12:6: error:
+    • Constructor ‘S’ does not have the required strict field(s):
+        y :: Int
+    • In the expression: S {x = 3}
+      In an equation for ‘s2’: s2 = S {x = 3}
 
-tcfail112.hs:14:6:
-    Constructor ‘T’ does not have the required strict field(s)
-    In the expression: T {}
-    In an equation for ‘t’: t = T {}
+tcfail112.hs:14:6: error:
+    • Constructor ‘T’ does not have the required strict field(s)
+    • In the expression: T {}
+      In an equation for ‘t’: t = T {}
diff --git a/testsuite/tests/warnings/should_fail/WerrorFail2.stderr b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
index 66e99b9bbb..68c642107b 100644
--- a/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
+++ b/testsuite/tests/warnings/should_fail/WerrorFail2.stderr
@@ -10,7 +10,8 @@ WerrorFail2.hs:19:1: warning: [-Wmissing-signatures (in -Wall)]
     Top-level binding with no type signature: printRec :: IO ()
 
 WerrorFail2.hs:19:18: error: [-Wmissing-fields (in -Wdefault), -Werror=missing-fields]
-    • Fields of ‘Rec’ not initialised: f2
+    • Fields of ‘Rec’ not initialised:
+        f2 :: Int
     • In the first argument of ‘print’, namely ‘Rec {f1 = 1}’
       In the expression: print Rec {f1 = 1}
       In an equation for ‘printRec’: printRec = print Rec {f1 = 1}