error messages: Don't display ghci specific hints for missing packageswip/t22884

Tickets like #22884 suggest that it is confusing that GHC used on the
command line can suggest options which only work in GHCi.

This ticket uses the error message infrastructure to override certain
error messages which displayed GHCi specific information so that this
information is only showed when using GHCi.

The main annoyance is that we mostly want to display errors in the same
way as before, but with some additional information. This means that the
error rendering code has to be exported from the Iface/Errors/Ppr.hs
module.

I am unsure about whether the approach taken here is the best or most
maintainable solution.

Fixes #22884

2 files changed, 55 insertions, 42 deletions

diff --git a/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs
index 4e36eadbba..5f23fe01ca 100644
--- a/compiler/GHC/Iface/Errors/Ppr.hs
+++ b/compiler/GHC/Iface/Errors/Ppr.hs
@@ -19,6 +19,11 @@ module GHC.Iface.Errors.Ppr
   , missingInterfaceErrorReason
   , missingInterfaceErrorDiagnostic
   , readInterfaceErrorDiagnostic
+
+  , lookingForHerald
+  , cantFindErrorX
+  , mayShowLocations
+  , pkgHiddenHint
   )
   where
 
@@ -129,34 +134,34 @@ cantFindError :: IfaceMessageOpts
   -> FindingModuleOrInterface
   -> CantFindInstalled
   -> SDoc
-cantFindError opts = cantFindErrorX (pkg_hidden_hint (ifaceBuildingCabalPackage opts)) (mayShowLocations (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
+cantFindError opts =
+  cantFindErrorX
+    (pkgHiddenHint (const empty) (ifaceBuildingCabalPackage opts))
+    (mayShowLocations "-v" (ifaceShowTriedFiles opts))
+
+
+pkgHiddenHint :: (UnitInfo -> SDoc) -> BuildingCabalPackage
+              -> UnitInfo -> SDoc
+pkgHiddenHint _hint YesBuildingCabalPackage pkg
+ = text "Perhaps you need to add" <+>
+   quotes (ppr (unitPackageName pkg)) <+>
+   text "to the build-depends in your .cabal file."
+pkgHiddenHint hint _not_cabal pkg
+ = hint pkg
+
+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)
 
 -- | General version of cantFindError which has some holes which allow GHC/GHCi to display slightly different
 -- error messages.
-cantFindErrorX :: (Maybe UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc
-cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstalled mod_name cfir) =
+cantFindErrorX :: (UnitInfo -> SDoc) -> ([FilePath] -> SDoc) -> FindingModuleOrInterface -> CantFindInstalled -> SDoc
+cantFindErrorX pkg_hidden_hint may_show_locations mod_or_interface (CantFindInstalled mod_name cfir) =
   let ambig = isAmbiguousInstalledReason cfir
       find_or_load = isLoadOrFindReason cfir
       ppr_what = prettyCantFindWhat find_or_load mod_or_interface ambig
@@ -184,11 +189,11 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal
       text "There are files missing in the " <> quotes (ppr pkg) <+>
       text "package," $$
       text "try running 'ghc-pkg check'." $$
-      mayShowLocations files
+      may_show_locations files
     MissingPackageWayFiles build pkg files ->
       text "Perhaps you haven't installed the " <> text build <+>
       text "libraries for package " <> quotes (ppr pkg) <> char '?' $$
-      mayShowLocations files
+      may_show_locations files
     ModuleSuggestion ms fps ->
 
       let pp_suggestions :: [ModuleSuggestion] -> SDoc
@@ -230,7 +235,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal
                           <+> ppr (mkUnit pkg))
                     | otherwise = empty
 
-        in pp_suggestions ms $$ mayShowLocations fps
+        in pp_suggestions ms $$ may_show_locations fps
     NotAModule -> text "It is not a module in the current program, or in any known package."
     CouldntFindInFiles fps -> vcat (map text fps)
     MultiplePackages mods
@@ -248,7 +253,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal
       vcat (map pkg_hidden pkg_hiddens) $$
       vcat (map mod_hidden mod_hiddens) $$
       vcat (map unusable unusables) $$
