Skip type family defaults with hs-boot and hsig files

Works around #17190, possible resolution for #17224. New design is is
according to accepted [GHC Propoal 320].

Instances in signatures currently unconditionally opt into associated
family defaults if no explicit instance is given. This is bad for two
reasons:

  1. It constrains possible instantiations to use the default, rather
  than possibly define the associated family differently.

  2. It breaks compilation as type families are unsupported in
  signatures.

This PR simply turns off the filling in of defaults in those cases.
Additionally, it squelches a missing definition warning for hs-boot too
that was only squelched for hsig before.

The downsides are:

  1. There is no way to opt into the default, other than copying its
  definition.

  2. If we fixed type classes in signatures, and wanted instances to
  have to explicitly *out of* rather than into the default, that would
  now be a breaking change.

The change that is most unambiguously goood is harmonizing the warning
squelching between hs-boot or hsig. Maybe they should have the warning
(opt out of default) maybe they shouldn't (opt in to default), but
surely it should be the same for both.

Add hs-boot version of a backpack test regarding class-specified
defaults in instances that appear in an hs-boot file.

The metrics increase is very slight and makes no sense --- at least no
one has figured anything out after this languishing for a while, so I'm
just going to accept it.

Metric Increase:
  T10421a

[GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320

17 files changed, 269 insertions, 5 deletions

diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs
index 5fa26c2c57..baad1622c0 100644
--- a/compiler/GHC/Tc/TyCl/Class.hs
+++ b/compiler/GHC/Tc/TyCl/Class.hs
@@ -550,8 +550,10 @@ warnMissingAT name
   = do { warn <- woptM Opt_WarnMissingMethods
        ; traceTc "warn" (ppr name <+> ppr warn)
        ; hsc_src <- fmap tcg_src getGblEnv
-       -- Warn only if -Wmissing-methods AND not a signature
-       ; warnTc (Reason Opt_WarnMissingMethods) (warn && hsc_src /= HsigFile)
+       -- hs-boot and signatures never need to provide complete "definitions"
+       -- of any sort, as they aren't really defining anything, but just
+       -- constraining items which are defined elsewhere.
+       ; warnTc (Reason Opt_WarnMissingMethods) (warn && hsc_src == HsSrcFile)
                 (text "No explicit" <+> text "associated type"
                     <+> text "or default declaration for"
                     <+> quotes (ppr name)) }
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index b0dfa80f90..4cc8a79e1e 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -512,9 +512,18 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds
 
                       -- Check for missing associated types and build them
                       -- from their defaults (if available)
+                    ; is_boot <- tcIsHsBootOrSig
+                    ; let atItems = classATItems clas
                     ; tf_insts2 <- mapM (tcATDefault loc mini_subst defined_ats)
-                                        (classATItems clas)
-
+                                        (if is_boot then [] else atItems)
+                      -- Don't default type family instances, but rather omit, in hsig/hs-boot.
+                      -- Since hsig/hs-boot files are essentially large binders we want omission
+                      -- of the definition to result in no restriction, rather than for example
+                      -- attempting to "pattern match" with the invisible defaults and generate
+                      -- equalities. Without further handling, this would just result in a panic
+                      -- anyway.
+                      -- See https://github.com/ghc-proposals/ghc-proposals/pull/320 for
+                      -- additional discussion.
                     ; return (df_stuff, tf_insts1 ++ concat tf_insts2) }
 
 
@@ -539,8 +548,8 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds
               all_insts                      = tyfam_insts ++ datafam_insts
 
          -- In hs-boot files there should be no bindings
-        ; is_boot <- tcIsHsBootOrSig
         ; let no_binds = isEmptyLHsBinds binds && null uprags
+        ; is_boot <- tcIsHsBootOrSig
         ; failIfTc (is_boot && not no_binds) badBootDeclErr
 
         ; return ( [inst_info], all_insts, deriv_infos ) }
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index 6655e09360..ac8c2a7ed8 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -48,6 +48,10 @@ test('bkp53', normal, backpack_compile, [''])
 test('bkp54', normal, backpack_compile, [''])
 test('bkp55', normal, backpack_compile, [''])
 test('bkp56', normal, backpack_compile, [''])
