diff options
59 files changed, 853 insertions, 508 deletions
diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs index f4b709301b..1e8b5a1e67 100644 --- a/compiler/GHC/Driver/Config/Diagnostic.hs +++ b/compiler/GHC/Driver/Config/Diagnostic.hs @@ -8,11 +8,13 @@ module GHC.Driver.Config.Diagnostic , initDsMessageOpts , initTcMessageOpts , initDriverMessageOpts + , initIfaceMessageOpts ) where import GHC.Driver.Flags import GHC.Driver.Session +import GHC.Prelude import GHC.Utils.Outputable import GHC.Utils.Error (DiagOpts (..)) @@ -22,6 +24,8 @@ import GHC.Tc.Errors.Types import GHC.HsToCore.Errors.Types import GHC.Types.Error import GHC.Tc.Errors.Ppr +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr -- | Initialise the general configuration for printing diagnostic messages -- For example, this configuration controls things like whether warnings are @@ -50,11 +54,17 @@ initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage initPsMessageOpts _ = NoDiagnosticOpts initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage -initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags } +initTcMessageOpts dflags = + TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags + , tcOptsIfaceOpts = initIfaceMessageOpts dflags } initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage initDsMessageOpts _ = NoDiagnosticOpts +initIfaceMessageOpts :: DynFlags -> DiagnosticOpts IfaceMessage +initIfaceMessageOpts dflags = + IfaceMessageOpts { ifaceShowTriedFiles = verbosity dflags >= 3 } + initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage -initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) +initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) (initIfaceMessageOpts dflags) diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs index 89bdf31b2c..a02321ab78 100644 --- a/compiler/GHC/Driver/Config/Tidy.hs +++ b/compiler/GHC/Driver/Config/Tidy.hs @@ -17,11 +17,8 @@ import GHC.Driver.Env import GHC.Driver.Backend import GHC.Core.Make (getMkStringIds) -import GHC.Data.Maybe -import GHC.Utils.Panic -import GHC.Utils.Outputable import GHC.Builtin.Names -import GHC.Tc.Utils.Env (lookupGlobal_maybe) +import GHC.Tc.Utils.Env (lookupGlobal) import GHC.Types.TyThing import GHC.Platform.Ways @@ -49,13 +46,9 @@ initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts initStaticPtrOpts hsc_env = do let dflags = hsc_dflags hsc_env - let lookupM n = lookupGlobal_maybe hsc_env n >>= \case - Succeeded r -> pure r - Failed err -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n)) - - mk_string <- getMkStringIds (fmap tyThingId . lookupM) - static_ptr_info_datacon <- tyThingDataCon <$> lookupM staticPtrInfoDataConName - static_ptr_datacon <- tyThingDataCon <$> lookupM staticPtrDataConName + mk_string <- getMkStringIds (fmap tyThingId . lookupGlobal hsc_env ) + static_ptr_info_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrInfoDataConName + static_ptr_datacon <- tyThingDataCon <$> lookupGlobal hsc_env staticPtrDataConName pure $ StaticPtrOpts { opt_platform = targetPlatform dflags diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs index dd6834046b..ab62682517 100644 --- a/compiler/GHC/Driver/Errors.hs +++ b/compiler/GHC/Driver/Errors.hs @@ -13,7 +13,7 @@ import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.Error import GHC.Utils.Error -import GHC.Utils.Outputable (hang, ppr, ($$), SDocContext, text, withPprStyle, mkErrStyle, sdocStyle ) +import GHC.Utils.Outputable (hang, ppr, ($$), text, mkErrStyle, sdocStyle, updSDocContext ) import GHC.Utils.Logger import qualified GHC.Driver.CmdLine as CmdLine @@ -22,21 +22,21 @@ printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ - withPprStyle style (messageWithHints ctx dia) + updSDocContext (\_ -> ctx) (messageWithHints dia) | MsgEnvelope { errMsgSpan = s, errMsgDiagnostic = dia, errMsgSeverity = sev, errMsgContext = name_ppr_ctx } <- sortMsgBag (Just opts) (getMessages msgs) ] where - messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc - messageWithHints ctx e = - let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e + messageWithHints :: Diagnostic a => a -> SDoc + messageWithHints e = + let main_msg = formatBulleted $ diagnosticMessage msg_opts e in case diagnosticHints e of [] -> main_msg [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h) hs -> main_msg $$ hang (text "Suggested fixes:") 2 - (formatBulleted ctx . mkDecorated . map ppr $ hs) + (formatBulleted $ mkDecorated . map ppr $ hs) handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO () handleFlagWarnings logger print_config opts warns = do diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs index 9e3822e460..a89e7992b1 100644 --- a/compiler/GHC/Driver/Errors/Ppr.hs +++ b/compiler/GHC/Driver/Errors/Ppr.hs @@ -16,7 +16,6 @@ import GHC.Driver.Flags import GHC.Driver.Session import GHC.HsToCore.Errors.Ppr () import GHC.Parser.Errors.Ppr () -import GHC.Tc.Errors.Ppr () import GHC.Types.Error import GHC.Types.Error.Codes ( constructorCode ) import GHC.Unit.Types @@ -30,6 +29,9 @@ import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) import GHC.Tc.Errors.Types (TcRnMessage) import GHC.HsToCore.Errors.Types (DsMessage) +import GHC.Iface.Errors.Types +import GHC.Tc.Errors.Ppr () +import GHC.Iface.Errors.Ppr () -- -- Suggestions @@ -86,7 +88,7 @@ instance Diagnostic GhcMessage where instance Diagnostic DriverMessage where type DiagnosticOpts DriverMessage = DriverMessageOpts - defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) + defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) (defaultDiagnosticOpts @IfaceMessage) diagnosticMessage opts = \case DriverUnknownMessage (UnknownDiagnostic @e m) -> diagnosticMessage (defaultDiagnosticOpts @e) m @@ -218,6 +220,7 @@ instance Diagnostic DriverMessage where -> mkSimpleDecorated $ vcat ([text "Home units are not closed." , text "It is necessary to also load the following units:" ] ++ map (\uid -> text "-" <+> ppr uid) needed_unit_ids) + DriverInterfaceError reason -> diagnosticMessage (ifaceDiagnosticOpts opts) reason diagnosticReason = \case DriverUnknownMessage m @@ -272,6 +275,7 @@ instance Diagnostic DriverMessage where -> ErrorWithoutFlag DriverHomePackagesNotClosed {} -> ErrorWithoutFlag + DriverInterfaceError reason -> diagnosticReason reason diagnosticHints = \case DriverUnknownMessage m @@ -328,5 +332,6 @@ instance Diagnostic DriverMessage where -> noHints DriverHomePackagesNotClosed {} -> noHints + DriverInterfaceError reason -> diagnosticHints reason diagnosticCode = constructorCode diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs index c2ec9cbb0c..cbf0622025 100644 --- a/compiler/GHC/Driver/Errors/Types.hs +++ b/compiler/GHC/Driver/Errors/Types.hs @@ -8,7 +8,6 @@ module GHC.Driver.Errors.Types ( , DriverMessage(..) , DriverMessageOpts(..) , DriverMessages, PsMessage(PsHeaderMessage) - , BuildingCabalPackage(..) , WarningMessages , ErrorMessages , WarnMsg @@ -32,7 +31,6 @@ import GHC.Unit.Module import GHC.Unit.State import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) ) -import GHC.Tc.Errors.Types ( TcRnMessage ) import GHC.HsToCore.Errors.Types ( DsMessage ) import GHC.Hs.Extension (GhcTc) @@ -40,6 +38,9 @@ import Language.Haskell.Syntax.Decls (RuleDecl) import GHC.Generics ( Generic ) +import GHC.Tc.Errors.Types +import GHC.Iface.Errors.Types + -- | A collection of warning messages. -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity. type WarningMessages = Messages GhcMessage @@ -369,21 +370,18 @@ data DriverMessage where DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage + DriverInterfaceError :: !IfaceMessage -> DriverMessage + deriving instance Generic DriverMessage data DriverMessageOpts = - DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage } + DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage + , ifaceDiagnosticOpts :: DiagnosticOpts IfaceMessage } --- | Pass to a 'DriverMessage' the information whether or not the --- '-fbuilding-cabal-package' flag is set. -data BuildingCabalPackage - = YesBuildingCabalPackage - | NoBuildingCabalPackage - deriving Eq -- | Checks if we are building a cabal package by consulting the 'DynFlags'. checkBuildingCabalPackage :: DynFlags -> BuildingCabalPackage checkBuildingCabalPackage dflags = if gopt Opt_BuildingCabalPackage dflags then YesBuildingCabalPackage - else NoBuildingCabalPackage + else NoBuildingCabalPackage
\ No newline at end of file diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 7f60d5a8a0..d72b452d2e 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -153,6 +153,7 @@ import GHC.Utils.Constants import GHC.Types.Unique.DFM (udfmRestrictKeysSet) import qualified Data.IntSet as I import GHC.Types.Unique +import GHC.Iface.Errors.Types -- ----------------------------------------------------------------------------- @@ -2336,8 +2337,8 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMe -- ToDo: we don't have a proper line number for this error noModError hsc_env loc wanted_mod err = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ - DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ - cannotFindModule hsc_env wanted_mod err + DriverInterfaceError $ + (Can'tFindInterface (cannotFindModule hsc_env wanted_mod err) (LookingForModule wanted_mod NotBoot)) {- noHsFileErr :: SrcSpan -> String -> DriverMessages diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index a770637311..be20bfd89f 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -27,7 +27,6 @@ import GHC.Data.Graph.Directed ( SCC(..) ) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Types.Error (UnknownDiagnostic(..)) import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.PkgQual @@ -53,6 +52,7 @@ import Control.Monad ( when, forM_ ) import Data.Maybe ( isJust ) import Data.IORef import qualified Data.Set as Set +import GHC.Iface.Errors.Types ----------------------------------------------------------------- -- @@ -307,9 +307,8 @@ findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do fail -> throwOneError $ mkPlainErrorMsgEnvelope srcloc $ - GhcDriverMessage $ DriverUnknownMessage $ - UnknownDiagnostic $ mkPlainError noHints $ - cannotFindModule hsc_env imp fail + GhcDriverMessage $ DriverInterfaceError $ + (Can'tFindInterface (cannotFindModule hsc_env imp fail) (LookingForModule imp is_boot)) ----------------------------- writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO () diff --git a/compiler/GHC/Iface/Errors.hs b/compiler/GHC/Iface/Errors.hs index 743ce9a33a..0fce13fd4a 100644 --- a/compiler/GHC/Iface/Errors.hs +++ b/compiler/GHC/Iface/Errors.hs @@ -3,14 +3,9 @@ module GHC.Iface.Errors ( badIfaceFile - , hiModuleNameMismatchWarn - , homeModError , cannotFindInterface , cantFindInstalledErr , cannotFindModule - , cantFindErr - -- * Utility functions - , mayShowLocations ) where import GHC.Platform.Profile @@ -25,73 +20,38 @@ import GHC.Unit import GHC.Unit.Env import GHC.Unit.Finder.Types import GHC.Utils.Outputable as Outputable +import GHC.Iface.Errors.Types +-- ----------------------------------------------------------------------------- +-- Error messages badIfaceFile :: String -> SDoc -> SDoc badIfaceFile file err = vcat [text "Bad interface file:" <+> text file, nest 4 err] -hiModuleNameMismatchWarn :: Module -> Module -> SDoc -hiModuleNameMismatchWarn requested_mod read_mod - | moduleUnit requested_mod == moduleUnit read_mod = - sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, - text "but we were expecting module" <+> quotes (ppr requested_mod), - sep [text "Probable cause: the source code which generated interface file", - text "has an incompatible module name" - ] - ] - | otherwise = - -- ToDo: This will fail to have enough qualification when the package IDs - -- are the same - withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ - -- we want the Modules below to be qualified with package names, - -- so reset the NamePprCtx setting. - hsep [ text "Something is amiss; requested module " - , ppr requested_mod - , text "differs from name found in the interface file" - , ppr read_mod - , parens (text "if these names look the same, try again with -dppr-debug") - ] - -homeModError :: InstalledModule -> ModLocation -> SDoc --- See Note [Home module load error] -homeModError mod location - = text "attempting to use module " <> quotes (ppr mod) - <> (case ml_hs_file location of - Just file -> space <> parens (text file) - Nothing -> Outputable.empty) - <+> text "which is not loaded" - - --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc -cannotFindInterface = cantFindInstalledErr (text "Failed to load interface for") - (text "Ambiguous interface for") +cannotFindInterface :: UnitState -> Maybe HomeUnit -> Profile + -> ModuleName -> InstalledFindResult -> MissingInterfaceError +cannotFindInterface us mhu p mn ifr = + CantFindErr us FindingInterface $ + cantFindInstalledErr us mhu p mn ifr cantFindInstalledErr - :: SDoc - -> SDoc - -> UnitState + :: UnitState -> Maybe HomeUnit -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult - -> SDoc -cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info + -> CantFindInstalled +cantFindInstalledErr unit_state mhome_unit profile mod_name find_result + = CantFindInstalled mod_name more_info where build_tag = waysBuildTag (profileWays profile) more_info = case find_result of InstalledNoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" $$ looks_like_srcpkgid pkg + -> NoUnitIdMatching pkg (searchPackageId unit_state (PackageId (unitIdFS pkg))) InstalledNotFound files mb_pkg | Just pkg <- mb_pkg @@ -99,152 +59,83 @@ cantFindInstalledErr cannot_find _ unit_state mhome_unit profile tried_these mod -> not_found_in_package pkg files | null files - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> tried_these files + -> CouldntFindInFiles files _ -> panic "cantFindInstalledErr" - looks_like_srcpkgid :: UnitId -> SDoc - looks_like_srcpkgid pk - -- Unsafely coerce a unit id (i.e. an installed package component - -- identifier) into a PackageId and see if it means anything. - | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk)) - = parens (text "This unit ID looks like the source package ID;" $$ - text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ - (if null pkgs then Outputable.empty - else text "and" <+> int (length pkgs) <+> text "other candidates")) - -- Todo: also check if it looks like a package name! - | otherwise = Outputable.empty - not_found_in_package pkg files | build_tag /= "" = let build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in - text "Perhaps you haven't installed the " <> text build <> - text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ - tried_these files - + MissingPackageWayFiles build pkg files | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files + = MissingPackageFiles pkg files -mayShowLocations :: DynFlags -> [FilePath] -> SDoc -mayShowLocations dflags files - | null files = Outputable.empty - | verbosity dflags < 3 = - text "Use -v (or `:set -v` in ghci) " <> - text "to see a list of the files searched for." - | otherwise = - hang (text "Locations searched:") 2 $ vcat (map text files) -cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc + +cannotFindModule :: HscEnv -> ModuleName -> FindResult -> MissingInterfaceError cannotFindModule hsc_env = cannotFindModule' (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (targetProfile (hsc_dflags hsc_env)) -cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc -cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $ +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult + -> MissingInterfaceError +cannotFindModule' dflags unit_env profile mod res = + CantFindErr (ue_units unit_env) FindingModule $ cantFindErr (checkBuildingCabalPackage dflags) - cannotFindMsg - (text "Ambiguous module name") unit_env profile - (mayShowLocations dflags) mod res - where - cannotFindMsg = - case res of - NotFound { fr_mods_hidden = hidden_mods - , fr_pkgs_hidden = hidden_pkgs - , fr_unusables = unusables } - | not (null hidden_mods && null hidden_pkgs && null unusables) - -> text "Could not load module" - _ -> text "Could not find module" cantFindErr :: BuildingCabalPackage -- ^ Using Cabal? - -> SDoc - -> SDoc -> UnitEnv -> Profile - -> ([FilePath] -> SDoc) -> ModuleName -> FindResult - -> SDoc -cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods) - | Just pkgs <- unambiguousPackages - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - sep [text "it was found in multiple packages:", - hsep (map ppr pkgs) ] - ) - | otherwise - = hang (multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( - vcat (map pprMod mods) - ) - where - unambiguousPackages = foldl' unambiguousPackage (Just []) mods - unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) - = Just (moduleUnit m : xs) - unambiguousPackage _ _ = Nothing + -> CantFindInstalled +cantFindErr _ _ _ mod_name (FoundMultiple mods) + = CantFindInstalled mod_name (MultiplePackages mods) - pprMod (m, o) = text "it is bound as" <+> ppr m <+> - text "by" <+> pprOrigin m o - pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" - pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" - pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( - if e == Just True - then [text "package" <+> ppr (moduleUnit m)] - else [] ++ - map ((text "a reexport in package" <+>) - .ppr.mkUnit) res ++ - if f then [text "a package flag"] else [] - ) - -cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result - = cannot_find <+> quotes (ppr mod_name) - $$ more_info +cantFindErr using_cabal unit_env profile mod_name find_result + = CantFindInstalled mod_name more_info where mhome_unit = ue_homeUnit unit_env more_info = case find_result of NoPackage pkg - -> text "no unit id matching" <+> quotes (ppr pkg) <+> - text "was found" - + -> NoUnitIdMatching (toUnitId pkg) [] NotFound { fr_paths = files, fr_pkg = mb_pkg , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens , fr_unusables = unusables, fr_suggestions = suggest } | Just pkg <- mb_pkg , Nothing <- mhome_unit -- no home-unit - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | Just pkg <- mb_pkg , Just home_unit <- mhome_unit -- there is a home-unit but the , not (isHomeUnit home_unit pkg) -- module isn't from it - -> not_found_in_package pkg files + -> not_found_in_package (toUnitId pkg) files | not (null suggest) - -> pp_suggestions suggest $$ tried_these files + -> ModuleSuggestion suggest files | null files && null mod_hiddens && null pkg_hiddens && null unusables - -> text "It is not a module in the current program, or in any known package." + -> NotAModule | otherwise - -> vcat (map pkg_hidden pkg_hiddens) $$ - vcat (map mod_hidden mod_hiddens) $$ - vcat (map unusable unusables) $$ - tried_these files - + -> GenericMissing using_cabal + (map ((\uid -> (uid, lookupUnit (ue_units unit_env) uid))) pkg_hiddens) + mod_hiddens unusables files _ -> panic "cantFindErr" build_tag = waysBuildTag (profileWays profile) @@ -255,81 +146,7 @@ cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find build = if build_tag == "p" then "profiling" else "\"" ++ build_tag ++ "\"" in - text "Perhaps you haven't installed the " <> text build <> - text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ - tried_these files + MissingPackageWayFiles build pkg files | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files - - pkg_hidden :: Unit -> SDoc - pkg_hidden uid = - text "It is a member of the hidden package" - <+> 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 uid - - pkg_hidden_hint uid - | using_cabal == YesBuildingCabalPackage - = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid) - in text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - | Just pkg <- lookupUnit (ue_units unit_env) uid - = 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.)" - | otherwise = Outputable.empty - - mod_hidden pkg = - text "it is a hidden module in the package" <+> quotes (ppr pkg) - - unusable (pkg, reason) - = text "It is a member of the package" - <+> quotes (ppr pkg) - $$ pprReason (text "which is") reason - - pp_suggestions :: [ModuleSuggestion] -> SDoc - pp_suggestions sugs - | null sugs = Outputable.empty - | otherwise = hang (text "Perhaps you meant") - 2 (vcat (map pp_sugg sugs)) - - -- NB: Prefer the *original* location, and then reexports, and then - -- package flags when making suggestions. ToDo: if the original package - -- also has a reexport, prefer that one - pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromExposedReexport = res, - fromPackageFlag = f }) - | Just True <- e - = parens (text "from" <+> ppr (moduleUnit mod)) - | f && moduleName mod == m - = parens (text "from" <+> ppr (moduleUnit mod)) - | (pkg:_) <- res - = parens (text "from" <+> ppr (mkUnit pkg) - <> comma <+> text "reexporting" <+> ppr mod) - | f - = parens (text "defined via package flags to be" - <+> ppr mod) - | otherwise = Outputable.empty - pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o - where provenance ModHidden = Outputable.empty - provenance (ModUnusable _) = Outputable.empty - provenance (ModOrigin{ fromOrigUnit = e, - fromHiddenReexport = rhs }) - | Just False <- e - = parens (text "needs flag -package-id" - <+> ppr (moduleUnit mod)) - | (pkg:_) <- rhs - = parens (text "needs flag -package-id" - <+> ppr (mkUnit pkg)) - | otherwise = Outputable.empty - + = MissingPackageFiles pkg files diff --git a/compiler/GHC/Iface/Errors/Ppr.hs b/compiler/GHC/Iface/Errors/Ppr.hs new file mode 100644 index 0000000000..031e4fd75c --- /dev/null +++ b/compiler/GHC/Iface/Errors/Ppr.hs @@ -0,0 +1,366 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage +{-# LANGUAGE InstanceSigs #-} + +module GHC.Iface.Errors.Ppr + ( IfaceMessageOpts(..) + , interfaceErrorHints + , interfaceErrorReason + , interfaceErrorDiagnostic + , missingInterfaceErrorHints + , missingInterfaceErrorReason + , missingInterfaceErrorDiagnostic + , readInterfaceErrorDiagnostic + ) + where + +import GHC.Prelude + +import GHC.Types.Error +import GHC.Types.Hint.Ppr () -- Outputable GhcHint +import GHC.Types.Error.Codes ( constructorCode ) +import GHC.Types.Name +import GHC.Types.TyThing + +import GHC.Unit.State +import GHC.Unit.Module + +import GHC.Utils.Outputable +import GHC.Utils.Panic + + + +import GHC.Iface.Errors.Types + +data IfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles :: !Bool -- ^ Whether to show files we tried to look for or not when printing loader errors + } + +defaultIfaceMessageOpts :: IfaceMessageOpts +defaultIfaceMessageOpts = IfaceMessageOpts { ifaceShowTriedFiles = False } + + +instance Diagnostic IfaceMessage where + type DiagnosticOpts IfaceMessage = IfaceMessageOpts + defaultDiagnosticOpts = defaultIfaceMessageOpts + diagnosticMessage opts reason = mkSimpleDecorated $ + interfaceErrorDiagnostic opts reason + + diagnosticReason = interfaceErrorReason + + diagnosticHints = interfaceErrorHints + + diagnosticCode = constructorCode + +interfaceErrorHints :: IfaceMessage -> [GhcHint] +interfaceErrorHints = \ case + Can'tFindInterface err _looking_for -> + missingInterfaceErrorHints err + Can'tFindNameInInterface {} -> + noHints + +missingInterfaceErrorHints :: MissingInterfaceError -> [GhcHint] +missingInterfaceErrorHints = \case + BadSourceImport {} -> + noHints + HomeModError {} -> + noHints + DynamicHashMismatchError {} -> + noHints + CantFindErr {} -> + noHints + BadIfaceFile {} -> + noHints + FailedToLoadDynamicInterface {} -> + noHints + +interfaceErrorReason :: IfaceMessage -> DiagnosticReason +interfaceErrorReason (Can'tFindInterface err _) + = missingInterfaceErrorReason err +interfaceErrorReason (Can'tFindNameInInterface {}) + = ErrorWithoutFlag + +missingInterfaceErrorReason :: MissingInterfaceError -> DiagnosticReason +missingInterfaceErrorReason = \ case + BadSourceImport {} -> + ErrorWithoutFlag + HomeModError {} -> + ErrorWithoutFlag + DynamicHashMismatchError {} -> + ErrorWithoutFlag + CantFindErr {} -> + ErrorWithoutFlag + BadIfaceFile {} -> + ErrorWithoutFlag + FailedToLoadDynamicInterface {} -> + ErrorWithoutFlag + + +prettyCantFindWhat :: FindOrLoad -> FindingModuleOrInterface -> AmbiguousOrMissing -> SDoc +prettyCantFindWhat Find FindingModule AoM_Missing = text "Could not find module" +prettyCantFindWhat Load FindingModule AoM_Missing = text "Could not load module" +prettyCantFindWhat _ FindingInterface AoM_Missing = text "Failed to load interface for" +prettyCantFindWhat _ FindingModule AoM_Ambiguous = text "Ambiguous module name" +prettyCantFindWhat _ FindingInterface AoM_Ambiguous = text "Ambiguous interface for" + +isAmbiguousInstalledReason :: CantFindInstalledReason -> AmbiguousOrMissing +isAmbiguousInstalledReason (MultiplePackages {}) = AoM_Ambiguous +isAmbiguousInstalledReason _ = AoM_Missing + +isLoadOrFindReason :: CantFindInstalledReason -> FindOrLoad +isLoadOrFindReason NotAModule {} = Find +isLoadOrFindReason (GenericMissing _ a b c _) | null a && null b && null c = Find +isLoadOrFindReason (ModuleSuggestion {}) = Find +isLoadOrFindReason _ = Load + +data FindOrLoad = Find | Load + +data AmbiguousOrMissing = AoM_Ambiguous | AoM_Missing + +cantFindError :: IfaceMessageOpts -> FindingModuleOrInterface -> CantFindInstalled -> SDoc +cantFindError opts 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 + in + (ppr_what <+> quotes (ppr mod_name) <> dot) $$ + case cfir of + NoUnitIdMatching pkg cands -> + + let looks_like_srcpkgid :: SDoc + looks_like_srcpkgid = + -- Unsafely coerce a unit id (i.e. an installed package component + -- identifier) into a PackageId and see if it means anything. + case cands of + (pkg:pkgs) -> + parens (text "This unit ID looks like the source package ID;" $$ + text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ + (if null pkgs then empty + else text "and" <+> int (length pkgs) <+> text "other candidate" <> plural pkgs)) + -- Todo: also check if it looks like a package name! + [] -> empty + + in hsep [ text "no unit id matching" <+> quotes (ppr pkg) + , text "was found"] $$ looks_like_srcpkgid + MissingPackageFiles pkg files -> + text "There are files missing in the " <> quotes (ppr pkg) <+> + text "package," $$ + text "try running 'ghc-pkg check'." $$ + mayShowLocations verbose files + MissingPackageWayFiles build pkg files -> + text "Perhaps you haven't installed the " <> text build <+> + text "libraries for package " <> quotes (ppr pkg) <> char '?' $$ + mayShowLocations verbose files + ModuleSuggestion ms fps -> + + let pp_suggestions :: [ModuleSuggestion] -> SDoc + pp_suggestions sugs + | null sugs = empty + | otherwise = hang (text "Perhaps you meant") + 2 (vcat (map pp_sugg sugs)) + + -- NB: Prefer the *original* location, and then reexports, and then + -- package flags when making suggestions. ToDo: if the original package + -- also has a reexport, prefer that one + pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromExposedReexport = res, + fromPackageFlag = f }) + | Just True <- e + = parens (text "from" <+> ppr (moduleUnit mod)) + | f && moduleName mod == m + = parens (text "from" <+> ppr (moduleUnit mod)) + | (pkg:_) <- res + = parens (text "from" <+> ppr (mkUnit pkg) + <> comma <+> text "reexporting" <+> ppr mod) + | f + = parens (text "defined via package flags to be" + <+> ppr mod) + | otherwise = empty + pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o + where provenance ModHidden = empty + provenance (ModUnusable _) = empty + provenance (ModOrigin{ fromOrigUnit = e, + fromHiddenReexport = rhs }) + | Just False <- e + = parens (text "needs flag -package-id" + <+> ppr (moduleUnit mod)) + | (pkg:_) <- rhs + = parens (text "needs flag -package-id" + <+> ppr (mkUnit pkg)) + | otherwise = empty + + in pp_suggestions ms $$ mayShowLocations verbose 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 + | Just pkgs <- unambiguousPackages + -> sep [text "it was found in multiple packages:", + hsep (map ppr pkgs)] + | otherwise + -> vcat (map pprMod mods) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing + GenericMissing using_cabal pkg_hiddens mod_hiddens unusables files -> + vcat (map (pkg_hidden using_cabal) pkg_hiddens) $$ + vcat (map mod_hidden mod_hiddens) $$ + vcat (map unusable unusables) $$ + mayShowLocations verbose files + where + verbose = ifaceShowTriedFiles opts + + pprMod (m, o) = text "it is bound as" <+> ppr m <+> + text "by" <+> pprOrigin m o + pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" + pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" + pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( + if e == Just True + then [text "package" <+> ppr (moduleUnit m)] + else [] ++ + map ((text "a reexport in package" <+>) + .ppr.mkUnit) res ++ + if f then [text "a package flag"] else [] + ) + pkg_hidden :: BuildingCabalPackage -> (Unit, Maybe UnitInfo) -> SDoc + pkg_hidden using_cabal (uid, uif) = + text "It is a member of the hidden package" + <+> 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 using_cabal uif + + 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 + + mod_hidden pkg = + text "it is a hidden module in the package" <+> quotes (ppr pkg) + + unusable (pkg, reason) + = text "It is a member of the package" + <+> quotes (ppr pkg) + $$ pprReason (text "which is") reason + +mayShowLocations :: Bool -> [FilePath] -> SDoc +mayShowLocations verbose files + | null files = empty + | not verbose = + text "Use -v (or `:set -v` in ghci) " <> + text "to see a list of the files searched for." + | otherwise = + hang (text "Locations searched:") 2 $ vcat (map text files) + +interfaceErrorDiagnostic :: IfaceMessageOpts -> IfaceMessage -> SDoc +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) + +readInterfaceErrorDiagnostic :: ReadInterfaceError -> SDoc +readInterfaceErrorDiagnostic = \ case + ExceptionOccurred fp ex -> + hang (text "Exception when reading interface file " <+> text fp) + 2 (text (showException ex)) + HiModuleNameMismatchWarn _ m1 m2 -> + hiModuleNameMismatchWarn m1 m2 + +missingInterfaceErrorDiagnostic :: IfaceMessageOpts -> MissingInterfaceError -> SDoc +missingInterfaceErrorDiagnostic opts reason = + case reason of + BadSourceImport m -> badSourceImport m + HomeModError im ml -> homeModError im ml + DynamicHashMismatchError m ml -> dynamicHashMismatchError m ml + CantFindErr us module_or_interface cfi -> pprWithUnitState us $ cantFindError opts module_or_interface cfi + BadIfaceFile rie -> readInterfaceErrorDiagnostic rie + FailedToLoadDynamicInterface wanted_mod err -> + hang (text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) + 2 (readInterfaceErrorDiagnostic err) + +hiModuleNameMismatchWarn :: Module -> Module -> SDoc +hiModuleNameMismatchWarn requested_mod read_mod + | moduleUnit requested_mod == moduleUnit read_mod = + sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma, + text "but we were expecting module" <+> quotes (ppr requested_mod), + sep [text "Probable cause: the source code which generated interface file", + text "has an incompatible module name" + ] + ] + | otherwise = + -- ToDo: This will fail to have enough qualification when the package IDs + -- are the same + withPprStyle (mkUserStyle alwaysQualify AllTheWay) $ + -- we want the Modules below to be qualified with package names, + -- so reset the NamePprCtx setting. + hsep [ text "Something is amiss; requested module " + , ppr requested_mod + , text "differs from name found in the interface file" + , ppr read_mod + , parens (text "if these names look the same, try again with -dppr-debug") + ] + +dynamicHashMismatchError :: Module -> ModLocation -> SDoc +dynamicHashMismatchError wanted_mod loc = + vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) + , text "Normal interface file from" <+> text (ml_hi_file loc) + , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) + , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] + +homeModError :: InstalledModule -> ModLocation -> SDoc +-- See Note [Home module load error] +homeModError mod location + = text "attempting to use module " <> quotes (ppr mod) + <> (case ml_hs_file location of + Just file -> space <> parens (text file) + Nothing -> empty) + <+> text "which is not loaded" + + +missingDeclInInterface :: Name -> [TyThing] -> SDoc +missingDeclInInterface name things = + whenPprDebug (found_things $$ empty) $$ + hang (text "Can't find interface-file declaration for" <+> + pprNameSpace (nameNameSpace name) <+> ppr name) + 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", + text "Use -ddump-if-trace to get an idea of which file caused the error"]) + where + found_things = + hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) + 2 (vcat (map ppr things)) + +badSourceImport :: Module -> SDoc +badSourceImport mod + = hang (text "You cannot {-# SOURCE #-} import a module from another package") + 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" + <+> quotes (ppr (moduleUnit mod))) diff --git a/compiler/GHC/Iface/Errors/Types.hs b/compiler/GHC/Iface/Errors/Types.hs new file mode 100644 index 0000000000..a421c2eeb7 --- /dev/null +++ b/compiler/GHC/Iface/Errors/Types.hs @@ -0,0 +1,90 @@ + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} + +module GHC.Iface.Errors.Types ( + + MissingInterfaceError(..) + , InterfaceLookingFor(..) + , IfaceMessage(..) + , ReadInterfaceError(..) + , CantFindInstalled(..) + , CantFindInstalledReason(..) + , FindingModuleOrInterface(..) + + , BuildingCabalPackage(..) + + ) where + +import GHC.Prelude + +import GHC.Hs +import GHC.Types.Name (Name) +import GHC.Types.TyThing (TyThing) +import GHC.Unit.Types (Module, InstalledModule, UnitId, Unit) +import GHC.Unit.State (UnitState, ModuleSuggestion, ModuleOrigin, UnusableUnitReason, UnitInfo) +import GHC.Exception.Type (SomeException) + + + +import GHC.Generics ( Generic ) +import GHC.Unit.Module.Location + +data InterfaceLookingFor + = LookingForName !Name + | LookingForHiBoot !Module + | LookingForModule !ModuleName !IsBootInterface + | LookingForSig !InstalledModule + +data IfaceMessage + = Can'tFindInterface + MissingInterfaceError + InterfaceLookingFor + | Can'tFindNameInInterface + Name + [TyThing] -- possibly relevant TyThings + deriving Generic + +data MissingInterfaceError + = BadSourceImport !Module + | HomeModError !InstalledModule !ModLocation + | DynamicHashMismatchError !Module !ModLocation + + | CantFindErr !UnitState FindingModuleOrInterface CantFindInstalled + + | BadIfaceFile ReadInterfaceError + | FailedToLoadDynamicInterface Module ReadInterfaceError + deriving Generic + +data ReadInterfaceError + = ExceptionOccurred FilePath SomeException + | HiModuleNameMismatchWarn FilePath Module Module + deriving Generic + +data CantFindInstalledReason + = NoUnitIdMatching UnitId [UnitInfo] + | MissingPackageFiles UnitId [FilePath] + | MissingPackageWayFiles String UnitId [FilePath] + | ModuleSuggestion [ModuleSuggestion] [FilePath] + | NotAModule + | CouldntFindInFiles [FilePath] + | GenericMissing BuildingCabalPackage + [(Unit, Maybe UnitInfo)] [Unit] + [(Unit, UnusableUnitReason)] [FilePath] + | MultiplePackages [(Module, ModuleOrigin)] + deriving Generic + +data CantFindInstalled = + CantFindInstalled ModuleName CantFindInstalledReason + deriving Generic +data FindingModuleOrInterface = FindingModule + | FindingInterface + +-- | Pass to a 'DriverMessage' the information whether or not the +-- '-fbuilding-cabal-package' flag is set. +data BuildingCabalPackage + = YesBuildingCabalPackage + | NoBuildingCabalPackage + deriving Eq diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index e794c7c6d2..5305a97623 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -116,6 +116,7 @@ import Data.Map ( toList ) import System.FilePath import System.Directory import GHC.Driver.Env.KnotVars +import GHC.Iface.Errors.Types {- ************************************************************************ @@ -143,7 +144,7 @@ where the code that e1 expands to might import some defns that also turn out to be needed by the code that e2 expands to. -} -tcLookupImported_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcLookupImported_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing) -- Returns (Failed err) if we can't find the interface file for the thing tcLookupImported_maybe name = do { hsc_env <- getTopEnv @@ -152,7 +153,7 @@ tcLookupImported_maybe name Just thing -> return (Succeeded thing) Nothing -> tcImportDecl_maybe name } -tcImportDecl_maybe :: Name -> TcM (MaybeErr SDoc TyThing) +tcImportDecl_maybe :: Name -> TcM (MaybeErr IfaceMessage TyThing) -- Entry point for *source-code* uses of importDecl tcImportDecl_maybe name | Just thing <- wiredInNameTyThing_maybe name @@ -163,7 +164,7 @@ tcImportDecl_maybe name | otherwise = initIfaceTcRn (importDecl name) -importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing) +importDecl :: Name -> IfM lcl (MaybeErr IfaceMessage TyThing) -- Get the TyThing for this Name from an interface file -- It's not a wired-in thing -- the caller caught that importDecl name @@ -174,29 +175,22 @@ importDecl name -- Load the interface, which should populate the PTE ; mb_iface <- assertPpr (isExternalName name) (ppr name) $ loadInterface nd_doc (nameModule name) ImportBySystem - ; case mb_iface of { - Failed err_msg -> return (Failed err_msg) ; - Succeeded _ -> do + ; case mb_iface of + { Failed err_msg -> return $ Failed $ + Can'tFindInterface err_msg (LookingForName name) + ; Succeeded _ -> do -- Now look it up again; this time we should find it { eps <- getEps ; case lookupTypeEnv (eps_PTE eps) name of Just thing -> return $ Succeeded thing - Nothing -> let doc = whenPprDebug (found_things_msg eps $$ empty) - $$ not_found_msg - in return $ Failed doc + Nothing -> return $ Failed $ + Can'tFindNameInInterface name + (filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps) }}} where nd_doc = text "Need decl for" <+> ppr name - not_found_msg = hang (text "Can't find interface-file declaration for" <+> - pprNameSpace (nameNameSpace name) <+> ppr name) - 2 (vcat [text "Probable cause: bug in .hi-boot file, or inconsistent .hi file", - text "Use -ddump-if-trace to get an idea of which file caused the error"]) - found_things_msg eps = - hang (text "Found the following declarations in" <+> ppr (nameModule name) <> colon) - 2 (vcat (map ppr $ filter is_interesting $ nonDetNameEnvElts $ eps_PTE eps)) - where - is_interesting thing = nameModule name == nameModule (getName thing) + is_interesting thing = nameModule name == nameModule (getName thing) {- @@ -299,15 +293,21 @@ loadSrcInterface :: SDoc loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of - Failed err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) - Succeeded iface -> return iface } + Failed err -> + failWithTc $ + TcRnInterfaceError $ + Can'tFindInterface err $ + LookingForModule mod want_boot + Succeeded iface -> + return iface + } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'. loadSrcInterface_maybe :: SDoc -> ModuleName -> IsBootInterface -- {-# SOURCE #-} ? -> PkgQual -- "package", if any - -> RnM (MaybeErr SDoc ModIface) + -> RnM (MaybeErr MissingInterfaceError ModIface) loadSrcInterface_maybe doc mod want_boot maybe_pkg -- We must first find which Module this import refers to. This involves @@ -403,11 +403,11 @@ loadInterfaceWithException doc mod_name where_from = do dflags <- getDynFlags let ctx = initSDocContext dflags defaultUserStyle - withException ctx (loadInterface doc mod_name where_from) + withIfaceErr ctx (loadInterface doc mod_name where_from) ------------------ loadInterface :: SDoc -> Module -> WhereFrom - -> IfM lcl (MaybeErr SDoc ModIface) + -> IfM lcl (MaybeErr MissingInterfaceError ModIface) -- loadInterface looks in both the HPT and PIT for the required interface -- If not found, it loads it, and puts it in the PIT (always). @@ -703,7 +703,7 @@ computeInterface -> SDoc -> IsBootInterface -> Module - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) computeInterface hsc_env doc_str hi_boot_file mod0 = do massert (not (isHoleModule mod0)) let mhome_unit = hsc_home_unit_maybe hsc_env @@ -732,7 +732,7 @@ computeInterface hsc_env doc_str hi_boot_file mod0 = do -- @p[A=\<A>,B=\<B>]:B@ never includes B. moduleFreeHolesPrecise :: SDoc -> Module - -> TcRnIf gbl lcl (MaybeErr SDoc (UniqDSet ModuleName)) + -> TcRnIf gbl lcl (MaybeErr MissingInterfaceError (UniqDSet ModuleName)) moduleFreeHolesPrecise doc_str mod | moduleIsDefinite mod = return (Succeeded emptyUniqDSet) | otherwise = @@ -769,13 +769,13 @@ moduleFreeHolesPrecise doc_str mod Failed err -> return (Failed err) wantHiBootFile :: Maybe HomeUnit -> ExternalPackageState -> Module -> WhereFrom - -> MaybeErr SDoc IsBootInterface + -> MaybeErr MissingInterfaceError IsBootInterface -- Figure out whether we want Foo.hi or Foo.hi-boot wantHiBootFile mhome_unit eps mod from = case from of ImportByUser usr_boot | usr_boot == IsBoot && notHomeModuleMaybe mhome_unit mod - -> Failed (badSourceImport mod) + -> Failed (BadSourceImport mod) | otherwise -> Succeeded usr_boot ImportByPlugin @@ -798,11 +798,6 @@ wantHiBootFile mhome_unit eps mod from -- The boot-ness of the requested interface, -- based on the dependencies in directly-imported modules -badSourceImport :: Module -> SDoc -badSourceImport mod - = hang (text "You cannot {-# SOURCE #-} import a module from another package") - 2 (text "but" <+> quotes (ppr mod) <+> text "is from package" - <+> quotes (ppr (moduleUnit mod))) ----------------------------------------------------- -- Loading type/class/value decls @@ -855,7 +850,7 @@ findAndReadIface -- this to check the consistency of the requirements of the -- module we read out. -> IsBootInterface -- ^ Looking for .hi-boot or .hi file - -> IO (MaybeErr SDoc (ModIface, FilePath)) + -> IO (MaybeErr MissingInterfaceError (ModIface, FilePath)) findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do let profile = targetProfile dflags @@ -897,12 +892,12 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do Just home_unit | isHomeInstalledModule home_unit mod , not (isOneShot (ghcMode dflags)) - -> return (Failed (homeModError mod loc)) + -> return (Failed (HomeModError mod loc)) _ -> do r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of - Failed _ - -> return r + Failed err + -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) -> do r2 <- load_dynamic_too_maybe logger name_cache unit_state @@ -910,46 +905,47 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do iface loc case r2 of Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return r + Succeeded {} -> return $ Succeeded (iface,_fp) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface unit_state mhome_unit profile - (Iface_Errors.mayShowLocations dflags) (moduleName mod) err -- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc -- Indefinite interfaces are ALWAYS non-dynamic. | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc | otherwise = return (Succeeded ()) -load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> ModLocation -> IO (MaybeErr SDoc ()) +load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> ModIface -> ModLocation + -> IO (MaybeErr MissingInterfaceError ()) load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case Succeeded (dynIface, _) | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) -> return (Succeeded ()) | otherwise -> - do return $ (Failed $ dynamicHashMismatchError wanted_mod loc) + do return $ (Failed $ DynamicHashMismatchError wanted_mod loc) Failed err -> - do return $ (Failed $ ((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) + do return $ (Failed $ FailedToLoadDynamicInterface wanted_mod err) + --((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) -dynamicHashMismatchError :: Module -> ModLocation -> SDoc -dynamicHashMismatchError wanted_mod loc = - vcat [ text "Dynamic hash doesn't match for" <+> quotes (ppr wanted_mod) - , text "Normal interface file from" <+> text (ml_hi_file loc) - , text "Dynamic interface file from" <+> text (ml_dyn_hi_file loc) - , text "You probably need to recompile" <+> quotes (ppr wanted_mod) ] -read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath)) + +read_file :: Logger -> NameCache -> UnitState -> DynFlags + -> Module -> FilePath + -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath)) read_file logger name_cache unit_state dflags wanted_mod file_path = do trace_if logger (text "readIFace" <+> text file_path) @@ -964,7 +960,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do (uninstantiateInstantiatedModule indef_mod) read_result <- readIface dflags name_cache wanted_mod' file_path case read_result of - Failed err -> return (Failed (badIfaceFile file_path err)) + Failed err -> return (Failed err) Succeeded iface -> return (Succeeded (iface, file_path)) -- Don't forget to fill in the package name... @@ -985,7 +981,7 @@ readIface -> NameCache -> Module -> FilePath - -> IO (MaybeErr SDoc ModIface) + -> IO (MaybeErr ReadInterfaceError ModIface) readIface dflags name_cache wanted_mod file_path = do let profile = targetProfile dflags res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path @@ -999,9 +995,9 @@ readIface dflags name_cache wanted_mod file_path = do | otherwise -> return (Failed err) where actual_mod = mi_module iface - err = hiModuleNameMismatchWarn wanted_mod actual_mod + err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod - Left exn -> return (Failed (text (showException exn))) + Left exn -> return (Failed (ExceptionOccurred file_path exn)) {- ********************************************************* diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 2e1150910b..b0e668f0e6 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -83,6 +83,7 @@ import GHC.List (uncons) import Data.Ord import Data.Containers.ListUtils import Data.Bifunctor +import GHC.Iface.Errors.Ppr {- ----------------------------------------------- @@ -292,8 +293,13 @@ check_old_iface hsc_env mod_summary maybe_iface read_result <- readIface read_dflags ncu (ms_mod mod_summary) iface_path case read_result of Failed err -> do - trace_if logger (text "FYI: cannot read old interface file:" $$ nest 4 err) - trace_hi_diffs logger (text "Old interface file was invalid:" $$ nest 4 err) + let msg = readInterfaceErrorDiagnostic err + trace_if logger + $ vcat [ text "FYI: cannot read old interface file:" + , nest 4 msg ] + trace_hi_diffs logger $ + vcat [ text "Old interface file was invalid:" + , nest 4 msg ] return Nothing Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) @@ -1323,7 +1329,7 @@ getOrphanHashes hsc_env mods = do dflags = hsc_dflags hsc_env ctx = initSDocContext dflags defaultUserStyle get_orph_hash mod = do - iface <- initIfaceLoad hsc_env . withException ctx + iface <- initIfaceLoad hsc_env . withIfaceErr ctx $ loadInterface (text "getOrphanHashes") mod ImportBySystem return (mi_orphan_hash (mi_final_exts iface)) @@ -1618,7 +1624,7 @@ mkHashFun hsc_env eps name -- requirements; we didn't do any /real/ typechecking -- so there's no guarantee everything is loaded. -- Kind of a heinous hack. - initIfaceLoad hsc_env . withException ctx + initIfaceLoad hsc_env . withIfaceErr ctx $ withoutDynamicNow -- If you try and load interfaces when dynamic-too -- enabled then it attempts to load the dyn_hi and hi diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index aaacb86b7f..2a81b9c2a0 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -132,6 +132,7 @@ import GHC.Unit.Module.WholeCoreBindings import Data.IORef import Data.Foldable import GHC.Builtin.Names (ioTyConName, rOOT_MAIN) +import GHC.Iface.Errors.Types {- This module takes @@ -576,13 +577,14 @@ tcHiBootIface hsc_src mod -- to check consistency against, rather than just when we notice -- that an hi-boot is necessary due to a circular import. { hsc_env <- getTopEnv - ; read_result <- liftIO $ findAndReadIface hsc_env - need (fst (getModuleInstantiation mod)) mod - IsBoot -- Hi-boot file + ; read_result <- liftIO $ findAndReadIface hsc_env need + (fst (getModuleInstantiation mod)) mod + IsBoot -- Hi-boot file ; case read_result of { - Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + Succeeded (iface, _path) -> + do { tc_iface <- initIfaceTcRn $ typecheckIface iface + ; mkSelfBootInfo iface tc_iface } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -598,7 +600,10 @@ tcHiBootIface hsc_src mod Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of - IsBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints (elaborate err)) + IsBoot -> + let diag = Can'tFindInterface err + (LookingForHiBoot mod) + in failWithTc (TcRnInterfaceError diag) -- The hi-boot file has mysteriously disappeared. NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! @@ -611,8 +616,6 @@ tcHiBootIface hsc_src mod moduleLoop = text "Circular imports: module" <+> quotes (ppr mod) <+> text "depends on itself" - elaborate err = hang (text "Could not find hi-boot interface for" <+> - quotes (ppr mod) <> colon) 4 err mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo @@ -1968,7 +1971,7 @@ tcIfaceGlobal name { mb_thing <- importDecl name -- It's imported; go get it ; case mb_thing of - Failed err -> failIfM (ppr name <+> err) + Failed err -> failIfM (ppr name <+> pprDiagnostic err) Succeeded thing -> return thing }}} diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs index 7080bb0776..f6caa18a9d 100644 --- a/compiler/GHC/Linker/Loader.hs +++ b/compiler/GHC/Linker/Loader.hs @@ -119,6 +119,7 @@ import GHC.Iface.Load import GHC.Unit.Home import Data.Either import Control.Applicative +import GHC.Iface.Errors.Ppr uninitialised :: a uninitialised = panic "Loader not initialised" @@ -789,7 +790,10 @@ getLinkDeps hsc_env pls replace_osuf span mods mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $ loadInterface msg mod (ImportByUser NotBoot) iface <- case mb_iface of - Maybes.Failed err -> throwGhcExceptionIO (ProgramError (showSDoc dflags err)) + Maybes.Failed err -> + let opts = initIfaceMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic opts err + in throwGhcExceptionIO (ProgramError (showSDoc dflags err_txt)) Maybes.Succeeded iface -> return iface when (mi_boot iface == IsBoot) $ link_boot_mod_error mod diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index ebfa7875e5..cbe376b9cd 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -45,16 +45,20 @@ import GHC.Core.Type ( Type, mkTyConTy ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( TyCon ) + import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader +import GHC.Types.Unique.DFM + import GHC.Unit.Finder ( findPluginModule, FindResult(..) ) import GHC.Driver.Config.Finder ( initFinderOpts ) +import GHC.Driver.Config.Diagnostic ( initIfaceMessageOpts ) import GHC.Unit.Module ( Module, ModuleName ) -import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModIface ( ModIface_(mi_exports), ModIface ) import GHC.Unit.Env import GHC.Utils.Panic @@ -68,8 +72,9 @@ import Control.Monad ( unless ) import Data.Maybe ( mapMaybe ) import Unsafe.Coerce ( unsafeCoerce ) import GHC.Linker.Types -import GHC.Types.Unique.DFM import Data.List (unzip4) +import GHC.Iface.Errors.Ppr + -- | Loads the plugins specified in the pluginModNames field of the dynamic -- flags. Should be called after command line arguments are parsed, but before @@ -329,7 +334,11 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do _ -> panic "lookupRdrNameInModule" Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name] - err -> throwCmdLineErrorS dflags $ cannotFindModule hsc_env mod_name err + err -> + let opts = initIfaceMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic opts + $ cannotFindModule hsc_env mod_name err + in throwCmdLineErrorS dflags err_txt where doc = text "contains a name used in an invocation of lookupRdrNameInModule" diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 0d253cbf6b..5cc8ab5f64 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -76,7 +76,7 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Fixity (defaultFixity) -import GHC.Unit.State (pprWithUnitState, UnitState) +import GHC.Unit.State import GHC.Unit.Module import GHC.Unit.Module.Warnings ( warningTxtCategory, pprWarningTxtForMsg ) @@ -101,13 +101,16 @@ import Data.Ord ( comparing ) import Data.Bifunctor import qualified Language.Haskell.TH as TH import {-# SOURCE #-} GHC.Tc.Types (pprTcTyThingCategory) +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not + , tcOptsIfaceOpts :: !IfaceMessageOpts } defaultTcRnMessageOpts :: TcRnMessageOpts -defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True } - +defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True + , tcOptsIfaceOpts = defaultDiagnosticOpts @IfaceMessage } instance Diagnostic TcRnMessage where type DiagnosticOpts TcRnMessage = TcRnMessageOpts @@ -1245,7 +1248,6 @@ instance Diagnostic TcRnMessage where True -> text (show item) False -> text (TH.pprint item)) TcRnReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg - TcRnInterfaceLookupError _ sdoc -> mkSimpleDecorated sdoc TcRnUnsatisfiedMinimalDef mindef -> mkSimpleDecorated $ vcat [text "No explicit implementation for" @@ -1733,6 +1735,8 @@ instance Diagnostic TcRnMessage where ppr (frr_context frr) $$ text "cannot be assigned a fixed runtime representation," <+> text "not even by defaulting." + TcRnInterfaceError reason + -> diagnosticMessage (tcOptsIfaceOpts opts) reason diagnosticReason = \case TcRnUnknownMessage m @@ -2105,8 +2109,6 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnReportCustomQuasiError isError _ -> if isError then ErrorWithoutFlag else WarningWithoutFlag - TcRnInterfaceLookupError{} - -> ErrorWithoutFlag TcRnUnsatisfiedMinimalDef{} -> WarningWithFlag (Opt_WarnMissingMethods) TcRnMisplacedInstSig{} @@ -2307,6 +2309,9 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnCannotDefaultConcrete{} -> ErrorWithoutFlag + TcRnInterfaceError err + -> interfaceErrorReason err + diagnosticHints = \case TcRnUnknownMessage m @@ -2685,8 +2690,6 @@ instance Diagnostic TcRnMessage where -> noHints TcRnReportCustomQuasiError{} -> noHints - TcRnInterfaceLookupError{} - -> noHints TcRnUnsatisfiedMinimalDef{} -> noHints TcRnMisplacedInstSig{} @@ -2908,6 +2911,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnCannotDefaultConcrete{} -> [SuggestAddTypeSignatures UnnamedBinding] + TcRnInterfaceError reason + -> interfaceErrorHints reason diagnosticCode = constructorCode diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index a8d7c30846..38615d0f0d 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -124,6 +124,7 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) import GHC.Tc.Types.Rank (Rank) import GHC.Tc.Utils.TcType (IllegalForeignTypeReason, TcType, TcSigmaType, TcPredType) import GHC.Types.Avail (AvailInfo) +import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) @@ -151,7 +152,6 @@ import GHC.Core.TyCon (TyCon, Role) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState) -import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) @@ -166,6 +166,7 @@ import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics ( Generic ) import GHC.Types.Name.Env (NameEnv) +import GHC.Iface.Errors.Types {- Note [Migrating TcM Messages] @@ -232,6 +233,11 @@ data TcRnMessage where -} TcRnUnknownMessage :: UnknownDiagnostic -> TcRnMessage + {-| Wrap an 'IfaceMessage' to a 'TcRnMessage' for when we attempt to load interface + files during typechecking but encounter an error. -} + + TcRnInterfaceError :: !IfaceMessage -> TcRnMessage + {-| TcRnMessageWithInfo is a constructor which is used when extra information is needed to be provided in order to qualify a diagnostic and where it was originated (and why). It carries an extra 'UnitState' which can be used to pretty-print some names @@ -2723,14 +2729,6 @@ data TcRnMessage where -> !String -- Error body -> TcRnMessage - {-| TcRnInterfaceLookupError is an error resulting from looking up a name in an interface file. - - Example(s): - - Test cases: - -} - TcRnInterfaceLookupError :: !Name -> !SDoc -> TcRnMessage - {- | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance is missing methods that are required by the minimal definition. diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index fcfe39cb4d..e28ba6f24f 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -2029,7 +2029,7 @@ tcLookupTh name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing) - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}}} notInScope :: TH.Name -> TcRnMessage diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index 20508c0fa4..5f76ba7e0c 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -87,6 +87,8 @@ import GHC.Data.Maybe import Control.Monad import Data.List (find) +import GHC.Iface.Errors.Types + checkHsigDeclM :: ModIface -> TyThing -> TyThing -> TcRn () checkHsigDeclM sig_iface sig_thing real_thing = do let name = getName real_thing @@ -152,7 +154,7 @@ checkHsigIface tcg_env gre_env sig_iface -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of - Failed err -> addErr (TcRnInterfaceLookupError name err) + Failed err -> addErr (TcRnInterfaceError err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must @@ -262,7 +264,7 @@ findExtraSigImports hsc_env HsigFile modname = do reqs = requirementMerges unit_state modname holes <- forM reqs $ \(Module iuid mod_name) -> do initIfaceLoad hsc_env - . withException ctx + . withIfaceErr ctx $ moduleFreeHolesPrecise (text "findExtraSigImports") (mkModule (VirtUnit iuid) mod_name) return (uniqDSetToList (unionManyUniqDSets holes)) @@ -547,9 +549,8 @@ mergeSignatures im = fst (getModuleInstantiation m) ctx = initSDocContext dflags defaultUserStyle fmap fst - . withException ctx - $ findAndReadIface hsc_env - (text "mergeSignatures") im m NotBoot + . withIfaceErr ctx + $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot -- STEP 3: Get the unrenamed exports of all these interfaces, -- thin it according to the export list, and do shaping on them. @@ -980,9 +981,9 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface - Failed err -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ - hang (text "Could not find hi interface for signature" <+> - quotes (ppr isig_mod) <> colon) 4 err + Failed err -> + failWithTc $ TcRnInterfaceError $ + Can'tFindInterface err (LookingForSig isig_mod) -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 52bf245dc5..b8f9d83912 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -25,7 +25,7 @@ module GHC.Tc.Utils.Env( tcLookupRecSelParent, tcLookupLocatedGlobalId, tcLookupLocatedTyCon, tcLookupLocatedClass, tcLookupAxiom, - lookupGlobal, lookupGlobal_maybe, ioLookupDataCon, + lookupGlobal, lookupGlobal_maybe, addTypecheckedBinds, -- Local environment @@ -136,11 +136,12 @@ import GHC.Types.Name.Reader import GHC.Types.TyThing import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import qualified GHC.LanguageExtensions as LangExt -import GHC.Tc.Errors.Ppr (pprTyThingUsedWrong) import Data.IORef import Data.List ( intercalate ) import Control.Monad +import GHC.Iface.Errors.Types +import GHC.Types.Error {- ********************************************************************* * * @@ -156,10 +157,13 @@ lookupGlobal hsc_env name mb_thing <- lookupGlobal_maybe hsc_env name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> pprPanic "lookupGlobal" msg + Failed err -> + let msg = case err of + Left name -> text "Could not find local name:" <+> ppr name + Right err -> pprDiagnostic err + in pprPanic "lookupGlobal" msg } - -lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr (Either Name IfaceMessage) TyThing) -- This may look up an Id that one has previously looked up. -- If so, we are going to read its interface file, and add its bindings -- to the ExternalPackageTable. @@ -170,24 +174,26 @@ lookupGlobal_maybe hsc_env name tcg_semantic_mod = homeModuleInstantiation mhome_unit mod ; if nameIsLocalOrFrom tcg_semantic_mod name - then (return - (Failed (text "Can't find local name: " <+> ppr name))) - -- Internal names can happen in GHCi - else - -- Try home package table and external package table - lookupImported_maybe hsc_env name + then return $ Failed $ Left name + -- Internal names can happen in GHCi + else do + res <- lookupImported_maybe hsc_env name + -- Try home package table and external package table + return $ case res of + Succeeded ok -> Succeeded ok + Failed err -> Failed (Right err) } -lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr IfaceMessage TyThing) -- Returns (Failed err) if we can't find the interface file for the thing lookupImported_maybe hsc_env name = do { mb_thing <- lookupType hsc_env name ; case mb_thing of Just thing -> return (Succeeded thing) Nothing -> importDecl_maybe hsc_env name - } + } -importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing) +importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr IfaceMessage TyThing) importDecl_maybe hsc_env name | Just thing <- wiredInNameTyThing_maybe name = do { when (needWiredInHomeIface thing) @@ -197,23 +203,6 @@ importDecl_maybe hsc_env name | otherwise = initIfaceLoad hsc_env (importDecl name) --- | A 'TyThing'... except it's not the right sort. -type WrongTyThing = TyThing - -ioLookupDataCon :: HscEnv -> Name -> IO DataCon -ioLookupDataCon hsc_env name = do - mb_thing <- ioLookupDataCon_maybe hsc_env name - case mb_thing of - Succeeded thing -> return thing - Failed thing -> pprPanic "lookupDataConIO" (pprTyThingUsedWrong WrongThingDataCon (AGlobal thing) name) - -ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr WrongTyThing DataCon) -ioLookupDataCon_maybe hsc_env name = do - thing <- lookupGlobal hsc_env name - return $ case thing of - AConLike (RealDataCon con) -> Succeeded con - _ -> Failed thing - addTypecheckedBinds :: TcGblEnv -> [LHsBinds GhcTc] -> TcGblEnv addTypecheckedBinds tcg_env binds | isHsBootOrSig (tcg_src tcg_env) = tcg_env @@ -263,7 +252,7 @@ tcLookupGlobal name do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing - Failed msg -> failWithTc (TcRnInterfaceLookupError name msg) + Failed msg -> failWithTc (TcRnInterfaceError msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc. diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index d713fce376..75b74cbb35 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -138,7 +139,7 @@ module GHC.Tc.Utils.Monad( forkM, setImplicitEnvM, - withException, + withException, withIfaceErr, -- * Stuff for cost centres. getCCIndexM, getCCIndexTcM, @@ -222,6 +223,8 @@ import qualified Data.Map as Map import GHC.Driver.Env.KnotVars import GHC.Linker.Types import GHC.Types.Unique.DFM +import GHC.Iface.Errors.Types +import GHC.Iface.Errors.Ppr {- ************************************************************************ @@ -661,6 +664,16 @@ withException ctx do_this = do Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx err)) Succeeded result -> return result +withIfaceErr :: MonadIO m => SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a +withIfaceErr ctx do_this = do + r <- do_this + case r of + Failed err -> do + let opts = defaultDiagnosticOpts @IfaceMessage + msg = missingInterfaceErrorDiagnostic opts err + liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx msg)) + Succeeded result -> return result + {- ************************************************************************ * * diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs index 0eccf085bb..b0454cac6b 100644 --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -35,6 +35,8 @@ module GHC.Types.Error , mkDecoratedDiagnostic , mkDecoratedError + , pprDiagnostic + , NoDiagnosticOpts(..) -- * Hints and refactoring actions diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs index b85e484ea2..e5d7a84bb6 100644 --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -38,6 +38,7 @@ import GHC.Generics import GHC.TypeLits ( Symbol, TypeError, ErrorMessage(..) ) import GHC.TypeNats ( Nat, KnownNat, natVal' ) import GHC.Core.InstEnv (LookupInstanceErrReason) +import GHC.Iface.Errors.Types {- Note [Diagnostic codes] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -663,6 +664,22 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "OneArgExpected" = 91490 GhcDiagnosticCode "AtLeastOneArgExpected" = 07641 + -- Interface errors + GhcDiagnosticCode "BadSourceImport" = 64852 + GhcDiagnosticCode "HomeModError" = 58427 + GhcDiagnosticCode "DynamicHashMismatchError" = 54709 + GhcDiagnosticCode "CouldntFindInFiles" = 94559 + GhcDiagnosticCode "GenericMissing" = 87110 + GhcDiagnosticCode "MissingPackageFiles" = 22211 + GhcDiagnosticCode "MissingPackageWayFiles" = 88719 + GhcDiagnosticCode "ModuleSuggestion" = 61948 + GhcDiagnosticCode "MultiplePackages" = 45102 + GhcDiagnosticCode "NoUnitIdMatching" = 51294 + GhcDiagnosticCode "NotAModule" = 35235 + GhcDiagnosticCode "Can'tFindNameInInterface" = 83249 + GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693 + GhcDiagnosticCode "ExceptionOccurred" = 47808 + -- Out of scope errors GhcDiagnosticCode "NotInScope" = 76037 GhcDiagnosticCode "NotARecordField" = 22385 @@ -757,6 +774,15 @@ type family ConRecursInto con where ConRecursInto "DriverUnknownMessage" = 'Just UnknownDiagnostic ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage + ConRecursInto "DriverInterfaceError" = 'Just IfaceMessage + + ConRecursInto "CantFindErr" = 'Just CantFindInstalled + ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled + + ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason + + ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError + ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError ---------------------------------- -- Constructors of PsMessage @@ -793,6 +819,11 @@ type family ConRecursInto con where ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason ConRecursInto "ConversionFail" = 'Just ConversionFailReason + -- Interface file errors + + ConRecursInto "TcRnInterfaceError" = 'Just IfaceMessage + ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError + ------------------ -- FFI errors diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs index 8ea61c6f39..bf80c5ed37 100644 --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -245,14 +245,14 @@ getInvalids vs = [d | NotValid d <- vs] ---------------- -- | Formats the input list of structured document, where each element of the list gets a bullet. -formatBulleted :: SDocContext -> DecoratedSDoc -> SDoc -formatBulleted ctx (unDecorated -> docs) - = case msgs of +formatBulleted :: DecoratedSDoc -> SDoc +formatBulleted (unDecorated -> docs) + = sdocWithContext $ \ctx -> case msgs ctx of [] -> Outputable.empty [msg] -> msg - _ -> vcat $ map starred msgs + xs -> vcat $ map starred xs where - msgs = filter (not . Outputable.isEmpty ctx) docs + msgs ctx = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc @@ -274,12 +274,11 @@ pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = name_ppr_ctx }) - = sdocWithContext $ \ctx -> - withErrStyle name_ppr_ctx $ + = withErrStyle name_ppr_ctx $ mkLocMessage (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) s - (formatBulleted ctx $ diagnosticMessage opts e) + (formatBulleted $ diagnosticMessage opts e) sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e] sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 105d44ef99..59a033d568 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -503,6 +503,8 @@ Library GHC.Iface.Binary GHC.Iface.Env GHC.Iface.Errors + GHC.Iface.Errors.Types + GHC.Iface.Errors.Ppr GHC.Iface.Ext.Ast GHC.Iface.Ext.Binary GHC.Iface.Ext.Debug diff --git a/ghc/Main.hs b/ghc/Main.hs index ae862a7014..ef3de102c0 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -79,12 +79,13 @@ import GHC.Iface.Load import GHC.Iface.Recomp.Binary ( fingerprintBinMem ) import GHC.Tc.Utils.Monad ( initIfaceCheck ) -import System.FilePath +import GHC.Iface.Errors.Ppr -- Standard Haskell libraries import System.IO import System.Environment import System.Exit +import System.FilePath import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Except (throwE, runExceptT) @@ -1100,8 +1101,11 @@ abiHash strs = do r <- findImportedModule hsc_env modname NoPkgQual case r of Found _ m -> return m - _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ - cannotFindModule hsc_env modname r + _error -> + let opts = initIfaceMessageOpts dflags + err_txt = missingInterfaceErrorDiagnostic opts + $ cannotFindModule hsc_env modname r + in throwGhcException . CmdLineError $ showSDoc dflags err_txt mods <- mapM find_it strs diff --git a/testsuite/tests/cabal/cabal05/cabal05.stderr b/testsuite/tests/cabal/cabal05/cabal05.stderr index 183c5319d1..2ff23d3a47 100644 --- a/testsuite/tests/cabal/cabal05/cabal05.stderr +++ b/testsuite/tests/cabal/cabal05/cabal05.stderr @@ -1,5 +1,5 @@ -T.hs:3:1: error: - Ambiguous module name ‘Conflict’: - it is bound as p-0.1.0.0:P2 by a reexport in package q-0.1.0.0 - it is bound as P by a reexport in package r-0.1.0.0 +T.hs:3:1: error: [GHC-45102] + Ambiguous module name ‘Conflict’. + it is bound as p-0.1.0.0:P2 by a reexport in package q-0.1.0.0 + it is bound as P by a reexport in package r-0.1.0.0 diff --git a/testsuite/tests/cabal/ghcpkg04.stderr b/testsuite/tests/cabal/ghcpkg04.stderr index 5cc97f573f..dab99da52d 100644 --- a/testsuite/tests/cabal/ghcpkg04.stderr +++ b/testsuite/tests/cabal/ghcpkg04.stderr @@ -1,4 +1,4 @@ -ghcpkg04.hs:1:1: error: - Ambiguous module name ‘A’: - it was found in multiple packages: newtestpkg-2.0 testpkg-1.2.3.4 +ghcpkg04.hs:1:1: error: [GHC-45102] + Ambiguous module name ‘A’. + it was found in multiple packages: newtestpkg-2.0 testpkg-1.2.3.4 diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 652a35a9b7..beb1e54f23 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -141,6 +141,8 @@ GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Ppr GHC.HsToCore.Pmc.Solver.Types GHC.HsToCore.Pmc.Types +GHC.Iface.Errors.Ppr +GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Recomp.Binary GHC.Iface.Syntax diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 4850f57f96..44fc982440 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -142,6 +142,8 @@ GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Ppr GHC.HsToCore.Pmc.Solver.Types GHC.HsToCore.Pmc.Types +GHC.Iface.Errors.Ppr +GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Recomp.Binary GHC.Iface.Syntax diff --git a/testsuite/tests/driver/driver063.stderr b/testsuite/tests/driver/driver063.stderr index 307467b27b..979b5ee506 100644 --- a/testsuite/tests/driver/driver063.stderr +++ b/testsuite/tests/driver/driver063.stderr @@ -1,4 +1,4 @@ -D063.hs:2:1: error: - Could not find module ‘A063’ +D063.hs:2:1: error: [GHC-35235] + Could not find module ‘A063’. It is not a module in the current program, or in any known package. diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr index 349b5f2816..2b10199ac0 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr +++ b/testsuite/tests/driver/dynamicToo/dynamicToo001/dynamicToo001.stderr @@ -1,5 +1,5 @@ -C.hs:5:1: error: +C.hs:5:1: error: [GHC-54709] Dynamic hash doesn't match for ‘B’ Normal interface file from ./B.hi Dynamic interface file from ./B.dyn_hi diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr index 8b17cac27a..95cf763877 100644 --- a/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr +++ b/testsuite/tests/driver/dynamicToo/dynamicToo001boot/dynamicToo001boot.stderr @@ -1,5 +1,5 @@ -C.hs:5:1: error: +C.hs:5:1: error: [GHC-54709] Dynamic hash doesn't match for ‘B’ Normal interface file from ./B.hi-boot Dynamic interface file from ./B.dyn_hi-boot diff --git a/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr index b1cd097d13..f6c9781fcc 100644 --- a/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr +++ b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnitsModuleVisibility.stderr @@ -1,5 +1,5 @@ -module-visibility-import/MV.hs:5:1: error: - Could not load module ‘MV2’ +module-visibility-import/MV.hs:5:1: error: [GHC-87110] + Could not load module ‘MV2’. it is a hidden module in the package ‘mv’ Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs index 82981a9e82..c6d35773f7 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.hs +++ b/testsuite/tests/ghc-api/T4891/T4891.hs @@ -62,6 +62,6 @@ chaseConstructor !hv = do Right dcName -> do putStrLn $ "Name: " ++ showPpr dflags dcName putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" - dc <- ioLookupDataCon hscEnv dcName + dc <- lookupGlobal hscEnv dcName putStrLn $ "DataCon: " ++ showPpr dflags dc _ -> return () diff --git a/testsuite/tests/ghc-api/T4891/T4891.stdout b/testsuite/tests/ghc-api/T4891/T4891.stdout index 8ad0b4eabe..758d497e16 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.stdout +++ b/testsuite/tests/ghc-api/T4891/T4891.stdout @@ -1,20 +1,20 @@ ===== Name: False OccString: 'False' -DataCon: False +DataCon: Data constructor ‘False’ ===== Name: : OccString: ':' -DataCon: : +DataCon: Data constructor ‘:’ ===== Name: :-> OccString: ':->' -DataCon: :-> +DataCon: Data constructor ‘:->’ ===== Name: :->. OccString: ':->.' -DataCon: :->. +DataCon: Data constructor ‘:->.’ ===== Name: :->.+ OccString: ':->.+' -DataCon: :->.+ +DataCon: Data constructor ‘:->.+’ diff --git a/testsuite/tests/ghc-api/target-contents/TargetContents.stderr b/testsuite/tests/ghc-api/target-contents/TargetContents.stderr index 3fa570ca1d..f1dfb73027 100644 --- a/testsuite/tests/ghc-api/target-contents/TargetContents.stderr +++ b/testsuite/tests/ghc-api/target-contents/TargetContents.stderr @@ -16,8 +16,8 @@ B.hs:3:5: error: [GHC-88464] Variable not in scope: z B.hs:3:5: error: [GHC-88464] Variable not in scope: z == Dep_Error_MM_A -A.hs:3:1: error: - Could not find module ‘B’ +A.hs:3:1: error: [GHC-87110] + Could not find module ‘B’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. == Dep_DM_AB == Dep_Error_DM_AB @@ -25,8 +25,8 @@ A.hs:3:1: error: B.hs:3:5: error: [GHC-88464] Variable not in scope: z == Dep_Error_DM_A -A.hs:3:1: error: - Could not find module ‘B’ +A.hs:3:1: error: [GHC-87110] + Could not find module ‘B’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. == Dep_MD_AB == Dep_Error_MD_AB diff --git a/testsuite/tests/ghc-e/should_fail/T9905fail1.stderr b/testsuite/tests/ghc-e/should_fail/T9905fail1.stderr index 9d0d79c23e..ccbb16662d 100644 --- a/testsuite/tests/ghc-e/should_fail/T9905fail1.stderr +++ b/testsuite/tests/ghc-e/should_fail/T9905fail1.stderr @@ -1,5 +1,5 @@ -<no location info>: error: - Could not find module ‘This.Module.Does.Not.Exist’ +<no location info>: error: [GHC-35235] + Could not find module ‘This.Module.Does.Not.Exist’. It is not a module in the current program, or in any known package. 1 diff --git a/testsuite/tests/ghc-e/should_run/T2636.stderr b/testsuite/tests/ghc-e/should_run/T2636.stderr index 9a2c6674c9..a471f15686 100644 --- a/testsuite/tests/ghc-e/should_run/T2636.stderr +++ b/testsuite/tests/ghc-e/should_run/T2636.stderr @@ -1,4 +1,4 @@ -T2636.hs:1:1: error: - Could not find module ‘MissingModule’ +T2636.hs:1:1: error: [GHC-87110] + Could not find module ‘MissingModule’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr index 49283bea08..e78b9f1eaa 100644 --- a/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr +++ b/testsuite/tests/ghci.debugger/scripts/dynbrk001.stderr @@ -1,4 +1,4 @@ -<no location info>: - Could not find module ‘NonModule’ +<no location info>: error: [GHC-35235] + Could not find module ‘NonModule’. It is not a module in the current program, or in any known package. diff --git a/testsuite/tests/ghci/scripts/T20455.stderr b/testsuite/tests/ghci/scripts/T20455.stderr index db1df877e3..c2a4c9599d 100644 --- a/testsuite/tests/ghci/scripts/T20455.stderr +++ b/testsuite/tests/ghci/scripts/T20455.stderr @@ -6,6 +6,6 @@ ‘Ghci1.l’ (imported from Ghci1), ‘l’ (line 2), ‘all’ (imported from Prelude) -<no location info>: error: - Could not find module ‘Ghci1’ +<no location info>: error: [GHC-35235] + Could not find module ‘Ghci1’. It is not a module in the current program, or in any known package. diff --git a/testsuite/tests/ghci/scripts/T5836.stderr b/testsuite/tests/ghci/scripts/T5836.stderr index 80de015c5c..14369e8fea 100644 --- a/testsuite/tests/ghci/scripts/T5836.stderr +++ b/testsuite/tests/ghci/scripts/T5836.stderr @@ -1,4 +1,4 @@ -<no location info>: - Could not find module ‘Does.Not.Exist’ +<no location info>: error: [GHC-35235] + Could not find module ‘Does.Not.Exist’. It is not a module in the current program, or in any known package. diff --git a/testsuite/tests/ghci/scripts/T5979.stderr b/testsuite/tests/ghci/scripts/T5979.stderr index 75dc448445..8ad77a8204 100644 --- a/testsuite/tests/ghci/scripts/T5979.stderr +++ b/testsuite/tests/ghci/scripts/T5979.stderr @@ -1,7 +1,7 @@ -<no location info>: error: - Could not find module ‘Control.Monad.Trans.State’ +<no location info>: error: [GHC-61948] + Could not find module ‘Control.Monad.Trans.State’. Perhaps you meant - Control.Monad.Trans.State (from transformers-0.5.6.2) - Control.Monad.Trans.Cont (from transformers-0.5.6.2) - Control.Monad.Trans.Class (from transformers-0.5.6.2) + Control.Monad.Trans.State (from transformers-0.6.1.0) + Control.Monad.Trans.Cont (from transformers-0.6.1.0) + Control.Monad.Trans.Class (from transformers-0.6.1.0) diff --git a/testsuite/tests/ghci/should_fail/T15055.stderr b/testsuite/tests/ghci/should_fail/T15055.stderr index fbf540edfd..c5e54166bc 100644 --- a/testsuite/tests/ghci/should_fail/T15055.stderr +++ b/testsuite/tests/ghci/should_fail/T15055.stderr @@ -1,6 +1,6 @@ -<no location info>: error: - Could not load module ‘GHC’ - It is a member of the hidden package ‘ghc-8.5’. +<no location info>: error: [GHC-87110] + Could not load module ‘GHC’. + 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.) diff --git a/testsuite/tests/module/mod1.stderr b/testsuite/tests/module/mod1.stderr index 9bcff0bc5d..d3d2278f79 100644 --- a/testsuite/tests/module/mod1.stderr +++ b/testsuite/tests/module/mod1.stderr @@ -1,4 +1,4 @@ -mod1.hs:3:1: error: - Could not find module ‘N’ +mod1.hs:3:1: error: [GHC-87110] + Could not find module ‘N’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/module/mod2.stderr b/testsuite/tests/module/mod2.stderr index d9d07168b7..78bb04bda3 100644 --- a/testsuite/tests/module/mod2.stderr +++ b/testsuite/tests/module/mod2.stderr @@ -1,4 +1,4 @@ -mod2.hs:3:1: error: - Could not find module ‘N’ +mod2.hs:3:1: error: [GHC-87110] + Could not find module ‘N’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/T4806.stderr b/testsuite/tests/package/T4806.stderr index 99bde2ec0d..786715548f 100644 --- a/testsuite/tests/package/T4806.stderr +++ b/testsuite/tests/package/T4806.stderr @@ -1,6 +1,6 @@ -T4806.hs:1:1: error: - Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.0.1’ +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. diff --git a/testsuite/tests/package/T4806a.stderr b/testsuite/tests/package/T4806a.stderr index fe98798453..b1cc036bbf 100644 --- a/testsuite/tests/package/T4806a.stderr +++ b/testsuite/tests/package/T4806a.stderr @@ -1,7 +1,7 @@ -T4806a.hs:1:1: error: - Could not load module ‘Data.Map’ - It is a member of the package ‘containers-0.6.6’ +T4806a.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 unusable because the -ignore-package flag was used to ignore at least one of its dependencies: - deepseq-1.4.8.0 template-haskell-2.20.0.0 + 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. diff --git a/testsuite/tests/package/package01e.stderr b/testsuite/tests/package/package01e.stderr index 3381a1bd42..623f8346a5 100644 --- a/testsuite/tests/package/package01e.stderr +++ b/testsuite/tests/package/package01e.stderr @@ -1,14 +1,14 @@ -package01e.hs:2:1: error: - Could not load module ‘Data.Map’ - It is a member of the hidden package ‘containers-0.6.0.1’. +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. -package01e.hs:3:1: error: - Could not load module ‘Data.IntMap’ - It is a member of the hidden package ‘containers-0.6.0.1’. +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. diff --git a/testsuite/tests/package/package06e.stderr b/testsuite/tests/package/package06e.stderr index 16b03b49d2..73c45713cc 100644 --- a/testsuite/tests/package/package06e.stderr +++ b/testsuite/tests/package/package06e.stderr @@ -1,14 +1,14 @@ -package06e.hs:2:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-8.7’. +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. -package06e.hs:3:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-8.7’. +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. diff --git a/testsuite/tests/package/package07e.stderr b/testsuite/tests/package/package07e.stderr index 7762072014..f0fe055ff7 100644 --- a/testsuite/tests/package/package07e.stderr +++ b/testsuite/tests/package/package07e.stderr @@ -1,29 +1,29 @@ -package07e.hs:2:1: error: - Could not find module ‘GHC.Hs.MyTypes’ +package07e.hs:2:1: error: [GHC-61948] + Could not find module ‘GHC.Hs.MyTypes’. Perhaps you meant - GHC.Hs.Type (needs flag -package-id ghc-9.3) - GHC.Tc.Types (needs flag -package-id ghc-9.3) - GHC.Hs.Syn.Type (needs flag -package-id ghc-9.3) + 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. -package07e.hs:3:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-9.3’. +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. -package07e.hs:4:1: error: - Could not load module ‘GHC.Hs.Utils’ - It is a member of the hidden package ‘ghc-9.3’. +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. -package07e.hs:5:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-9.3’. +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. diff --git a/testsuite/tests/package/package08e.stderr b/testsuite/tests/package/package08e.stderr index 5d0867c908..3c9d05df20 100644 --- a/testsuite/tests/package/package08e.stderr +++ b/testsuite/tests/package/package08e.stderr @@ -1,29 +1,29 @@ -package08e.hs:2:1: error: - Could not find module ‘GHC.Hs.MyTypes’ +package08e.hs:2:1: error: [GHC-61948] + Could not find module ‘GHC.Hs.MyTypes’. Perhaps you meant - GHC.Hs.Type (needs flag -package-id ghc-9.3) - GHC.Tc.Types (needs flag -package-id ghc-9.3) - GHC.Hs.Syn.Type (needs flag -package-id ghc-9.3) + 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. -package08e.hs:3:1: error: - Could not load module ‘GHC.Hs.Type’ - It is a member of the hidden package ‘ghc-9.3’. +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. -package08e.hs:4:1: error: - Could not load module ‘GHC.Hs.Utils’ - It is a member of the hidden package ‘ghc-9.3’. +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. -package08e.hs:5:1: error: - Could not load module ‘GHC.Types.Unique.FM’ - It is a member of the hidden package ‘ghc-9.3’. +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. diff --git a/testsuite/tests/package/package09e.stderr b/testsuite/tests/package/package09e.stderr index 3ce28df519..555835da5c 100644 --- a/testsuite/tests/package/package09e.stderr +++ b/testsuite/tests/package/package09e.stderr @@ -1,5 +1,5 @@ -package09e.hs:2:1: error: - Ambiguous module name ‘M’: - it is bound as Data.Set by a package flag - it is bound as Data.Map by a package flag +package09e.hs:2:1: error: [GHC-45102] + Ambiguous module name ‘M’. + it is bound as Data.Set by a package flag + it is bound as Data.Map by a package flag diff --git a/testsuite/tests/perf/compiler/parsing001.stderr b/testsuite/tests/perf/compiler/parsing001.stderr index 8293a1acd1..79b2645259 100644 --- a/testsuite/tests/perf/compiler/parsing001.stderr +++ b/testsuite/tests/perf/compiler/parsing001.stderr @@ -1,4 +1,4 @@ -parsing001.hs:3:1: error: - Could not find module ‘Wibble’ +parsing001.hs:3:1: error: [GHC-87110] + Could not find module ‘Wibble’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/plugins/T11244.stderr b/testsuite/tests/plugins/T11244.stderr index 72f01060db..5701d9d342 100644 --- a/testsuite/tests/plugins/T11244.stderr +++ b/testsuite/tests/plugins/T11244.stderr @@ -1,4 +1,4 @@ -<command line>: Could not load module ‘RuleDefiningPlugin’ +<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.) diff --git a/testsuite/tests/plugins/plugins03.stderr b/testsuite/tests/plugins/plugins03.stderr index a923550592..d964311ba6 100644 --- a/testsuite/tests/plugins/plugins03.stderr +++ b/testsuite/tests/plugins/plugins03.stderr @@ -1,2 +1,2 @@ -<command line>: Could not find module ‘Simple.NonExistentPlugin’ +<command line>: Could not find module ‘Simple.NonExistentPlugin’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr index acfb8de460..7d26176149 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr @@ -2,6 +2,6 @@ SafeLang07.hs:2:14: warning: -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving -SafeLang07.hs:15:1: error: - Could not find module ‘SafeLang07_A’ +SafeLang07.hs:15:1: error: [GHC-87110] + Could not find module ‘SafeLang07_A’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr index 4a06b1d775..cd60385c58 100644 --- a/testsuite/tests/th/T10279.stderr +++ b/testsuite/tests/th/T10279.stderr @@ -1,6 +1,6 @@ -T10279.hs:10:9: error: [GHC-52243] - • Failed to load interface for ‘A’ +T10279.hs:10:9: error: [GHC-51294] + • Failed to load interface for ‘A’. no unit id matching ‘rts-1.0.2’ was found (This unit ID looks like the source package ID; the real unit ID is ‘rts’) diff --git a/testsuite/tests/typecheck/should_fail/tcfail082.stderr b/testsuite/tests/typecheck/should_fail/tcfail082.stderr index 31317b2c42..f72d4e04c4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail082.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail082.stderr @@ -1,12 +1,12 @@ -tcfail082.hs:2:1: error: - Could not find module ‘Data82’ +tcfail082.hs:2:1: error: [GHC-87110] + Could not find module ‘Data82’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. -tcfail082.hs:3:1: error: - Could not find module ‘Inst82_1’ +tcfail082.hs:3:1: error: [GHC-87110] + Could not find module ‘Inst82_1’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. -tcfail082.hs:4:1: error: - Could not find module ‘Inst82_2’ +tcfail082.hs:4:1: error: [GHC-87110] + Could not find module ‘Inst82_2’. Use -v (or `:set -v` in ghci) to see a list of the files searched for. |