summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-04-06 10:33:40 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-08 08:08:20 -0400
commit6e8e2e0887f12725977feb2a0535f7679e86700f (patch)
tree194fa3b2ce8269242ac01ccd63ace3c7a06721ad /compiler
parenta3cc9a295e92c05af208623765e04e2d50925e37 (diff)
downloadhaskell-6e8e2e0887f12725977feb2a0535f7679e86700f.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Iface/Errors.hs335
-rw-r--r--compiler/GHC/Iface/Load.hs325
-rw-r--r--compiler/ghc.cabal.in1
3 files changed, 341 insertions, 320 deletions
diff --git a/compiler/GHC/Iface/Errors.hs b/compiler/GHC/Iface/Errors.hs
new file mode 100644
index 0000000000..6cfa09f99d
--- /dev/null
+++ b/compiler/GHC/Iface/Errors.hs
@@ -0,0 +1,335 @@
+
+{-# 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
+
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index d2d3e858e9..b52498129f 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -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)
- -> 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
-
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 29137a146f..4178b9d0f6 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -438,6 +438,7 @@ Library
GHC.Hs.Utils
GHC.Iface.Binary
GHC.Iface.Env
+ GHC.Iface.Errors
GHC.Iface.Ext.Ast
GHC.Iface.Ext.Binary
GHC.Iface.Ext.Debug