Suppress -Winaccessible-code in derived code

Summary:
It's rather unfortunate that derived code can produce inaccessible
code warnings (as demonstrated in #8128, #8740, and #15398), since
the programmer has no control over the generated code. This patch
aims to suppress `-Winaccessible-code` in all derived code. It
accomplishes this by doing the following:

* Generalize the `ic_env :: TcLclEnv` field of `Implication` to
  be of type `Env TcGblEnc TcLclEnv` instead. This way, it also
  captures `DynFlags`, which record the flag state at the time
  the `Implication` was created.
* When typechecking derived code, turn off `-Winaccessible-code`.
  This way, any insoluble given `Implication`s that are created when
  typechecking this derived code will remember that
  `-Winaccessible-code` was disabled.
* During error reporting, consult the `DynFlags` of an
  `Implication` before making the decision to report an inaccessible
  code warning.

Test Plan: make test TEST="T8128 T8740 T15398"

Reviewers: simonpj, bgamari

Reviewed By: simonpj

Subscribers: monoidal, rwbarton, thomie, carter

GHC Trac Issues: #8128, #8740, #15398

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

4 files changed, 21 insertions, 32 deletions

diff --git a/testsuite/tests/deriving/should_compile/T15398.hs b/testsuite/tests/deriving/should_compile/T15398.hs
new file mode 100644
index 0000000000..b78df1fa17
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T15398.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module T15398 where
+
+newtype Radius a = Radius a deriving (Eq, Ord)
+
+data CourseLine
+data OpenDistance
+data EndOfSpeedSection
+
+data Zone k a where
+    Point :: (Eq a, Ord a) => Zone CourseLine a
+    Vector :: (Eq a, Ord a) => Zone OpenDistance a
+    Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a
+
+deriving instance Eq a => Eq (Zone k a)
+deriving instance (Eq a, Ord a) => Ord (Zone k a)
diff --git a/testsuite/tests/deriving/should_compile/T8128.stderr b/testsuite/tests/deriving/should_compile/T8128.stderr
deleted file mode 100644
index 5f8b1307d1..0000000000
--- a/testsuite/tests/deriving/should_compile/T8128.stderr
+++ /dev/null
@@ -1,14 +0,0 @@
-
-T8128.hs:9:1: warning: [-Winaccessible-code (in -Wdefault)]
-    • Couldn't match type ‘Int’ with ‘Bool’
-      Inaccessible code in
-        a pattern with constructor: MkT2 :: Bool -> T Bool,
-        in an equation for ‘showsPrec’
-    • In the pattern: MkT2 b1
-      In an equation for ‘showsPrec’:
-          showsPrec a (MkT2 b1)
-            = showParen (a >= 11) ((.) (showString "MkT2 ") (showsPrec 11 b1))
-      When typechecking the code for ‘showsPrec’
-        in a derived instance for ‘Show (T Int)’:
-        To see the code I am typechecking, use -ddump-deriv
-      In the instance declaration for ‘Show (T Int)’
diff --git a/testsuite/tests/deriving/should_compile/T8740.stderr b/testsuite/tests/deriving/should_compile/T8740.stderr
deleted file mode 100644
index 9b60741027..0000000000
--- a/testsuite/tests/deriving/should_compile/T8740.stderr
+++ /dev/null
@@ -1,18 +0,0 @@
-
-T8740.hs:17:1: warning: [-Winaccessible-code (in -Wdefault)]
-    • Couldn't match type ‘Reified’ with ‘Abstract’
-      Inaccessible code in
-        a pattern with constructor:
-          ElectRefAsTypeOf :: forall a.
-                              Int -> Elect Abstract a -> Elect Abstract a,
-        in a case alternative
-    • In the pattern: ElectRefAsTypeOf {}
-      In a case alternative: ElectRefAsTypeOf {} -> GT
-      In the expression:
-        case b of
-          ElectRefAsTypeOf {} -> GT
-          ElectHandle b1 -> (a1 `compare` b1)
-          _ -> LT
-      When typechecking the code for ‘compare’
-        in a derived instance for ‘Ord (Elect p a)’:
-        To see the code I am typechecking, use -ddump-deriv
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index a224871b2a..cc0730f4e0 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -111,3 +111,4 @@ test('T14932', normal, compile, [''])
 test('T14933', normal, compile, [''])
 test('T15290c', normal, compile, [''])
 test('T15290d', normal, compile, [''])
+test('T15398', normal, compile, [''])