summaryrefslogtreecommitdiff
path: root/compiler/main/Finder.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/main/Finder.hs')
-rw-r--r--compiler/main/Finder.hs97
1 files changed, 68 insertions, 29 deletions
diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index d1bf1c8073..9a3cb6009b 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -33,6 +33,8 @@ module Finder (
#include "HsVersions.h"
+import GhcPrelude
+
import Module
import HscTypes
import Packages
@@ -150,15 +152,17 @@ orIfNotFound this or_this = do
res <- this
case res of
NotFound { fr_paths = paths1, fr_mods_hidden = mh1
- , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
+ , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 }
-> do res2 <- or_this
case res2 of
NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
- , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
+ , fr_pkgs_hidden = ph2, fr_unusables = u2
+ , fr_suggestions = s2 }
-> return (NotFound { fr_paths = paths1 ++ paths2
, fr_pkg = mb_pkg2 -- snd arg is the package search
, fr_mods_hidden = mh1 ++ mh2
, fr_pkgs_hidden = ph1 ++ ph2
+ , fr_unusables = u1 ++ u2
, fr_suggestions = s1 ++ s2 })
_other -> return res2
_other -> return res
@@ -203,6 +207,7 @@ findLookupResult hsc_env r = case r of
InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnitId m)
, fr_pkgs_hidden = []
, fr_mods_hidden = []
+ , fr_unusables = []
, fr_suggestions = []})
LookupMultiple rs ->
return (FoundMultiple rs)
@@ -210,11 +215,23 @@ findLookupResult hsc_env r = case r of
return (NotFound{ fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = map (moduleUnitId.fst) pkg_hiddens
, fr_mods_hidden = map (moduleUnitId.fst) mod_hiddens
+ , fr_unusables = []
, fr_suggestions = [] })
+ LookupUnusable unusable ->
+ let unusables' = map get_unusable unusable
+ get_unusable (m, ModUnusable r) = (moduleUnitId m, r)
+ get_unusable (_, r) =
+ pprPanic "findLookupResult: unexpected origin" (ppr r)
+ in return (NotFound{ fr_paths = [], fr_pkg = Nothing
+ , fr_pkgs_hidden = []
+ , fr_mods_hidden = []
+ , fr_unusables = unusables'
+ , fr_suggestions = [] })
LookupNotFound suggest ->
return (NotFound{ fr_paths = [], fr_pkg = Nothing
, fr_pkgs_hidden = []
, fr_mods_hidden = []
+ , fr_unusables = []
, fr_suggestions = suggest })
modLocationCache :: HscEnv -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
@@ -258,6 +275,7 @@ findHomeModule hsc_env mod_name = do
fr_pkg = Just uid,
fr_mods_hidden = [],
fr_pkgs_hidden = [],
+ fr_unusables = [],
fr_suggestions = []
}
where
@@ -568,8 +586,19 @@ findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
-- Error messages
cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
-cannotFindModule = cantFindErr (sLit "Could not find module")
- (sLit "Ambiguous module name")
+cannotFindModule flags mod res =
+ cantFindErr (sLit cannotFindMsg)
+ (sLit "Ambiguous module name")
+ flags 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"
cannotFindInterface :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
@@ -596,6 +625,7 @@ cantFindErr _ multiple_found _ mod_name (FoundMultiple 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 (moduleUnitId m)]
@@ -617,20 +647,22 @@ cantFindErr cannot_find _ dflags mod_name find_result
NotFound { fr_paths = files, fr_pkg = mb_pkg
, fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
- , fr_suggestions = suggest }
+ , fr_unusables = unusables, fr_suggestions = suggest }
| Just pkg <- mb_pkg, pkg /= thisPackage dflags
-> not_found_in_package pkg files
| not (null suggest)
- -> pp_suggestions suggest $$ tried_these files
+ -> pp_suggestions suggest $$ tried_these files dflags
- | null files && null mod_hiddens && null pkg_hiddens
+ | 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) $$
- tried_these files
+ vcat (map unusable unusables) $$
+ tried_these files dflags
_ -> panic "cantFindErr"
@@ -644,20 +676,13 @@ cantFindErr cannot_find _ dflags mod_name find_result
in
text "Perhaps you haven't installed the " <> text build <>
text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
- tried_these files
+ tried_these files dflags
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
- tried_these files
-
- tried_these files
- | null files = Outputable.empty
- | verbosity dflags < 3 =
- text "Use -v to see a list of the files searched for."
- | otherwise =
- hang (text "Locations searched:") 2 $ vcat (map text files)
+ tried_these files dflags
pkg_hidden :: UnitId -> SDoc
pkg_hidden pkgid =
@@ -665,18 +690,28 @@ cantFindErr cannot_find _ dflags mod_name find_result
<+> quotes (ppr pkgid)
--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 $$ cabal_pkg_hidden_hint pkgid
- cabal_pkg_hidden_hint pkgid
+ <> dot $$ pkg_hidden_hint pkgid
+ pkg_hidden_hint pkgid
| gopt Opt_BuildingCabalPackage dflags
= let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
in text "Perhaps you need to add" <+>
quotes (ppr (packageName pkg)) <+>
text "to the build-depends in your .cabal file."
+ | Just pkg <- lookupPackage dflags pkgid
+ = text "You can run" <+>
+ quotes (text ":set -package " <> ppr (packageName 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
@@ -688,6 +723,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
-- 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{ fromOrigPackage = e,
fromExposedReexport = res,
fromPackageFlag = f })
@@ -704,6 +740,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
| otherwise = Outputable.empty
pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
where provenance ModHidden = Outputable.empty
+ provenance (ModUnusable _) = Outputable.empty
provenance (ModOrigin{ fromOrigPackage = e,
fromHiddenReexport = rhs })
| Just False <- e
@@ -734,7 +771,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
-> text "It is not a module in the current program, or in any known package."
| otherwise
- -> tried_these files
+ -> tried_these files dflags
_ -> panic "cantFindInstalledErr"
@@ -760,17 +797,19 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
in
text "Perhaps you haven't installed the " <> text build <>
text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
- tried_these files
+ tried_these files dflags
| otherwise
= text "There are files missing in the " <> quotes (ppr pkg) <>
text " package," $$
text "try running 'ghc-pkg check'." $$
- tried_these files
-
- tried_these files
- | null files = Outputable.empty
- | verbosity dflags < 3 =
- text "Use -v to see a list of the files searched for."
- | otherwise =
- hang (text "Locations searched:") 2 $ vcat (map text files)
+ tried_these files dflags
+
+tried_these :: [FilePath] -> DynFlags -> SDoc
+tried_these files dflags
+ | 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)