b5ad08b425db712a45aedd46508ba41461961226
[ghc.git] / compiler / main / Finder.lhs
1 %
2 % (c) The University of Glasgow, 2000-2006
3 %
4 \section[Finder]{Module Finder}
5
6 \begin{code}
7 {-# LANGUAGE CPP #-}
8
9 module Finder (
10     flushFinderCaches,
11     FindResult(..),
12     findImportedModule,
13     findExactModule,
14     findHomeModule,
15     findExposedPackageModule,
16     mkHomeModLocation,
17     mkHomeModLocation2,
18     mkHiOnlyModLocation,
19     addHomeModuleToFinder,
20     uncacheModule,
21     mkStubPaths,
22
23     findObjectLinkableMaybe,
24     findObjectLinkable,
25
26     cannotFindModule,
27     cannotFindInterface,
28
29   ) where
30
31 #include "HsVersions.h"
32
33 import Module
34 import HscTypes
35 import Packages
36 import FastString
37 import Util
38 import PrelNames        ( gHC_PRIM )
39 import DynFlags
40 import Outputable
41 import UniqFM
42 import Maybes           ( expectJust )
43 import Exception        ( evaluate )
44
45 import Data.IORef       ( IORef, writeIORef, readIORef, atomicModifyIORef )
46 import System.Directory
47 import System.FilePath
48 import Control.Monad
49 import Data.Time
50 import Data.List        ( foldl' )
51
52
53 type FileExt = String   -- Filename extension
54 type BaseName = String  -- Basename of file
55
56 -- -----------------------------------------------------------------------------
57 -- The Finder
58
59 -- The Finder provides a thin filesystem abstraction to the rest of
60 -- the compiler.  For a given module, it can tell you where the
61 -- source, interface, and object files for that module live.
62
63 -- It does *not* know which particular package a module lives in.  Use
64 -- Packages.lookupModuleInAllPackages for that.
65
66 -- -----------------------------------------------------------------------------
67 -- The finder's cache
68
69 -- remove all the home modules from the cache; package modules are
70 -- assumed to not move around during a session.
71 flushFinderCaches :: HscEnv -> IO ()
72 flushFinderCaches hsc_env = do
73   -- Ideally the update to both caches be a single atomic operation.
74   writeIORef fc_ref emptyUFM
75   flushModLocationCache this_pkg mlc_ref
76  where
77         this_pkg = thisPackage (hsc_dflags hsc_env)
78         fc_ref = hsc_FC hsc_env
79         mlc_ref = hsc_MLC hsc_env
80
81 flushModLocationCache :: PackageKey -> IORef ModLocationCache -> IO ()
82 flushModLocationCache this_pkg ref = do
83   atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
84   _ <- evaluate =<< readIORef ref
85   return ()
86   where is_ext mod _ | modulePackageKey mod /= this_pkg = True
87                      | otherwise = False
88
89 addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
90 addToFinderCache ref key val =
91   atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
92
93 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
94 addToModLocationCache ref key val =
95   atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
96
97 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
98 removeFromFinderCache ref key =
99   atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
100
101 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
102 removeFromModLocationCache ref key =
103   atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
104
105 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
106 lookupFinderCache ref key = do
107    c <- readIORef ref
108    return $! lookupUFM c key
109
110 lookupModLocationCache :: IORef ModLocationCache -> Module
111                        -> IO (Maybe ModLocation)
112 lookupModLocationCache ref key = do
113    c <- readIORef ref
114    return $! lookupModuleEnv c key
115
116 -- -----------------------------------------------------------------------------
117 -- The two external entry points
118
119 -- | Locate a module that was imported by the user.  We have the
120 -- module's name, and possibly a package name.  Without a package
121 -- name, this function will use the search path and the known exposed
122 -- packages to find the module, if a package is specified then only
123 -- that package is searched for the module.
124
125 findImportedModule :: HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
126 findImportedModule hsc_env mod_name mb_pkg =
127   case mb_pkg of
128         Nothing                        -> unqual_import
129         Just pkg | pkg == fsLit "this" -> home_import -- "this" is special
130                  | otherwise           -> pkg_import
131   where
132     home_import   = findHomeModule hsc_env mod_name
133
134     pkg_import    = findExposedPackageModule hsc_env mod_name mb_pkg
135
136     unqual_import = home_import
137                     `orIfNotFound`
138                     findExposedPackageModule hsc_env mod_name Nothing
139
140 -- | Locate a specific 'Module'.  The purpose of this function is to
141 -- create a 'ModLocation' for a given 'Module', that is to find out
142 -- where the files associated with this module live.  It is used when
143 -- reading the interface for a module mentioned by another interface,
144 -- for example (a "system import").
145
146 findExactModule :: HscEnv -> Module -> IO FindResult
147 findExactModule hsc_env mod =
148     let dflags = hsc_dflags hsc_env
149     in if modulePackageKey mod == thisPackage dflags
150        then findHomeModule hsc_env (moduleName mod)
151        else findPackageModule hsc_env mod
152
153 -- -----------------------------------------------------------------------------
154 -- Helpers
155
156 orIfNotFound :: IO FindResult -> IO FindResult -> IO FindResult
157 orIfNotFound this or_this = do
158   res <- this
159   case res of
160     NotFound { fr_paths = paths1, fr_mods_hidden = mh1
161              , fr_pkgs_hidden = ph1, fr_suggestions = s1 }
162      -> do res2 <- or_this
163            case res2 of
164              NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2
165                       , fr_pkgs_hidden = ph2, fr_suggestions = s2 }
166               -> return (NotFound { fr_paths = paths1 ++ paths2
167                                   , fr_pkg = mb_pkg2 -- snd arg is the package search
168                                   , fr_mods_hidden = mh1 ++ mh2
169                                   , fr_pkgs_hidden = ph1 ++ ph2
170                                   , fr_suggestions = s1  ++ s2 })
171              _other -> return res2
172     _other -> return res
173
174
175 homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
176 homeSearchCache hsc_env mod_name do_this = do
177   m <- lookupFinderCache (hsc_FC hsc_env) mod_name
178   case m of
179     Just result -> return result
180     Nothing     -> do
181         result <- do_this
182         addToFinderCache (hsc_FC hsc_env) mod_name result
183         case result of
184            Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
185            _other        -> return ()
186         return result
187
188 findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
189                          -> IO FindResult
190 findExposedPackageModule hsc_env mod_name mb_pkg
191   = case lookupModuleWithSuggestions (hsc_dflags hsc_env) mod_name mb_pkg of
192      LookupFound m pkg_conf ->
193        findPackageModule_ hsc_env m pkg_conf
194      LookupMultiple rs ->
195        return (FoundMultiple rs)
196      LookupHidden pkg_hiddens mod_hiddens ->
197        return (NotFound{ fr_paths = [], fr_pkg = Nothing
198                        , fr_pkgs_hidden = map (modulePackageKey.fst) pkg_hiddens
199                        , fr_mods_hidden = map (modulePackageKey.fst) mod_hiddens
200                        , fr_suggestions = [] })
201      LookupNotFound suggest ->
202        return (NotFound{ fr_paths = [], fr_pkg = Nothing
203                        , fr_pkgs_hidden = []
204                        , fr_mods_hidden = []
205                        , fr_suggestions = suggest })
206
207 modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
208 modLocationCache hsc_env mod do_this = do
209   mb_loc <- lookupModLocationCache mlc mod
210   case mb_loc of
211      Just loc -> return (Found loc mod)
212      Nothing  -> do
213         result <- do_this
214         case result of
215             Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
216             _other -> return ()
217         return result
218   where
219     mlc = hsc_MLC hsc_env
220
221 addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
222 addHomeModuleToFinder hsc_env mod_name loc = do
223   let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
224   addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
225   addToModLocationCache (hsc_MLC hsc_env) mod loc
226   return mod
227
228 uncacheModule :: HscEnv -> ModuleName -> IO ()
229 uncacheModule hsc_env mod = do
230   let this_pkg = thisPackage (hsc_dflags hsc_env)
231   removeFromFinderCache (hsc_FC hsc_env) mod
232   removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
233
234 -- -----------------------------------------------------------------------------
235 --      The internal workers
236
237 -- | Search for a module in the home package only.
238 findHomeModule :: HscEnv -> ModuleName -> IO FindResult
239 findHomeModule hsc_env mod_name =
240    homeSearchCache hsc_env mod_name $
241    let 
242      dflags = hsc_dflags hsc_env
243      home_path = importPaths dflags
244      hisuf = hiSuf dflags
245      mod = mkModule (thisPackage dflags) mod_name
246
247      source_exts =
248       [ ("hs",   mkHomeModLocationSearched dflags mod_name "hs")
249       , ("lhs",  mkHomeModLocationSearched dflags mod_name "lhs")
250       ]
251
252      hi_exts = [ (hisuf,                mkHiOnlyModLocation dflags hisuf)
253                , (addBootSuffix hisuf,  mkHiOnlyModLocation dflags hisuf)
254                ]
255
256         -- In compilation manager modes, we look for source files in the home
257         -- package because we can compile these automatically.  In one-shot
258         -- compilation mode we look for .hi and .hi-boot files only.
259      exts | isOneShot (ghcMode dflags) = hi_exts
260           | otherwise                  = source_exts
261    in
262
263   -- special case for GHC.Prim; we won't find it in the filesystem.
264   -- This is important only when compiling the base package (where GHC.Prim
265   -- is a home module).
266   if mod == gHC_PRIM
267         then return (Found (error "GHC.Prim ModLocation") mod)
268         else searchPathExts home_path mod exts
269
270
271 -- | Search for a module in external packages only.
272 findPackageModule :: HscEnv -> Module -> IO FindResult
273 findPackageModule hsc_env mod = do
274   let
275         dflags = hsc_dflags hsc_env
276         pkg_id = modulePackageKey mod
277   --
278   case lookupPackage dflags pkg_id of
279      Nothing -> return (NoPackage pkg_id)
280      Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
281
282 -- | Look up the interface file associated with module @mod@.  This function
283 -- requires a few invariants to be upheld: (1) the 'Module' in question must
284 -- be the module identifier of the *original* implementation of a module,
285 -- not a reexport (this invariant is upheld by @Packages.lhs@) and (2)
286 -- the 'PackageConfig' must be consistent with the package key in the 'Module'.
287 -- The redundancy is to avoid an extra lookup in the package state
288 -- for the appropriate config.
289 findPackageModule_ :: HscEnv -> Module -> PackageConfig -> IO FindResult
290 findPackageModule_ hsc_env mod pkg_conf =
291   ASSERT( modulePackageKey mod == packageConfigId pkg_conf )
292   modLocationCache hsc_env mod $
293
294   -- special case for GHC.Prim; we won't find it in the filesystem.
295   if mod == gHC_PRIM
296         then return (Found (error "GHC.Prim ModLocation") mod)
297         else
298
299   let
300      dflags = hsc_dflags hsc_env
301      tag = buildTag dflags
302
303            -- hi-suffix for packages depends on the build tag.
304      package_hisuf | null tag  = "hi"
305                    | otherwise = tag ++ "_hi"
306
307      mk_hi_loc = mkHiOnlyModLocation dflags package_hisuf
308
309      import_dirs = importDirs pkg_conf
310       -- we never look for a .hi-boot file in an external package;
311       -- .hi-boot files only make sense for the home package.
312   in
313   case import_dirs of
314     [one] | MkDepend <- ghcMode dflags -> do
315           -- there's only one place that this .hi file can be, so
316           -- don't bother looking for it.
317           let basename = moduleNameSlashes (moduleName mod)
318           loc <- mk_hi_loc one basename
319           return (Found loc mod)
320     _otherwise ->
321           searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
322
323 -- -----------------------------------------------------------------------------
324 -- General path searching
325
326 searchPathExts
327   :: [FilePath]         -- paths to search
328   -> Module             -- module name
329   -> [ (
330         FileExt,                                -- suffix
331         FilePath -> BaseName -> IO ModLocation  -- action
332        )
333      ]
334   -> IO FindResult
335
336 searchPathExts paths mod exts
337    = do result <- search to_search
338 {-
339         hPutStrLn stderr (showSDoc $
340                 vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
341                     , nest 2 (vcat (map text paths))
342                     , case result of
343                         Succeeded (loc, p) -> text "Found" <+> ppr loc
344                         Failed fs          -> text "not found"])
345 -}
346         return result
347
348   where
349     basename = moduleNameSlashes (moduleName mod)
350
351     to_search :: [(FilePath, IO ModLocation)]
352     to_search = [ (file, fn path basename)
353                 | path <- paths,
354                   (ext,fn) <- exts,
355                   let base | path == "." = basename
356                            | otherwise   = path </> basename
357                       file = base <.> ext
358                 ]
359
360     search [] = return (NotFound { fr_paths = map fst to_search
361                                  , fr_pkg   = Just (modulePackageKey mod)
362                                  , fr_mods_hidden = [], fr_pkgs_hidden = []
363                                  , fr_suggestions = [] })
364
365     search ((file, mk_result) : rest) = do
366       b <- doesFileExist file
367       if b
368         then do { loc <- mk_result; return (Found loc mod) }
369         else search rest
370
371 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
372                           -> FilePath -> BaseName -> IO ModLocation
373 mkHomeModLocationSearched dflags mod suff path basename = do
374    mkHomeModLocation2 dflags mod (path </> basename) suff
375
376 -- -----------------------------------------------------------------------------
377 -- Constructing a home module location
378
379 -- This is where we construct the ModLocation for a module in the home
380 -- package, for which we have a source file.  It is called from three
381 -- places:
382 --
383 --  (a) Here in the finder, when we are searching for a module to import,
384 --      using the search path (-i option).
385 --
386 --  (b) The compilation manager, when constructing the ModLocation for
387 --      a "root" module (a source file named explicitly on the command line
388 --      or in a :load command in GHCi).
389 --
390 --  (c) The driver in one-shot mode, when we need to construct a
391 --      ModLocation for a source file named on the command-line.
392 --
393 -- Parameters are:
394 --
395 -- mod
396 --      The name of the module
397 --
398 -- path
399 --      (a): The search path component where the source file was found.
400 --      (b) and (c): "."
401 --
402 -- src_basename
403 --      (a): (moduleNameSlashes mod)
404 --      (b) and (c): The filename of the source file, minus its extension
405 --
406 -- ext
407 --      The filename extension of the source file (usually "hs" or "lhs").
408
409 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
410 mkHomeModLocation dflags mod src_filename = do
411    let (basename,extension) = splitExtension src_filename
412    mkHomeModLocation2 dflags mod basename extension
413
414 mkHomeModLocation2 :: DynFlags
415                    -> ModuleName
416                    -> FilePath  -- Of source module, without suffix
417                    -> String    -- Suffix
418                    -> IO ModLocation
419 mkHomeModLocation2 dflags mod src_basename ext = do
420    let mod_basename = moduleNameSlashes mod
421
422        obj_fn = mkObjPath  dflags src_basename mod_basename
423        hi_fn  = mkHiPath   dflags src_basename mod_basename
424
425    return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
426                         ml_hi_file   = hi_fn,
427                         ml_obj_file  = obj_fn })
428
429 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
430                     -> IO ModLocation
431 mkHiOnlyModLocation dflags hisuf path basename
432  = do let full_basename = path </> basename
433           obj_fn = mkObjPath  dflags full_basename basename
434       return ModLocation{    ml_hs_file   = Nothing,
435                              ml_hi_file   = full_basename <.> hisuf,
436                                 -- Remove the .hi-boot suffix from
437                                 -- hi_file, if it had one.  We always
438                                 -- want the name of the real .hi file
439                                 -- in the ml_hi_file field.
440                              ml_obj_file  = obj_fn
441                   }
442
443 -- | Constructs the filename of a .o file for a given source file.
444 -- Does /not/ check whether the .o file exists
445 mkObjPath
446   :: DynFlags
447   -> FilePath           -- the filename of the source file, minus the extension
448   -> String             -- the module name with dots replaced by slashes
449   -> FilePath
450 mkObjPath dflags basename mod_basename = obj_basename <.> osuf
451   where
452                 odir = objectDir dflags
453                 osuf = objectSuf dflags
454
455                 obj_basename | Just dir <- odir = dir </> mod_basename
456                              | otherwise        = basename
457
458
459 -- | Constructs the filename of a .hi file for a given source file.
460 -- Does /not/ check whether the .hi file exists
461 mkHiPath
462   :: DynFlags
463   -> FilePath           -- the filename of the source file, minus the extension
464   -> String             -- the module name with dots replaced by slashes
465   -> FilePath
466 mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
467  where
468                 hidir = hiDir dflags
469                 hisuf = hiSuf dflags
470
471                 hi_basename | Just dir <- hidir = dir </> mod_basename
472                             | otherwise         = basename
473
474
475
476 -- -----------------------------------------------------------------------------
477 -- Filenames of the stub files
478
479 -- We don't have to store these in ModLocations, because they can be derived
480 -- from other available information, and they're only rarely needed.
481
482 mkStubPaths
483   :: DynFlags
484   -> ModuleName
485   -> ModLocation
486   -> FilePath
487
488 mkStubPaths dflags mod location
489   = let
490         stubdir = stubDir dflags
491
492         mod_basename = moduleNameSlashes mod
493         src_basename = dropExtension $ expectJust "mkStubPaths"
494                                                   (ml_hs_file location)
495
496         stub_basename0
497             | Just dir <- stubdir = dir </> mod_basename
498             | otherwise           = src_basename
499
500         stub_basename = stub_basename0 ++ "_stub"
501      in
502         stub_basename <.> "h"
503
504 -- -----------------------------------------------------------------------------
505 -- findLinkable isn't related to the other stuff in here,
506 -- but there's no other obvious place for it
507
508 findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
509 findObjectLinkableMaybe mod locn
510    = do let obj_fn = ml_obj_file locn
511         maybe_obj_time <- modificationTimeIfExists obj_fn
512         case maybe_obj_time of
513           Nothing -> return Nothing
514           Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
515
516 -- Make an object linkable when we know the object file exists, and we know
517 -- its modification time.
518 findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable
519 findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
520   -- We used to look for _stub.o files here, but that was a bug (#706)
521   -- Now GHC merges the stub.o into the main .o (#3687)
522
523 -- -----------------------------------------------------------------------------
524 -- Error messages
525
526 cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
527 cannotFindModule = cantFindErr (sLit "Could not find module")
528                                (sLit "Ambiguous module name")
529
530 cannotFindInterface  :: DynFlags -> ModuleName -> FindResult -> SDoc
531 cannotFindInterface = cantFindErr (sLit "Failed to load interface for")
532                                   (sLit "Ambiguous interface for")
533
534 cantFindErr :: LitString -> LitString -> DynFlags -> ModuleName -> FindResult
535             -> SDoc
536 cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
537   | Just pkgs <- unambiguousPackages
538   = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
539        sep [ptext (sLit "it was found in multiple packages:"),
540                 hsep (map ppr pkgs) ]
541     )
542   | otherwise
543   = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
544        vcat (map pprMod mods)
545     )
546   where
547     unambiguousPackages = foldl' unambiguousPackage (Just []) mods
548     unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
549         = Just (modulePackageKey m : xs)
550     unambiguousPackage _ _ = Nothing
551
552     pprMod (m, o) = ptext (sLit "it is bound as") <+> ppr m <+>
553                                 ptext (sLit "by") <+> pprOrigin m o
554     pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
555     pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
556       if e == Just True
557           then [ptext (sLit "package") <+> ppr (modulePackageKey m)]
558           else [] ++
559       map ((ptext (sLit "a reexport in package") <+>)
560                 .ppr.packageConfigId) res ++
561       if f then [ptext (sLit "a package flag")] else []
562       )
563
564 cantFindErr cannot_find _ dflags mod_name find_result
565   = ptext cannot_find <+> quotes (ppr mod_name)
566     $$ more_info
567   where
568     more_info
569       = case find_result of
570             NoPackage pkg
571                 -> ptext (sLit "no package matching") <+> quotes (ppr pkg) <+>
572                    ptext (sLit "was found")
573
574             NotFound { fr_paths = files, fr_pkg = mb_pkg
575                      , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
576                      , fr_suggestions = suggest }
577                 | Just pkg <- mb_pkg, pkg /= thisPackage dflags
578                 -> not_found_in_package pkg files
579
580                 | not (null suggest)
581                 -> pp_suggestions suggest $$ tried_these files
582
583                 | null files && null mod_hiddens && null pkg_hiddens
584                 -> ptext (sLit "It is not a module in the current program, or in any known package.")
585
586                 | otherwise
587                 -> vcat (map pkg_hidden pkg_hiddens) $$
588                    vcat (map mod_hidden mod_hiddens) $$
589                    tried_these files
590
591             _ -> panic "cantFindErr"
592
593     build_tag = buildTag dflags
594
595     not_found_in_package pkg files
596        | build_tag /= ""
597        = let
598             build = if build_tag == "p" then "profiling"
599                                         else "\"" ++ build_tag ++ "\""
600          in
601          ptext (sLit "Perhaps you haven't installed the ") <> text build <>
602          ptext (sLit " libraries for package ") <> quotes (ppr pkg) <> char '?' $$
603          tried_these files
604
605        | otherwise
606        = ptext (sLit "There are files missing in the ") <> quotes (ppr pkg) <>
607          ptext (sLit " package,") $$
608          ptext (sLit "try running 'ghc-pkg check'.") $$
609          tried_these files
610
611     tried_these files
612         | null files = empty
613         | verbosity dflags < 3 =
614               ptext (sLit "Use -v to see a list of the files searched for.")
615         | otherwise =
616                hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
617
618     pkg_hidden :: PackageKey -> SDoc
619     pkg_hidden pkgid =
620         ptext (sLit "It is a member of the hidden package")
621         <+> quotes (ppr pkgid)
622         --FIXME: we don't really want to show the package key here we should
623         -- show the source package id or installed package id if it's ambiguous
624         <> dot $$ cabal_pkg_hidden_hint pkgid
625     cabal_pkg_hidden_hint pkgid
626      | gopt Opt_BuildingCabalPackage dflags
627         = let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
628            in ptext (sLit "Perhaps you need to add") <+>
629               quotes (ppr (packageName pkg)) <+>
630               ptext (sLit "to the build-depends in your .cabal file.")
631      | otherwise = empty
632
633     mod_hidden pkg =
634         ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg)
635
636     pp_suggestions :: [ModuleSuggestion] -> SDoc
637     pp_suggestions sugs
638       | null sugs = empty
639       | otherwise = hang (ptext (sLit "Perhaps you meant"))
640                        2 (vcat (map pp_sugg sugs))
641
642     -- NB: Prefer the *original* location, and then reexports, and then
643     -- package flags when making suggestions.  ToDo: if the original package
644     -- also has a reexport, prefer that one
645     pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
646       where provenance ModHidden = empty
647             provenance (ModOrigin{ fromOrigPackage = e,
648                                    fromExposedReexport = res,
649                                    fromPackageFlag = f })
650               | Just True <- e
651                  = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
652               | f && moduleName mod == m
653                  = parens (ptext (sLit "from") <+> ppr (modulePackageKey mod))
654               | (pkg:_) <- res
655                  = parens (ptext (sLit "from") <+> ppr (packageConfigId pkg)
656                     <> comma <+> ptext (sLit "reexporting") <+> ppr mod)
657               | f
658                  = parens (ptext (sLit "defined via package flags to be")
659                     <+> ppr mod)
660               | otherwise = empty
661     pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
662       where provenance ModHidden =  empty
663             provenance (ModOrigin{ fromOrigPackage = e,
664                                    fromHiddenReexport = rhs })
665               | Just False <- e
666                  = parens (ptext (sLit "needs flag -package-key")
667                     <+> ppr (modulePackageKey mod))
668               | (pkg:_) <- rhs
669                  = parens (ptext (sLit "needs flag -package-key")
670                     <+> ppr (packageConfigId pkg))
671               | otherwise = empty
672 \end{code}