-      mayShowLocations files
+      may_show_locations files
   where
     pprMod (m, o) = text "it is bound as" <+> ppr m <+>
                                 text "by" <+> pprOrigin m o
@@ -268,7 +273,7 @@ cantFindErrorX pkg_hidden_hint mayShowLocations mod_or_interface (CantFindInstal
         <+> quotes (ppr uid)
         --FIXME: we don't really want to show the unit id here we should
         -- show the source package id or installed package id if it's ambiguous
-        <> dot $$ pkg_hidden_hint uif
+        <> dot $$ maybe empty pkg_hidden_hint uif
 
 
     mod_hidden pkg =
@@ -285,21 +290,21 @@ interfaceErrorDiagnostic opts = \ case
   Can'tFindNameInInterface name relevant_tyThings ->
     missingDeclInInterface name relevant_tyThings
   Can'tFindInterface err looking_for ->
-    case looking_for of
-      LookingForName {} ->
-        missingInterfaceErrorDiagnostic opts err
-      LookingForModule {} ->
-        missingInterfaceErrorDiagnostic opts err
-      LookingForHiBoot mod ->
-        hang (text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon)
-          2 (missingInterfaceErrorDiagnostic opts err)
-      LookingForSig sig ->
-        hang (text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon)
-          2 (missingInterfaceErrorDiagnostic opts err)
+    hangNotEmpty (lookingForHerald looking_for) 2 (missingInterfaceErrorDiagnostic opts err)
   CircularImport mod ->
     text "Circular imports: module" <+> quotes (ppr mod)
     <+> text "depends on itself"
 
+lookingForHerald :: InterfaceLookingFor -> SDoc
+lookingForHerald looking_for =
+    case looking_for of
+      LookingForName {} -> empty
+      LookingForModule {} -> empty
+      LookingForHiBoot mod ->
+        text "Could not find hi-boot interface for" <+> quotes (ppr mod) <> colon
+      LookingForSig sig ->
+        text "Could not find interface file for signature" <+> quotes (ppr sig) <> colon
+
 readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc
 readInterfaceErrorDiagnostic = \ case
   ExceptionOccurred fp ex ->
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 454d179c4b..460301273f 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -21,6 +21,10 @@ module GHC.Tc.Errors.Ppr
   , inHsDocContext
   , TcRnMessageOpts(..)
   , pprTyThingUsedWrong
+
+  -- | Useful when overriding message printing.
+  , messageWithInfoDiagnosticMessage
+  , messageWithHsDocContext
   )
   where
 
@@ -126,12 +130,8 @@ instance Diagnostic TcRnMessage where
                   (tcOptsShowContext opts)
                   (diagnosticMessage opts msg)
     TcRnWithHsDocContext ctxt msg
-      -> if tcOptsShowContext opts
-         then main_msg `unionDecoratedSDoc` ctxt_msg
-         else main_msg
-      where
-        main_msg = diagnosticMessage opts msg
-        ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt)
+      -> messageWithHsDocContext opts ctxt (diagnosticMessage opts msg)
+
     TcRnSolverReport msg _ _
       -> mkSimpleDecorated $ pprSolverReportWithCtxt msg
     TcRnRedundantConstraints redundants (info, show_info)
@@ -3259,6 +3259,14 @@ messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important =
       in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc`
          mkDecorated err_info'
 
+messageWithHsDocContext :: TcRnMessageOpts -> HsDocContext -> DecoratedSDoc -> DecoratedSDoc
+messageWithHsDocContext opts ctxt main_msg = do
+      if tcOptsShowContext opts
+         then main_msg `unionDecoratedSDoc` ctxt_msg
+         else main_msg
+      where
+        ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt)
+
 dodgy_msg :: Outputable ie => SDoc -> GlobalRdrElt -> ie -> SDoc
 dodgy_msg kind tc ie
   = vcat [ text "The" <+> kind <+> text "item" <+> quotes (ppr ie) <+> text "suggests that"