[Git][ghc/ghc][wip/t22884] error messages: Don't display ghci specific hints for missing packages
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Wed Apr 19 09:52:10 UTC 2023
Matthew Pickering pushed to branch wip/t22884 at Glasgow Haskell Compiler / GHC
Commits:
5dd2b0dd by GHC GitLab CI at 2023-04-19T10:51:54+01:00
error messages: Don't display ghci specific hints for missing packages
I am unsure about whether the approach taken here is the best of most
maintainable solution. I put it up here for review and comment.
Fixes #22884
- - - - -
15 changed files:
- compiler/GHC/Iface/Errors/Ppr.hs
- ghc/GHCi/UI/Exception.hs
- + testsuite/tests/package/T22884.hs
- + testsuite/tests/package/T22884.stderr
- + testsuite/tests/package/T22884_interactive.script
- + testsuite/tests/package/T22884_interactive.stderr
- testsuite/tests/package/T4806.stderr
- testsuite/tests/package/T4806a.stderr
- testsuite/tests/package/all.T
- testsuite/tests/package/package01e.stderr
- testsuite/tests/package/package06e.stderr
- testsuite/tests/package/package07e.stderr
- testsuite/tests/package/package08e.stderr
- testsuite/tests/plugins/T11244.stderr
- testsuite/tests/plugins/plugins03.stderr
Changes:
=====================================
compiler/GHC/Iface/Errors/Ppr.hs
=====================================
@@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr
, missingInterfaceErrorReason
, missingInterfaceErrorDiagnostic
, readInterfaceErrorDiagnostic
+
+ , lookingForHerald
+ , cantFindErrorX
+ , mayShowLocations
+ , pkgHiddenHint
)
where
@@ -130,26 +135,26 @@ cantFindError :: IfaceMessageOpts
-> FindingModuleOrInterface
-> CantFindInstalled
-> SDoc
-cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (ifaceShowTriedFiles opts))
+cantFindError opts = cantFindErrorX (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts)) (mayShowLocations "-v" (ifaceShowTriedFiles opts))
where
- pkg_hidden_hint using_cabal (Just pkg)
- | using_cabal == YesBuildingCabalPackage
- = text "Perhaps you need to add" <+>
- quotes (ppr (unitPackageName pkg)) <+>
- text "to the build-depends in your .cabal file."
- -- MP: This is ghci specific, remove
- | otherwise
- = text "You can run" <+>
- quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
- text "to expose it." $$
- text "(Note: this unloads all the modules in the current scope.)"
- pkg_hidden_hint _ Nothing = empty
-
-mayShowLocations :: Bool -> [FilePath] -> SDoc
-mayShowLocations verbose files
+
+pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage
+ -> Maybe UnitInfo -> SDoc
+pkgHiddenHint hint using_cabal (Just pkg)
+ | using_cabal == YesBuildingCabalPackage
+ = text "Perhaps you need to add" <+>
+ quotes (ppr (unitPackageName pkg)) <+>
+ text "to the build-depends in your .cabal file."
+
+ | otherwise
+ = hint pkg
+pkgHiddenHint _ _ Nothing = empty
+
+mayShowLocations :: String -> Bool -> [FilePath] -> SDoc
+mayShowLocations option verbose files
| null files = empty
| not verbose =
- text "Use -v (or `:set -v` in ghci) " <>
+ text "Use" <+> text option <+>
text "to see a list of the files searched for."
| otherwise =
hang (text "Locations searched:") 2 $ vcat (map text files)
@@ -286,17 +291,17 @@ interfaceErrorDiagnostic opts = \ case
Can'tFindNameInInterface name relevant_tyThings ->
missingDeclInInterface name relevant_tyThings
Can'tFindInterface err looking_for ->
+ hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err)
+
+lookingForHerald :: InterfaceLookingFor -> SDoc
+lookingForHerald looking_for =
case looking_for of
- LookingForName {} ->
- missingInterfaceErrorDiagnostic opts err
- LookingForModule {} ->
- missingInterfaceErrorDiagnostic opts err
+ LookingForName {} -> empty
+ LookingForModule {} -> empty
LookingForHiBoot mod ->
- hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon)
- 2 (missingInterfaceErrorDiagnostic opts err)
+ text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon
LookingForSig sig ->
- hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon)
- 2 (missingInterfaceErrorDiagnostic opts err)
+ text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon
readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc
readInterfaceErrorDiagnostic = \ case
=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -10,8 +10,14 @@ import GHC.Driver.Session
import GHC.Types.SourceError
import GHC.Driver.Errors.Types
import GHC.Types.Error
+import GHC.Iface.Errors.Types
+import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
+import GHC.Iface.Errors.Ppr
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
+import GHC.Utils.Outputable
+import GHC.Unit.State
-- | Print the all diagnostics in a 'SourceError'. Specialised for GHCi error reporting
-- for some error messages.
@@ -24,14 +30,14 @@ printGhciException err = do
liftIO $ printMessages logger print_config diag_opts (GHCiMessage <$> (srcErrorMessages err))
-newtype GHCiMessage = GHCiMessage { getGhciMessage :: GhcMessage }
+newtype GHCiMessage = GHCiMessage { _getGhciMessage :: GhcMessage }
instance Diagnostic GHCiMessage where
type DiagnosticOpts GHCiMessage = DiagnosticOpts GhcMessage
defaultDiagnosticOpts = defaultDiagnosticOpts @GhcMessage
- diagnosticMessage opts (GHCiMessage msg) = diagnosticMessage opts msg
+ diagnosticMessage opts (GHCiMessage msg) = ghciDiagnosticMessage opts msg
diagnosticReason (GHCiMessage msg) = diagnosticReason msg
@@ -39,4 +45,38 @@ instance Diagnostic GHCiMessage where
diagnosticCode (GHCiMessage msg) = diagnosticCode msg
+-- Modifications to error messages which we want to display in GHCi
+ghciDiagnosticMessage :: GhcMessageOpts -> GhcMessage -> DecoratedSDoc
+ghciDiagnosticMessage ghc_opts msg =
+ case msg of
+ GhcTcRnMessage (TcRnInterfaceError err) ->
+ case ghciInterfaceError err of
+ Just sdoc -> mkSimpleDecorated sdoc
+ Nothing -> diagnosticMessage ghc_opts msg
+ GhcDriverMessage (DriverInterfaceError err) ->
+ case ghciInterfaceError err of
+ Just sdoc -> mkSimpleDecorated sdoc
+ Nothing -> diagnosticMessage ghc_opts msg
+ _ -> diagnosticMessage ghc_opts msg
+ where
+ opts = tcOptsIfaceOpts (tcMessageOpts ghc_opts)
+ ghciInterfaceError (Can'tFindInterface err looking_for) =
+ hangNotEmpty (lookingForHerald looking_for) 2 <$> ghciMissingInterfaceErrorDiagnostic err
+ ghciInterfaceError _ = Nothing
+
+ ghciMissingInterfaceErrorDiagnostic reason =
+ case reason of
+ CantFindErr us module_or_interface cfi -> Just (pprWithUnitState us $ cantFindErrorX pkg_hidden_hint may_show_locations module_or_interface cfi)
+ _ -> Nothing
+ where
+
+ may_show_locations = mayShowLocations ":set -v" (ifaceShowTriedFiles opts)
+
+ pkg_hidden_hint = pkgHiddenHint hidden_msg (ifaceBuildingCabalPackage opts)
+ where
+ hidden_msg pkg =
+ text "You can run" <+>
+ quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
+ text "to expose it." $$
+ text "(Note: this unloads all the modules in the current scope.)"
=====================================
testsuite/tests/package/T22884.hs
=====================================
@@ -0,0 +1,3 @@
+module T22884 where
+
+import Data.Text
=====================================
testsuite/tests/package/T22884.stderr
=====================================
@@ -0,0 +1,5 @@
+
+T22884.hs:3:1: error: [GHC-87110]
+ Could not load module ‘Data.Text’.
+ It is a member of the hidden package ‘text-2.0.2’.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/T22884_interactive.script
=====================================
@@ -0,0 +1,3 @@
+:set -hide-all-packages
+
+import Data.Text
=====================================
testsuite/tests/package/T22884_interactive.stderr
=====================================
@@ -0,0 +1,6 @@
+
+<no location info>: error: [GHC-87110]
+ Could not load module ‘Data.Text’.
+ It is a member of the hidden package ‘text-2.0.2’.
+ You can run ‘:set -package text’ to expose it.
+ (Note: this unloads all the modules in the current scope.)
=====================================
testsuite/tests/package/T4806.stderr
=====================================
@@ -3,4 +3,4 @@ T4806.hs:1:1: error: [GHC-87110]
Could not load module ‘Data.Map’.
It is a member of the package ‘containers-0.6.7’
which is ignored due to an -ignore-package flag
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/T4806a.stderr
=====================================
@@ -4,4 +4,4 @@ T4806a.hs:1:1: error: [GHC-87110]
It is a member of the package ‘containers-0.6.7’
which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies:
deepseq-1.4.8.1 template-haskell-2.20.0.0
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/all.T
=====================================
@@ -20,3 +20,5 @@ test('package10', normal, compile, ['-hide-all-packages -package "ghc (GHC
test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers'])
test('T4806a', normalise_version('deepseq', 'containers'), compile_fail, ['-ignore-package deepseq'])
+test('T22884', normalise_version('text'), compile_fail, ['-hide-package text'])
+test('T22884_interactive', normalise_version('text'), ghci_script, ['T22884_interactive.script'])
=====================================
testsuite/tests/package/package01e.stderr
=====================================
@@ -2,13 +2,9 @@
package01e.hs:2:1: error: [GHC-87110]
Could not load module ‘Data.Map’.
It is a member of the hidden package ‘containers-0.6.7’.
- You can run ‘:set -package containers’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package01e.hs:3:1: error: [GHC-87110]
Could not load module ‘Data.IntMap’.
It is a member of the hidden package ‘containers-0.6.7’.
- You can run ‘:set -package containers’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package06e.stderr
=====================================
@@ -2,13 +2,9 @@
package06e.hs:2:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package06e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package07e.stderr
=====================================
@@ -5,25 +5,19 @@ package07e.hs:2:1: error: [GHC-61948]
GHC.Hs.Type (needs flag -package-id ghc-9.7)
GHC.Tc.Types (needs flag -package-id ghc-9.7)
GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:4:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Utils’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package07e.hs:5:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/package/package08e.stderr
=====================================
@@ -5,25 +5,19 @@ package08e.hs:2:1: error: [GHC-61948]
GHC.Hs.Type (needs flag -package-id ghc-9.7)
GHC.Tc.Types (needs flag -package-id ghc-9.7)
GHC.Hs.Syn.Type (needs flag -package-id ghc-9.7)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:3:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Type’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:4:1: error: [GHC-87110]
Could not load module ‘GHC.Hs.Utils’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
package08e.hs:5:1: error: [GHC-87110]
Could not load module ‘GHC.Types.Unique.FM’.
It is a member of the hidden package ‘ghc-9.7’.
- You can run ‘:set -package ghc’ to expose it.
- (Note: this unloads all the modules in the current scope.)
- Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+ Use -v to see a list of the files searched for.
=====================================
testsuite/tests/plugins/T11244.stderr
=====================================
@@ -1,5 +1,3 @@
<command line>: Could not load module ‘RuleDefiningPlugin’.
It is a member of the hidden package ‘rule-defining-plugin-0.1’.
-You can run ‘:set -package rule-defining-plugin’ to expose it.
-(Note: this unloads all the modules in the current scope.)
-Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+Use -v to see a list of the files searched for.
=====================================
testsuite/tests/plugins/plugins03.stderr
=====================================
@@ -1,2 +1,2 @@
<command line>: Could not find module ‘Simple.NonExistentPlugin’.
-Use -v (or `:set -v` in ghci) to see a list of the files searched for.
+Use -v to see a list of the files searched for.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dd2b0ddc3cbae767b09302781aa7fe52815e4b4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dd2b0ddc3cbae767b09302781aa7fe52815e4b4
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/20230419/59e9d8ca/attachment-0001.html>
More information about the ghc-commits
mailing list