From 5e3c2b055d47a4748a84b9df8c9fb59acaeee49c Mon Sep 17 00:00:00 2001
From: Philip Hazelden <philip.hazelden@gmail.com>
Date: Sat, 10 Jun 2023 12:55:47 +0100
Subject: [PATCH] Don't suggest `DeriveAnyClass` when instance can't be
derived.
Fixes #19692.
Prototypical cases:
class C1 a where
x1 :: a -> Int
data G1 = G1 deriving C1
class C2 a where
x2 :: a -> Int
x2 _ = 0
data G2 = G2 deriving C2
Both of these used to give this suggestion, but for C1 the suggestion
would have failed (generated code with undefined methods, which compiles
but warns). Now C2 still gives the suggestion but C1 doesn't.
---
compiler/GHC/Tc/Deriv.hs | 24 +++--
.../deriving/should_fail/T11509_1.stderr | 1 -
.../tests/deriving/should_fail/T19692.hs | 63 +++++++++++++
.../tests/deriving/should_fail/T19692.stderr | 91 +++++++++++++++++++
testsuite/tests/deriving/should_fail/all.T | 1 +
testsuite/tests/generics/T5462No1.stderr | 5 +-
6 files changed, 175 insertions(+), 10 deletions(-)
create mode 100644 testsuite/tests/deriving/should_fail/T19692.hs
create mode 100644 testsuite/tests/deriving/should_fail/T19692.stderr
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index a7d0a0ff020f..262d34875607 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -65,6 +65,7 @@ import GHC.Utils.Logger
import GHC.Data.Bag
import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs)
import qualified GHC.LanguageExtensions as LangExt
+import GHC.Data.BooleanFormula ( isUnsatisfied )
import Control.Monad
import Control.Monad.Trans.Class
@@ -1442,19 +1443,24 @@ mk_eqn_no_strategy = do
-- See Note [DerivEnv and DerivSpecMechanism] in GHC.Tc.Deriv.Utils
whenIsJust (hasStockDeriving cls) $ \_ ->
expectNonDataFamTyCon dit
- mk_eqn_originative dit
+ mk_eqn_originative cls dit
| otherwise
-> mk_eqn_anyclass
where
-- Use heuristics (checkOriginativeSideConditions) to determine whether
-- stock or anyclass deriving should be used.
- mk_eqn_originative :: DerivInstTys -> DerivM EarlyDerivSpec
- mk_eqn_originative dit@(DerivInstTys { dit_tc = tc
- , dit_rep_tc = rep_tc }) = do
+ mk_eqn_originative :: Class -> DerivInstTys -> DerivM EarlyDerivSpec
+ mk_eqn_originative cls dit@(DerivInstTys { dit_tc = tc
+ , dit_rep_tc = rep_tc }) = do
dflags <- getDynFlags
- let isDeriveAnyClassEnabled =
- deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
+ let isDeriveAnyClassEnabled
+ | canSafelyDeriveAnyClass cls
+ = deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags)
+ | otherwise
+ -- Pretend that the extension is enabled so that we won't suggest
+ -- enabling it.
+ = YesDeriveAnyClassEnabled
-- See Note [Deriving instances for classes themselves]
let dac_error
@@ -1471,6 +1477,12 @@ mk_eqn_no_strategy = do
, dsm_stock_gen_fns = gen_fns }
CanDeriveAnyClass -> mk_eqn_from_mechanism DerivSpecAnyClass
+ canSafelyDeriveAnyClass cls =
+ -- If the set of minimal required definitions is nonempty,
+ -- `DeriveAnyClass` will generate an instance with undefined methods or
+ -- associated types, so don't suggest enabling it.
+ isNothing $ isUnsatisfied (const False) (classMinimalDef cls)
+
{-
************************************************************************
* *
diff --git a/testsuite/tests/deriving/should_fail/T11509_1.stderr b/testsuite/tests/deriving/should_fail/T11509_1.stderr
index 8af55d63c433..7aa8f6d8d1b1 100644
--- a/testsuite/tests/deriving/should_fail/T11509_1.stderr
+++ b/testsuite/tests/deriving/should_fail/T11509_1.stderr
@@ -5,4 +5,3 @@ T11509_1.hs:53:1: error: [GHC-23244]
if DeriveAnyClass is enabled
• In the stand-alone deriving instance for
‘(Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))’
- Suggested fix: Perhaps you intended to use DeriveAnyClass
diff --git a/testsuite/tests/deriving/should_fail/T19692.hs b/testsuite/tests/deriving/should_fail/T19692.hs
new file mode 100644
index 000000000000..05e877deb981
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T19692.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE AllowAmbiguousTypes, DefaultSignatures, DerivingStrategies #-}
+
+module T19692 where
+
+-- Should not suggest enabling DeriveAnyClass
+class C1 a where
+ x1 :: a -> Int
+data G1 = G1 deriving C1
+data G1' = G1'
+deriving instance C1 G1'
+
+-- These should all suggest doing that
+class C2 a
+data G2 = G2 deriving C2
+data G2' = G2'
+deriving instance C2 G2'
+
+class C3 a where
+ x3 :: a -> Int
+ x3 _ = 0
+data G3 = G3 deriving C3
+data G3' = G3'
+deriving instance C3 G3'
+
+class C4 a where
+ x4 :: a -> Int
+ default x4 :: Eq a => a -> Int
+ x4 _ = 0
+data G4 = G4 deriving C4
+data G4' = G4'
+deriving instance C4 G4'
+
+-- These cases use a different code path. These ones should suggest enabling it:
+class C5
+deriving instance C5
+
+class C6 a
+deriving instance C6 a
+
+-- These ones ideally shouldn't, but currently do:
+class C7 a where
+ x7 :: a -> Int
+deriving instance C7 a
+
+class C8 where
+ x8 :: Int
+deriving instance C8
+
+-- "Making an instance for a typeclass" is also handled specially. Should
+-- suggest:
+class C9 a
+deriving instance C9 Eq
+
+-- Should not suggest:
+class C10 a where
+ x10 :: a Int => Int
+deriving instance C10 Eq
+
+-- And "anyclass specifically asked for" is different again. We want to suggest
+-- even if it would generate a warning.
+data G11 = G11 Int deriving anyclass Eq
+data G11' = G11' Int
+deriving anyclass instance Eq G11'
diff --git a/testsuite/tests/deriving/should_fail/T19692.stderr b/testsuite/tests/deriving/should_fail/T19692.stderr
new file mode 100644
index 000000000000..fc599703ba64
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T19692.stderr
@@ -0,0 +1,91 @@
+
+T19692.hs:8:23: error: [GHC-00158]
+ • Can't make a derived instance of ‘C1 G1’:
+ ‘C1’ is not a stock derivable class (Eq, Show, etc.)
+ • In the data declaration for ‘G1’
+
+T19692.hs:10:1: error: [GHC-00158]
+ • Can't make a derived instance of ‘C1 G1'’:
+ ‘C1’ is not a stock derivable class (Eq, Show, etc.)
+ • In the stand-alone deriving instance for ‘C1 G1'’
+
+T19692.hs:14:23: error: [GHC-00158]
+ • Can't make a derived instance of ‘C2 G2’:
+ ‘C2’ is not a stock derivable class (Eq, Show, etc.)
+ • In the data declaration for ‘G2’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:16:1: error: [GHC-00158]
+ • Can't make a derived instance of ‘C2 G2'’:
+ ‘C2’ is not a stock derivable class (Eq, Show, etc.)
+ • In the stand-alone deriving instance for ‘C2 G2'’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:21:23: error: [GHC-00158]
+ • Can't make a derived instance of ‘C3 G3’:
+ ‘C3’ is not a stock derivable class (Eq, Show, etc.)
+ • In the data declaration for ‘G3’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:23:1: error: [GHC-00158]
+ • Can't make a derived instance of ‘C3 G3'’:
+ ‘C3’ is not a stock derivable class (Eq, Show, etc.)
+ • In the stand-alone deriving instance for ‘C3 G3'’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:29:23: error: [GHC-00158]
+ • Can't make a derived instance of ‘C4 G4’:
+ ‘C4’ is not a stock derivable class (Eq, Show, etc.)
+ • In the data declaration for ‘G4’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:31:1: error: [GHC-00158]
+ • Can't make a derived instance of ‘C4 G4'’:
+ ‘C4’ is not a stock derivable class (Eq, Show, etc.)
+ • In the stand-alone deriving instance for ‘C4 G4'’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:35:1: error: [GHC-38178]
+ • Can't make a derived instance of ‘C5’:
+ • In the stand-alone deriving instance for ‘C5’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:38:1: error: [GHC-38178]
+ • Can't make a derived instance of ‘C6 a’:
+ • In the stand-alone deriving instance for ‘C6 a’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:43:1: error: [GHC-38178]
+ • Can't make a derived instance of ‘C7 a’:
+ • In the stand-alone deriving instance for ‘C7 a’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:47:1: error: [GHC-38178]
+ • Can't make a derived instance of ‘C8’:
+ • In the stand-alone deriving instance for ‘C8’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:52:1: error: [GHC-23244]
+ • Can't make a derived instance of ‘C9 Eq’:
+ ‘Eq’ is a type class, and can only have a derived instance
+ if DeriveAnyClass is enabled
+ • In the stand-alone deriving instance for ‘C9 Eq’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:57:1: error: [GHC-23244]
+ • Can't make a derived instance of ‘C10 Eq’:
+ ‘Eq’ is a type class, and can only have a derived instance
+ if DeriveAnyClass is enabled
+ • In the stand-alone deriving instance for ‘C10 Eq’
+
+T19692.hs:61:38: error: [GHC-38178]
+ • Can't make a derived instance of
+ ‘Eq G11’ with the anyclass strategy:
+ • In the data declaration for ‘G11’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
+
+T19692.hs:63:1: error: [GHC-38178]
+ • Can't make a derived instance of
+ ‘Eq G11'’ with the anyclass strategy:
+ • In the stand-alone deriving instance for ‘Eq G11'’
+ Suggested fix: Perhaps you intended to use DeriveAnyClass
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index 541934835fc7..d1c897e059cc 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -76,6 +76,7 @@ test('T14916', normal, compile_fail, [''])
test('T16181', normal, compile_fail, [''])
test('T16923', normal, compile_fail, [''])
test('T18127b', normal, compile_fail, [''])
+test('T19692', normal, compile_fail, [''])
test('deriving-via-fail', normal, compile_fail, [''])
test('deriving-via-fail2', normal, compile_fail, [''])
test('deriving-via-fail3', normal, compile_fail, [''])
diff --git a/testsuite/tests/generics/T5462No1.stderr b/testsuite/tests/generics/T5462No1.stderr
index 53d1ffa6dfc9..48911b7007ba 100644
--- a/testsuite/tests/generics/T5462No1.stderr
+++ b/testsuite/tests/generics/T5462No1.stderr
@@ -1,5 +1,5 @@
-[1 of 2] Compiling GFunctor ( GFunctor\GFunctor.hs, out_T5462No1\GFunctor.o )
-[2 of 2] Compiling T5462No1 ( T5462No1.hs, out_T5462No1\T5462No1.o )
+[1 of 2] Compiling GFunctor ( GFunctor/GFunctor.hs, out_T5462No1/GFunctor.o )
+[2 of 2] Compiling T5462No1 ( T5462No1.hs, out_T5462No1/T5462No1.o )
T5462No1.hs:25:42: error: [GHC-82023]
• Can't make a derived instance of ‘GFunctor F’:
@@ -13,7 +13,6 @@ T5462No1.hs:27:23: error: [GHC-00158]
• Can't make a derived instance of ‘C1 G’:
‘C1’ is not a stock derivable class (Eq, Show, etc.)
• In the data declaration for ‘G’
- Suggested fix: Perhaps you intended to use DeriveAnyClass
T5462No1.hs:28:23: error: [GHC-00158]
• Can't make a derived instance of ‘C2 H’:
--
GitLab