Use captureTopConstraints in TcRnDriver calls

Trac #16376 showed the danger of failing to report an error
that exists only in the unsolved constraints, if an exception
is raised (via failM).

Well, the commit 5c1f268e (Fail fast in solveLocalEqualities)
did just that -- i.e. it found errors in the constraints, and
called failM to avoid a misleading cascade.

So we need to be sure to call captureTopConstraints to report
those insolubles.  This was wrong in TcRnDriver.tcRnExpr and
in TcRnDriver.tcRnType.

As a result the error messages from test T13466 improved slightly,
a happy outcome.

7 files changed, 47 insertions, 10 deletions

diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index fcac5cb33d..9c60709d3c 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -399,8 +399,8 @@ tcRnSrcDecls explicit_mod_hdr decls
 
         -- Check for the 'main' declaration
         -- Must do this inside the captureTopConstraints
+        -- NB: always set envs *before* captureTopConstraints
       ; (tcg_env, lie_main) <- setEnvs (tcg_env, tcl_env) $
-                               -- always set envs *before* captureTopConstraints
                                captureTopConstraints $
                                checkMain explicit_mod_hdr
 
@@ -502,10 +502,13 @@ run_th_modfinalizers = do
     let run_finalizer (lcl_env, f) =
             setLclEnv lcl_env (runRemoteModFinalizers f)
 
-    (_, lie_th) <- captureTopConstraints $ mapM_ run_finalizer th_modfinalizers
+    (_, lie_th) <- captureTopConstraints $
+                   mapM_ run_finalizer th_modfinalizers
+
       -- Finalizers can add top-level declarations with addTopDecls, so
       -- we have to run tc_rn_src_decls to get them
     (tcg_env, tcl_env, lie_top_decls) <- tc_rn_src_decls []
+
     setEnvs (tcg_env, tcl_env) $ do
       -- Subsequent rounds of finalizers run after any new constraints are
       -- simplified, or some types might not be complete when using reify
@@ -616,11 +619,12 @@ tcRnHsBootDecls hsc_src decls
                             , hs_defds  = def_decls
                             , hs_ruleds = rule_decls
                             , hs_annds  = _
-                            , hs_valds
-                                 = XValBindsLR (NValBinds val_binds val_sigs) })
+                            , hs_valds  = XValBindsLR (NValBinds val_binds val_sigs) })
               <- rnTopSrcDecls first_group
+
         -- The empty list is for extra dependencies coming from .hs-boot files
         -- See Note [Extra dependencies from .hs-boot files] in RnSource
