[Git][ghc/ghc][master] compiler,ghci: error codes link to HF error index

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Sep 19 23:08:51 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
86d2971e by doyougnu at 2023-09-19T19:08:19-04:00
compiler,ghci: error codes link to HF error index

closes: #23259

- adds -fprint-error-index-links={auto|always|never} flag

- - - - -


17 changed files:

- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Utils/Outputable.hs
- docs/users_guide/expected-undocumented-flags.txt
- docs/users_guide/using.rst
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Builders/RunTest.hs
- testsuite/mk/test.mk
- testsuite/tests/ghc-api/target-contents/TargetContents.hs
- + testsuite/tests/ghci/should_fail/GHCiErrorIndexLinks.script
- + testsuite/tests/ghci/should_fail/GHCiErrorIndexLinks.stderr
- testsuite/tests/ghci/should_fail/all.T
- testsuite/tests/runghc/Makefile
- + testsuite/tests/typecheck/should_fail/ErrorIndexLinks.hs
- + testsuite/tests/typecheck/should_fail/ErrorIndexLinks.stderr
- testsuite/tests/typecheck/should_fail/all.T


Changes:

=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -413,6 +413,8 @@ data DynFlags = DynFlags {
   useUnicode            :: Bool,
   useColor              :: OverridingBool,
   canUseColor           :: Bool,
+  useErrorLinks         :: OverridingBool,
+  canUseErrorLinks      :: Bool,
   colScheme             :: Col.Scheme,
 
   -- | what kind of {-# SCC #-} to add automatically
@@ -513,6 +515,8 @@ initDynFlags dflags = do
         useUnicode    = useUnicode',
         useColor      = useColor',
         canUseColor   = stderrSupportsAnsiColors,
+        -- if the terminal supports color, we assume it supports links as well
+        canUseErrorLinks = stderrSupportsAnsiColors,
         colScheme     = colScheme',
         tmpDir        = TempDir tmp_dir
         }
@@ -679,6 +683,8 @@ defaultDynFlags mySettings =
         useUnicode = False,
         useColor = Auto,
         canUseColor = False,
+        useErrorLinks = Auto,
+        canUseErrorLinks = False,
         colScheme = Col.defaultScheme,
         profAuto = NoProfAuto,
         callerCcFilters = [],
@@ -1191,7 +1197,6 @@ defaultFlags settings
     -- Default floating flags (see Note [RHS Floating])
     ++ [ Opt_LocalFloatOut, Opt_LocalFloatOutTopLevel ]
 
-
     ++ default_PIC platform
 
     ++ validHoleFitDefaults
@@ -1479,7 +1484,6 @@ versionedFilePath platform = uniqueSubdir platform
 
 -- SDoc
 -------------------------------------------
-
 -- | Initialize the pretty-printing options
 initSDocContext :: DynFlags -> PprStyle -> SDocContext
 initSDocContext dflags style = SDC
@@ -1490,6 +1494,7 @@ initSDocContext dflags style = SDC
   , sdocDefaultDepth                = pprUserLength dflags
   , sdocLineLength                  = pprCols dflags
   , sdocCanUseUnicode               = useUnicode dflags
+  , sdocPrintErrIndexLinks          = overrideWith (canUseErrorLinks dflags) (useErrorLinks dflags)
   , sdocHexWordLiterals             = gopt Opt_HexWordLiterals dflags
   , sdocPprDebug                    = dopt Opt_D_ppr_debug dflags
   , sdocPrintUnicodeSyntax          = gopt Opt_PrintUnicodeSyntax dflags


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1314,6 +1314,13 @@ dynamic_flags_deps = [
   , make_ord_flag defFlag "fdiagnostics-color=never"
       (NoArg (upd (\d -> d { useColor = Never })))
 
+  , make_ord_flag defFlag "fprint-error-index-links=auto"
+      (NoArg (upd (\d -> d { useErrorLinks = Auto })))
+  , make_ord_flag defFlag "fprint-error-index-links=always"
+      (NoArg (upd (\d -> d { useErrorLinks = Always })))
+  , make_ord_flag defFlag "fprint-error-index-links=never"
+      (NoArg (upd (\d -> d { useErrorLinks = Never })))
+
   -- Suppress all that is suppressible in core dumps.
   -- Except for uniques, as some simplifier phases introduce new variables that
   -- have otherwise identical names.


=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -603,9 +603,18 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
                   -> brackets msg
               _   -> empty
 
+          ppr_with_hyperlink code =
+            -- this is a bit hacky, but we assume that if the terminal supports colors
+            -- then it should also support links
+            sdocOption (\ ctx -> sdocPrintErrIndexLinks ctx) $
+              \ use_hyperlinks ->
+                 if use_hyperlinks
+                 then ppr $ LinkedDiagCode code
+                 else ppr code
+
           code_doc =
             case msg_class of
-              MCDiagnostic _ _ (Just code) -> brackets (coloured msg_colour $ ppr code)
+              MCDiagnostic _ _ (Just code) -> brackets (coloured msg_colour $ ppr_with_hyperlink code)
               _                            -> empty
 
           flag_msg :: Severity -> DiagnosticReason -> Maybe SDoc
@@ -813,5 +822,23 @@ instance Show DiagnosticCode where
   show (DiagnosticCode prefix c) =
     prefix ++ "-" ++ printf "%05d" c
       -- pad the numeric code to have at least 5 digits
+
 instance Outputable DiagnosticCode where
   ppr code = text (show code)
+
+-- | A newtype that is a witness to the `-fprint-error-index-links` flag. It
+-- alters the @Outputable@ instance to emit @DiagnosticCode@ as ANSI hyperlinks
+-- to the HF error index
+newtype LinkedDiagCode = LinkedDiagCode DiagnosticCode
+
+instance Outputable LinkedDiagCode where
+  ppr (LinkedDiagCode d at DiagnosticCode{}) = linkEscapeCode d
+
+-- | Wrap the link in terminal escape codes specified by OSC 8.
+linkEscapeCode :: DiagnosticCode -> SDoc
+linkEscapeCode d = text "\ESC]8;;" <> hfErrorLink d -- make the actual link
+                   <> text "\ESC\\" <> ppr d <> text "\ESC]8;;\ESC\\" -- the rest is the visible text
+
+-- | create a link to the HF error index given an error code.
+hfErrorLink :: DiagnosticCode -> SDoc
+hfErrorLink errorCode = text "https://errors.haskell.org/messages/" <> ppr errorCode


=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -396,6 +396,7 @@ data SDocContext = SDC
   , sdocCanUseUnicode               :: !Bool
       -- ^ True if Unicode encoding is supported
       -- and not disabled by GHC_NO_UNICODE environment variable
+  , sdocPrintErrIndexLinks          :: !Bool
   , sdocHexWordLiterals             :: !Bool
   , sdocPprDebug                    :: !Bool
   , sdocPrintUnicodeSyntax          :: !Bool
@@ -457,6 +458,7 @@ defaultSDocContext = SDC
   , sdocDefaultDepth                = 5
   , sdocLineLength                  = 100
   , sdocCanUseUnicode               = False
+  , sdocPrintErrIndexLinks          = False
   , sdocHexWordLiterals             = False
   , sdocPprDebug                    = False
   , sdocPrintUnicodeSyntax          = False


=====================================
docs/users_guide/expected-undocumented-flags.txt
=====================================
@@ -41,6 +41,9 @@
 -fdiagnostics-color=always
 -fdiagnostics-color=auto
 -fdiagnostics-color=never
+-fprint-error-index-links=always
+-fprint-error-index-links=auto
+-fprint-error-index-links=never
 -fembed-manifest
 -fextended-default-rules
 -ffast-pap-calls


=====================================
docs/users_guide/using.rst
=====================================
@@ -1470,6 +1470,20 @@ messages and in GHCi:
     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:: -fprint-error-index-links=⟨always|auto|never⟩
+    :shortdesc: Whether to emit diagnostic codes as ANSI hyperlinks to the
+                Haskell Error Index.
+    :type: dynamic
+    :category: verbosity
+
+    :default: auto
+
+    Controls whether GHC will emit error indices as ANSI hyperlinks to the
+    `Haskell Error Index <https://errors.haskell.org/>`_. When set to auto, this
+    flag will render hyperlinks if the terminal is capable; when set to always,
+    this flag will render the hyperlinks regardless of the capabilities of the
+    terminal.
+
 .. ghc-flag:: -ferror-spans
     :shortdesc: Output full span in error messages
     :type: dynamic


=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -244,7 +244,7 @@ testRules = do
         ghcFlags        <- runTestGhcFlags
         let ghciFlags = ghcFlags ++ unwords
               [ "--interactive", "-v0", "-ignore-dot-ghci"
-              , "-fno-ghci-history"
+              , "-fno-ghci-history", "-fprint-error-index-links=never"
               ]
         ccPath          <- queryTargetTarget (Toolchain.prgPath . Toolchain.ccProgram . Toolchain.tgtCCompiler)
         ccFlags         <- queryTargetTarget (unwords . Toolchain.prgFlags . Toolchain.ccProgram . Toolchain.tgtCCompiler)


=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -51,7 +51,7 @@ runTestGhcFlags = do
     -- Take flags to send to the Haskell compiler from test.mk.
     -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
     unwords <$> sequence
-        [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways -rtsopts"
+        [ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways -fprint-error-index-links=never -rtsopts"
         , pure ghcOpts
         , pure ghcExtraFlags
         , ifMinGhcVer "711" "-fno-warn-missed-specialisations"


=====================================
testsuite/mk/test.mk
=====================================
@@ -50,6 +50,9 @@ TEST_HC_OPTS += -fshow-warning-groups
 TEST_HC_OPTS += -fdiagnostics-color=never
 TEST_HC_OPTS += -fno-diagnostics-show-caret
 
+# don't generate error index links for the GHC testsuite
+TEST_HC_OPTS += -fprint-error-index-links=never
+
 # See #15278.
 TEST_HC_OPTS += -Werror=compat
 


=====================================
testsuite/tests/ghc-api/target-contents/TargetContents.hs
=====================================
@@ -34,6 +34,7 @@ main = do
     (dflags1, xs, warn) <- parseDynamicFlags logger dflags0 $ map noLoc $
         [ "-outputdir", "./outdir"
         , "-fno-diagnostics-show-caret"
+        , "-fprint-error-index-links=never"
         ] ++ args
     _ <- setSessionDynFlags dflags1
 


=====================================
testsuite/tests/ghci/should_fail/GHCiErrorIndexLinks.script
=====================================
@@ -0,0 +1 @@
+print $ 1729 + "hello from GHCi!"


=====================================
testsuite/tests/ghci/should_fail/GHCiErrorIndexLinks.stderr
=====================================
@@ -0,0 +1,6 @@
+
+<interactive>:1:9: error: []8;;https://errors.haskell.org/messages/GHC-39999\GHC-39999]8;;\]
+    • No instance for ‘Num String’ arising from the literal ‘1729’
+    • In the first argument of ‘(+)’, namely ‘1729’
+      In the second argument of ‘($)’, namely ‘1729 + "hello from GHCi!"’
+      In the expression: print $ 1729 + "hello from GHCi!"


=====================================
testsuite/tests/ghci/should_fail/all.T
=====================================
@@ -6,3 +6,4 @@ test('T16287', [], ghci_script, ['T16287.script'])
 test('T18052b', [], ghci_script, ['T18052b.script'])
 test('T18027a', [], ghci_script, ['T18027a.script'])
 test('T20214', req_interp, makefile_test, ['T20214'])
+test('GHCiErrorIndexLinks', [extra_hc_opts("-fprint-error-index-links=always")], ghci_script, ['GHCiErrorIndexLinks.script'])


=====================================
testsuite/tests/runghc/Makefile
=====================================
@@ -26,7 +26,7 @@ T11247:
 T17171a:
 	'$(RUNGHC)' --ghc-arg=-Wall T17171a.hs
 T17171b:
-	'$(RUNGHC)' --ghc-arg=-Wall T17171b.hs
+	'$(RUNGHC)' --ghc-arg=-Wall -fprint-error-index-links=never T17171b.hs
 
 T-signals-child:
 	-'$(RUNGHC)' T-signals-child.hs --runghc '$(RUNGHC)'


=====================================
testsuite/tests/typecheck/should_fail/ErrorIndexLinks.hs
=====================================
@@ -0,0 +1,7 @@
+-- | Test that GHC produces links to the Haskell Foundation Error Index Pretty
+-- straight forward, we just induce a type error and track the link as a golden
+-- test.
+
+module Main where
+
+main = 1 + "hello HF! from GHC"


=====================================
testsuite/tests/typecheck/should_fail/ErrorIndexLinks.stderr
=====================================
@@ -0,0 +1,7 @@
+
+ErrorIndexLinks.hs:7:1: error: []8;;https://errors.haskell.org/messages/GHC-83865\GHC-83865]8;;\]
+    • Couldn't match type: [Char]
+                     with: IO t0
+      Expected: IO t0
+        Actual: String
+    • When checking the type of the IO action ‘main’


=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -701,3 +701,4 @@ test('T23514a', normal, compile_fail, [''])
 test('T22478c', normal, compile_fail, [''])
 test('T23776', normal, compile, ['']) # to become an error in GHC 9.12
 test('T17940', normal, compile_fail, [''])
+test('ErrorIndexLinks', normal, compile_fail, ['-fprint-error-index-links=always'])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86d2971e3cf194d23b483a7cd9466d928e104ca5
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/20230919/25158182/attachment-0001.html>


More information about the ghc-commits mailing list