Commit 6e8e2e08 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli Committed by Marge Bot

Move Iface.Load errors into Iface.Errors module

This commit moves the error-related functions in `GHC.Iface.Load` into
a brand new module called `GHC.Iface.Errors`. This will avoid boot files
and circular dependencies in the context of #18516, in the
pretty-printing modules.
parent a3cc9a29
Pipeline #34175 failed with stages
in 10 minutes and 57 seconds
{-# LANGUAGE FlexibleContexts #-}
module GHC.Iface.Errors
( badIfaceFile
, hiModuleNameMismatchWarn
, homeModError
, cannotFindInterface
, cantFindInstalledErr
, cannotFindModule
, cantFindErr
-- * Utility functions
, mayShowLocations
) where
import GHC.Platform.Profile
import GHC.Platform.Ways
import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Driver.Session
import GHC.Driver.Env.Types
import GHC.Data.Maybe
import GHC.Prelude
import GHC.Unit
import GHC.Unit.Env
import GHC.Unit.Finder.Types
import GHC.Unit.State
import GHC.Utils.Outputable as Outputable
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 PrintUnqualified 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 -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
(sLit "Ambiguous interface for")
cantFindInstalledErr
:: PtrString
-> PtrString
-> UnitState
-> HomeUnit
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
= ptext cannot_find <+> quotes (ppr 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
InstalledNotFound files mb_pkg
| Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
-> not_found_in_package pkg files
| null files
-> text "It is not a module in the current program, or in any known package."
| otherwise
-> tried_these 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
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
tried_these 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 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) $
cantFindErr (gopt Opt_BuildingCabalPackage dflags)
(sLit cannotFindMsg)
(sLit "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)
-> "Could not load module"
_ -> "Could not find module"
cantFindErr
:: Bool -- ^ Using Cabal?
-> PtrString
-> PtrString
-> UnitEnv
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods)
| Just pkgs <- unambiguousPackages
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
sep [text "it was found in multiple packages:",
hsep (map ppr pkgs) ]
)
| otherwise
= hang (ptext 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
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
= ptext cannot_find <+> quotes (ppr mod_name)
$$ more_info
where
mhome_unit = ue_home_unit unit_env
more_info
= case find_result of
NoPackage pkg
-> text "no unit id matching" <+> quotes (ppr pkg) <+>
text "was found"
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
| 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 (null suggest)
-> pp_suggestions suggest $$ tried_these 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."
| otherwise
-> vcat (map pkg_hidden pkg_hiddens) $$
vcat (map mod_hidden mod_hiddens) $$
vcat (map unusable unusables) $$
tried_these files
_ -> panic "cantFindErr"
build_tag = waysBuildTag (profileWays profile)
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
| 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
= 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
......@@ -32,14 +32,12 @@ module GHC.Iface.Load (
pprModIfaceSimple,
ifaceStats, pprModIface, showIface,
cannotFindModule
module Iface_Errors -- avoids boot files in Ppr modules
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform.Ways
import GHC.Platform.Profile
import {-# SOURCE #-} GHC.IfaceToCore
( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
......@@ -57,6 +55,7 @@ import GHC.Iface.Ext.Fields
import GHC.Iface.Binary
import GHC.Iface.Rename
import GHC.Iface.Env
import GHC.Iface.Errors as Iface_Errors
import GHC.Tc.Utils.Monad
......@@ -105,13 +104,12 @@ import GHC.Unit.State
import GHC.Unit.Home
import GHC.Unit.Home.ModInfo
import GHC.Unit.Finder
import GHC.Unit.Env
import GHC.Unit.Env ( ue_hpt )
import GHC.Data.Maybe
import GHC.Data.FastString
import Control.Monad
import Control.Exception
import Data.Map ( toList )
import System.FilePath
import System.Directory
......@@ -709,7 +707,7 @@ computeInterface hsc_env doc_str hi_boot_file mod0 = do
Succeeded (iface0, path) ->
rnModIface hsc_env (instUnitInsts (moduleUnit indef)) Nothing iface0 >>= \case
Right x -> return (Succeeded (x, path))
Left errs -> throwIO . mkSrcErr $ errs
Left errs -> throwErrors errs
Failed err -> return (Failed err)
(mod, _) -> find_iface mod
......@@ -909,7 +907,7 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
unit_state
home_unit
profile
(may_show_locations dflags)
(Iface_Errors.mayShowLocations dflags)
(moduleName mod)
err
......@@ -1227,316 +1225,3 @@ pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs
where
pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes"
{-
*********************************************************
* *
\subsection{Errors}
* *
*********************************************************
-}
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 PrintUnqualified 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 -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
(sLit "Ambiguous interface for")
cantFindInstalledErr
:: PtrString
-> PtrString
-> UnitState
-> HomeUnit
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> InstalledFindResult
-> SDoc
cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
= ptext cannot_find <+> quotes (ppr 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
InstalledNotFound files mb_pkg
| Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
-> not_found_in_package pkg files
| null files
-> text "It is not a module in the current program, or in any known package."
| otherwise
-> tried_these 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
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
tried_these files
may_show_locations :: DynFlags -> [FilePath] -> SDoc
may_show_locations 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 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) $
cantFindErr (gopt Opt_BuildingCabalPackage dflags)
(sLit cannotFindMsg)
(sLit "Ambiguous module name")
unit_env
profile
(may_show_locations 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)
-> "Could not load module"
_ -> "Could not find module"
cantFindErr
:: Bool -- ^ Using Cabal?
-> PtrString
-> PtrString
-> UnitEnv
-> Profile
-> ([FilePath] -> SDoc)
-> ModuleName
-> FindResult
-> SDoc
cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods)
| Just pkgs <- unambiguousPackages
= hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
sep [text "it was found in multiple packages:",
hsep (map ppr pkgs) ]
)
| otherwise
= hang (ptext 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
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
= ptext cannot_find <+> quotes (ppr mod_name)
$$ more_info
where
mhome_unit = ue_home_unit unit_env
more_info
= case find_result of
NoPackage pkg
-> text "no unit id matching" <+> quotes (ppr pkg) <+>
text "was found"
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
| 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 (null suggest