+
         ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do {
               -- NB: setGblEnv **before** captureTopConstraints so that
               -- if the latter reports errors, it knows what's in scope
@@ -2360,8 +2364,9 @@ tcRnExpr hsc_env mode rdr_expr
     uniq <- newUnique ;
     let { fresh_it  = itName uniq (getLoc rdr_expr)
         ; orig = lexprCtOrigin rn_expr } ;
-    (tclvl, lie, res_ty)
-          <- pushLevelAndCaptureConstraints $
+    ((tclvl, res_ty), lie)
+          <- captureTopConstraints $
+             pushTcLevelM          $
              do { (_tc_expr, expr_ty) <- tcInferSigma rn_expr
                 ; if inst
                   then snd <$> deeplyInstantiate orig expr_ty
@@ -2430,7 +2435,7 @@ tcRnType hsc_env normalise rdr_type
         -- First bring into scope any wildcards
        ; traceTc "tcRnType" (vcat [ppr wcs, ppr rn_type])
        ; ((ty, kind), lie)  <-
-                       captureConstraints $
+                       captureTopConstraints $
                        tcWildCardBinders wcs $ \ wcs' ->
                        do { emitWildCardHoleConstraints wcs'
                           ; tcLHsTypeUnsaturated rn_type }
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 77ea116042..8b720d6b62 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1684,7 +1684,7 @@ Hence:
   - insolublesOnly in tryCaptureConstraints
   - emitConstraints in the Left case of captureConstraints
 
-Hover note that fresly-generated constraints like (Int ~ Bool), or
+However note that freshly-generated constraints like (Int ~ Bool), or
 ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
 insoluble.  The constraint solver does that.  So they'll be discarded.
 That's probably ok; but see th/5358 as a not-so-good example:
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index f50b33efc6..418aa987e4 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -81,8 +81,21 @@ captureTopConstraints :: TcM a -> TcM (a, WantedConstraints)
 -- generates plus the constraints produced by static forms inside.
 -- If it fails with an exception, it reports any insolubles
 -- (out of scope variables) before doing so
--- NB: bring any environments into scope before calling this, so that
--- the reportUnsolved has access to the most complete GlobalRdrEnv
+--
+-- captureTopConstraints is used exclusively by TcRnDriver at the top
+-- level of a module.
+--
+-- Importantly, if captureTopConstraints propagates an exception, it
+-- reports any insoluble constraints first, lest they be lost
+-- altogether.  This is important, because solveLocalEqualities (maybe
+-- other things too) throws an exception without adding any error
+-- messages; it just puts the unsolved constraints back into the
+-- monad. See TcRnMonad Note [Constraints and errors]
+-- Trac #16376 is an example of what goes wrong if you don't do this.
+--
+-- NB: the caller should bring any environments into scope before
+-- calling this, so that the reportUnsolved has access to the most
+-- complete GlobalRdrEnv
 captureTopConstraints thing_inside
   = do { static_wc_var <- TcM.newTcRef emptyWC ;
        ; (mb_res, lie) <- TcM.updGblEnv (\env -> env { tcg_static_wc = static_wc_var } ) $
diff --git a/testsuite/tests/ghci/scripts/T13466.stderr b/testsuite/tests/ghci/scripts/T13466.stderr
index ba3d5fda8f..edd05c5a4d 100644
--- a/testsuite/tests/ghci/scripts/T13466.stderr
+++ b/testsuite/tests/ghci/scripts/T13466.stderr
@@ -1,4 +1,6 @@
 
+<interactive>:1:1: error: Variable not in scope: out_of_scope
+
 <interactive>:1:1: error:
     • Cannot apply expression of type ‘t1’
       to a visible type argument ‘[]’
diff --git a/testsuite/tests/ghci/scripts/T16376.script b/testsuite/tests/ghci/scripts/T16376.script
new file mode 100644
index 0000000000..7bdc872322
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16376.script
@@ -0,0 +1,4 @@
+:set -XTypeApplications -XPolyKinds -XDataKinds
+:t id @Maybe
+type Id (a :: k) = a
+:k Id @Maybe
diff --git a/testsuite/tests/ghci/scripts/T16376.stderr b/testsuite/tests/ghci/scripts/T16376.stderr
new file mode 100644
index 0000000000..7b34531569
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16376.stderr
@@ -0,0 +1,12 @@
+
+<interactive>:1:5: error:
+    • Expecting one more argument to ‘Maybe’
+      Expected a type, but ‘Maybe’ has kind ‘* -> *’
+    • In the type ‘Maybe’
+      In the expression: id @Maybe
+
+<interactive>:1:5: error:
+    • Expecting one more argument to ‘Maybe’
+      Expected a type, but ‘Maybe’ has kind ‘* -> *’
+    • In the first argument of ‘Id’, namely ‘Maybe’
+      In the type ‘Id @Maybe’
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 946c6ef954..dd76a07f5c 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -292,3 +292,4 @@ test('T16030', normal, ghci_script, ['T16030.script'])
 test('T11606', normal, ghci_script, ['T11606.script'])
 test('T16089', normal, ghci_script, ['T16089.script'])
 test('T14828', expect_broken(14828), ghci_script, ['T14828.script'])
+test('T16376', normal, ghci_script, ['T16376.script'])