[Git][ghc/ghc][wip/diagnostics-config] Add -fsuppress-error-contexts to disable printing error contexts in errors

sheaf (@sheaf) gitlab at gitlab.haskell.org
Tue Oct 18 10:58:48 UTC 2022 


sheaf pushed to branch wip/diagnostics-config at Glasgow Haskell Compiler / GHC


Commits:
d9be942d by Matthew Pickering at 2022-10-18T12:58:34+02:00
Add -fsuppress-error-contexts to disable printing error contexts in errors

In many development environments, the source span is the primary means
of seeing what an error message relates to, and the In the expression:
and In an equation for: clauses are not particularly relevant. However,
they can grow to be quite long, which can make the message itself both
feel overwhelming and interact badly with limited-space areas.

It's simple to implement this flag so we might as well do it and give
the user control about how they see their messages.

Fixes #21722

- - - - -


8 changed files:

- compiler/GHC/Driver/Config/Diagnostic.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- docs/users_guide/using.rst
- + testsuite/tests/driver/T21722.hs
- + testsuite/tests/driver/T21722.stderr
- testsuite/tests/driver/all.T


Changes:

=====================================
compiler/GHC/Driver/Config/Diagnostic.hs
=====================================
@@ -21,6 +21,7 @@ import GHC.Driver.Errors.Ppr ()
 import GHC.Tc.Errors.Types
 import GHC.HsToCore.Errors.Types
 import GHC.Types.Error
+import GHC.Tc.Errors.Ppr
 
 -- | Initialise the general configuration for printing diagnostic messages
 -- For example, this configuration controls things like whether warnings are
@@ -47,7 +48,7 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
 initPsMessageOpts _ = NoDiagnosticOpts
 
 initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
-initTcMessageOpts _ = NoDiagnosticOpts
+initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags }
 
 initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
 initDsMessageOpts _ = NoDiagnosticOpts


=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -427,6 +427,9 @@ data GeneralFlag
    | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps
    | Opt_SuppressCoreSizes  -- ^ Suppress per binding Core size stats in dumps
 
+   -- Error message suppression
+   | Opt_ShowErrorContext
+
    -- temporary flags
    | Opt_AutoLinkPackages
    | Opt_ImplicitImportQualified


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3508,7 +3508,8 @@ fFlagsDeps = [
       (\turn_on -> updM (\dflags -> do
         unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on)
                (addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.")
-        return dflags))
+        return dflags)),
+  flagSpec "show-error-context"               Opt_ShowErrorContext
 
   ]
   ++ fHoleFlags
@@ -3802,7 +3803,9 @@ defaultFlags settings
       Opt_VersionMacros,
       Opt_RPath,
       Opt_DumpWithWays,
-      Opt_CompactUnwind
+      Opt_CompactUnwind,
+      Opt_ShowErrorContext
+
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -18,6 +18,7 @@ module GHC.Tc.Errors.Ppr
   , withHsDocContext
   , pprHsDocContext
   , inHsDocContext
+  , TcRnMessageOpts(..)
   )
   where
 
@@ -96,16 +97,25 @@ import Data.Ord ( comparing )
 import Data.Bifunctor
 import GHC.Types.Name.Env
 
+data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not
+                                       }
+
+defaultTcRnMessageOpts :: TcRnMessageOpts
+defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True }
+
+
 instance Diagnostic TcRnMessage where
-  type DiagnosticOpts TcRnMessage = NoDiagnosticOpts
-  defaultDiagnosticOpts = NoDiagnosticOpts
+  type DiagnosticOpts TcRnMessage = TcRnMessageOpts
+  defaultDiagnosticOpts = defaultTcRnMessageOpts
   diagnosticMessage opts = \case
     TcRnUnknownMessage (UnknownDiagnostic @e m)
       -> diagnosticMessage (defaultDiagnosticOpts @e) m
     TcRnMessageWithInfo unit_state msg_with_info
       -> case msg_with_info of
            TcRnMessageDetailed err_info msg
-             -> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage opts msg)
+             -> messageWithInfoDiagnosticMessage unit_state err_info
+                  (tcOptsShowContext opts)
+                  (diagnosticMessage opts msg)
     TcRnSolverReport msg _ _
       -> mkSimpleDecorated $ pprSolverReportWithCtxt msg
     TcRnRedundantConstraints redundants (info, show_info)
@@ -1807,10 +1817,11 @@ deriveInstanceErrReasonHints cls newtype_deriving = \case
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
+                                 -> Bool
                                  -> DecoratedSDoc
                                  -> DecoratedSDoc
-messageWithInfoDiagnosticMessage unit_state ErrInfo{..} important =
-  let err_info' = map (pprWithUnitState unit_state) [errInfoContext, errInfoSupplementary]
+messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important =
+  let err_info' = map (pprWithUnitState unit_state) ([errInfoContext | show_ctxt] ++ [errInfoSupplementary])
       in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc`
          mkDecorated err_info'
 


=====================================
docs/users_guide/using.rst
=====================================
@@ -1360,6 +1360,18 @@ messages and in GHCi:
     error was detected.  This also affects the associated caret symbol that
     points at the region of code at fault.
 
+.. ghc-flag:: -fshow-error-context
+    :shortdesc: Whether to show textual information about error context
+    :type: dynamic
+    :reverse: -fno-show-error-context
+    :category: verbosity
+
+    :default: on
+
+    Controls whether GHC displays information about the context in which an
+    error occurred. This controls whether the part of the error message which
+    says "In the equation..", "In the pattern.." etc is displayed or not.
+
 .. ghc-flag:: -ferror-spans
     :shortdesc: Output full span in error messages
     :type: dynamic


=====================================
testsuite/tests/driver/T21722.hs
=====================================
@@ -0,0 +1,6 @@
+module T21722 where
+
+main = print ()
+  where
+    foo :: Int
+    foo = "abc"


=====================================
testsuite/tests/driver/T21722.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T21722.hs:6:11: error: [GHC-83865]
+    Couldn't match type ‘[Char]’ with ‘Int’
+    Expected: Int
+      Actual: String


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -313,3 +313,4 @@ test('T21349', extra_files(['T21349']), makefile_test, [])
 test('T21869', [normal, when(unregisterised(), skip)], makefile_test, [])
 test('T22044', normal, makefile_test, [])
 test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"])
+test('T21722', normal, compile_fail, ['-fno-show-error-context'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9be942dba7d6f6bfd5cc499371170f3f339b404

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9be942dba7d6f6bfd5cc499371170f3f339b404
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221018/313bd856/attachment-0001.html>

More information about the ghc-commits mailing list