+test('bkp57', normal, backpack_compile, [''])
+test('bkp58', normal, backpack_compile, [''])
+test('bkp59', normal, backpack_compile, [''])
+test('bkp60', normal, backpack_compile, [''])
 
 test('T13140', normal, backpack_compile, [''])
 test('T13149', expect_broken(13149), backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_compile/bkp57.bkp b/testsuite/tests/backpack/should_compile/bkp57.bkp
new file mode 100644
index 0000000000..51cc19b97c
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp57.bkp
@@ -0,0 +1,37 @@
+-- no default method, backpack
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+unit common where
+  module Class where
+    class Show (T x) => C x where
+      type T x
+      def :: T x
+      --type T x = ()
+unit consumer-abs where
+  dependency common
+  signature Instance where
+    import Class
+    data I = I Int
+    instance C I where
+      --type T I = ()
+  module Downstream where
+    import Class
+    import Instance
+    asdf :: C I => String
+    asdf = show $ def @I
+unit consumer-impl where
+  dependency common
+  module Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      type T I = ()
+      def = ()
+unit tie where
+  dependency consumer-impl
+  dependency consumer-abs[Instance=consumer-impl:Impl]
+  module Tie where
+    import Downstream
+    main = print asdf
diff --git a/testsuite/tests/backpack/should_compile/bkp57.stderr b/testsuite/tests/backpack/should_compile/bkp57.stderr
new file mode 100644
index 0000000000..96f769a402
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp57.stderr
@@ -0,0 +1,19 @@
+[1 of 4] Processing common
+  Instantiating common
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp57.out/common/Class.o )
+[2 of 4] Processing consumer-abs
+  [1 of 2] Compiling Instance[sig]    ( consumer-abs/Instance.hsig, nothing )
+  [2 of 2] Compiling Downstream       ( consumer-abs/Downstream.hs, nothing )
+[3 of 4] Processing consumer-impl
+  Instantiating consumer-impl
+  [1 of 1] Including common
+  [1 of 1] Compiling Impl             ( consumer-impl/Impl.hs, bkp57.out/consumer-impl/Impl.o )
+[4 of 4] Processing tie
+  Instantiating tie
+  [1 of 2] Including consumer-impl
+  [2 of 2] Including consumer-abs[Instance=consumer-impl:Impl]
+    Instantiating consumer-abs[Instance=consumer-impl:Impl]
+    [1 of 1] Including common
+    [1 of 2] Compiling Instance[sig]    ( consumer-abs/Instance.hsig, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o )
+    [2 of 2] Compiling Downstream       ( consumer-abs/Downstream.hs, bkp57.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o )
+  [1 of 1] Compiling Tie             ( tie/Tie.hs, bkp57.out/tie/Tie.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp58.bkp b/testsuite/tests/backpack/should_compile/bkp58.bkp
new file mode 100644
index 0000000000..6055e74496
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp58.bkp
@@ -0,0 +1,35 @@
+-- no default method, hs-boot
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+unit common where
+  module Class where
+    class Show (T x) => C x where
+      type T x
+      --type T x = ()
+      def :: T x
+unit consumer-impl where
+  dependency common
+  module {-# SOURCE #-} Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      --type T I = ()
+  module Downstream where
+    import Class
+    import {-# SOURCE #-} Impl
+    asdf :: C I => String
+    asdf = show $ def @I
+  module Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      type T I = ()
+      def = ()
+unit tie where
+  dependency consumer-impl
+  module Tie where
+    import Downstream
+    import Impl
+    main = print asdf
diff --git a/testsuite/tests/backpack/should_compile/bkp58.stderr b/testsuite/tests/backpack/should_compile/bkp58.stderr
new file mode 100644
index 0000000000..c5ce8bd55f
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp58.stderr
@@ -0,0 +1,13 @@
+[1 of 3] Processing common
+  Instantiating common
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp58.out/common/Class.o )
+[2 of 3] Processing consumer-impl
+  Instantiating consumer-impl
+  [1 of 1] Including common
+  [1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp58.out/consumer-impl/Impl.o-boot )
+  [2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp58.out/consumer-impl/Downstream.o )
+  [3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp58.out/consumer-impl/Impl.o )
+[3 of 3] Processing tie
+  Instantiating tie
+  [1 of 1] Including consumer-impl
+  [1 of 1] Compiling Tie             ( tie/Tie.hs, bkp58.out/tie/Tie.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp59.bkp b/testsuite/tests/backpack/should_compile/bkp59.bkp
new file mode 100644
index 0000000000..7ba77ec6c1
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp59.bkp
@@ -0,0 +1,38 @@
+-- default method, backpack
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+unit common where
+  module Class where
+    class Show (T x) => C x where
+      type T x
+      type T x = ()
+      def :: T x
+    class D x where
+unit consumer-abs where
+  dependency common
+  signature Instance where
+    import Class
+    data I = I Int
+    instance C I where
+      --type T I = ()
+  module Downstream where
+    import Class
+    import Instance
+    asdf :: C I => String
+    asdf = show $ def @I
+unit consumer-impl where
+  dependency common
+  module Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      type T I = ()
+      def = ()
+unit tie where
+  dependency consumer-impl
+  dependency consumer-abs[Instance=consumer-impl:Impl]
+  module Tie where
+    import Downstream
+    main = print asdf
diff --git a/testsuite/tests/backpack/should_compile/bkp59.stderr b/testsuite/tests/backpack/should_compile/bkp59.stderr
new file mode 100644
index 0000000000..364d6c2601
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp59.stderr
@@ -0,0 +1,19 @@
+[1 of 4] Processing common
+  Instantiating common
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp59.out/common/Class.o )
+[2 of 4] Processing consumer-abs
+  [1 of 2] Compiling Instance[sig]    ( consumer-abs/Instance.hsig, nothing )
+  [2 of 2] Compiling Downstream       ( consumer-abs/Downstream.hs, nothing )
+[3 of 4] Processing consumer-impl
+  Instantiating consumer-impl
+  [1 of 1] Including common
+  [1 of 1] Compiling Impl             ( consumer-impl/Impl.hs, bkp59.out/consumer-impl/Impl.o )
+[4 of 4] Processing tie
+  Instantiating tie
+  [1 of 2] Including consumer-impl
+  [2 of 2] Including consumer-abs[Instance=consumer-impl:Impl]
+    Instantiating consumer-abs[Instance=consumer-impl:Impl]
+    [1 of 1] Including common
+    [1 of 2] Compiling Instance[sig]    ( consumer-abs/Instance.hsig, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Instance.o )
+    [2 of 2] Compiling Downstream       ( consumer-abs/Downstream.hs, bkp59.out/consumer-abs/consumer-abs-EtqPCpl4Hcf9otzJUe9fPM/Downstream.o )
+  [1 of 1] Compiling Tie             ( tie/Tie.hs, bkp59.out/tie/Tie.o )
diff --git a/testsuite/tests/backpack/should_compile/bkp60.bkp b/testsuite/tests/backpack/should_compile/bkp60.bkp
new file mode 100644
index 0000000000..426ac1a75b
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp60.bkp
@@ -0,0 +1,35 @@
+-- default method, hs-boot
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
+unit common where
+  module Class where
+    class Show (T x) => C x where
+      type T x
+      type T x = ()
+      def :: T x
+unit consumer-impl where
+  dependency common
+  module {-# SOURCE #-} Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      --type T I = ()
+  module Downstream where
+    import Class
+    import {-# SOURCE #-} Impl
+    asdf :: C I => String
+    asdf = show $ def @I
+  module Impl where
+    import Class
+    data I = I Int
+    instance C I where
+      type T I = ()
+      def = ()
+unit tie where
+  dependency consumer-impl
+  module Tie where
+    import Downstream
+    import Impl
+    main = print asdf
diff --git a/testsuite/tests/backpack/should_compile/bkp60.stderr b/testsuite/tests/backpack/should_compile/bkp60.stderr
new file mode 100644
index 0000000000..070a908b17
--- /dev/null
+++ b/testsuite/tests/backpack/should_compile/bkp60.stderr
@@ -0,0 +1,13 @@
+[1 of 3] Processing common
+  Instantiating common
+  [1 of 1] Compiling Class            ( common/Class.hs, bkp60.out/common/Class.o )
+[2 of 3] Processing consumer-impl
+  Instantiating consumer-impl
+  [1 of 1] Including common
+  [1 of 3] Compiling Impl[boot]       ( consumer-impl/Impl.hs-boot, bkp60.out/consumer-impl/Impl.o-boot )
+  [2 of 3] Compiling Downstream       ( consumer-impl/Downstream.hs, bkp60.out/consumer-impl/Downstream.o )
+  [3 of 3] Compiling Impl             ( consumer-impl/Impl.hs, bkp60.out/consumer-impl/Impl.o )
+[3 of 3] Processing tie
+  Instantiating tie
+  [1 of 1] Including consumer-impl
+  [1 of 1] Compiling Tie             ( tie/Tie.hs, bkp60.out/tie/Tie.o )
diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs
new file mode 100644
index 0000000000..c066f70d55
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBoot.hs
@@ -0,0 +1,4 @@
+import ClassDefaultInHsBootA3
+import ClassDefaultInHsBootA2
+
+main = print asdf
diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs
new file mode 100644
index 0000000000..e83e1e8e8f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA1.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+-- Analogous to module Class from tests/backpack/should_compile/bkp58.bkp
+module ClassDefaultInHsBootA1 where
+
+class Show (T x) => C x where
+  type T x
+  type T x = Int
+  def :: T x
diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs
new file mode 100644
index 0000000000..a4dd9af667
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+module ClassDefaultInHsBootA2 where
+
+import ClassDefaultInHsBootA1
+
+data I = I Int
+
+instance C I where
+  type T I = ()
+  def = ()
diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot
new file mode 100644
index 0000000000..79cfe21342
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA2.hs-boot
@@ -0,0 +1,6 @@
+module ClassDefaultInHsBootA2 where
+
+import ClassDefaultInHsBootA1
+
+data I = I Int
+instance C I
diff --git a/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs
new file mode 100644
index 0000000000..c47e807608
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/ClassDefaultInHsBootA3.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE FlexibleContexts #-}
+module ClassDefaultInHsBootA3 where
+
+import ClassDefaultInHsBootA1
+import ClassDefaultInHsBootA2
+
+asdf :: String
+asdf = show $ def @I
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index ad682924e2..953f2489c7 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -724,4 +724,5 @@ test('T18323', normal, compile, [''])
 test('T18585', normal, compile, [''])
 test('T18831', normal, compile, [''])
 test('T15942', normal, compile, [''])
+test('ClassDefaultInHsBoot', [extra_files(['ClassDefaultInHsBootA1.hs','ClassDefaultInHsBootA2.hs','ClassDefaultInHsBootA2.hs-boot','ClassDefaultInHsBootA3.hs'])], multimod_compile, ['ClassDefaultInHsBoot', '-v0'])