Package keys (for linking/type equality) separated from package IDs.
[ghc.git] / compiler / main / Packages.lhs
1 %
2 % (c) The University of Glasgow, 2006
3 %
4 \begin{code}
5 {-# LANGUAGE CPP #-}
6
7 -- | Package manipulation
8 module Packages (
9         module PackageConfig,
10
11         -- * The PackageConfigMap
12         PackageConfigMap, emptyPackageConfigMap, lookupPackage,
13         extendPackageConfigMap, dumpPackages, simpleDumpPackages,
14
15         -- * Reading the package config, and processing cmdline args
16         PackageState(..),
17         ModuleConf(..),
18         initPackages,
19         getPackageDetails,
20         lookupModuleInAllPackages, lookupModuleWithSuggestions,
21
22         -- * Inspecting the set of packages in scope
23         getPackageIncludePath,
24         getPackageLibraryPath,
25         getPackageLinkOpts,
26         getPackageExtraCcOpts,
27         getPackageFrameworkPath,
28         getPackageFrameworks,
29         getPreloadPackagesAnd,
30
31         collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
32         packageHsLibs,
33         ModuleExport(..),
34
35         -- * Utils
36         packageKeyPackageIdString,
37         isDllName
38     )
39 where
40
41 #include "HsVersions.h"
42
43 import PackageConfig
44 import DynFlags
45 import Config           ( cProjectVersion )
46 import Name             ( Name, nameModule_maybe )
47 import UniqFM
48 import Module
49 import Util
50 import Panic
51 import Outputable
52 import Maybes
53
54 import System.Environment ( getEnv )
55 import Distribution.InstalledPackageInfo
56 import Distribution.InstalledPackageInfo.Binary
57 import Distribution.Package hiding (depends, PackageKey, mkPackageKey)
58 import Distribution.ModuleExport
59 import FastString
60 import ErrUtils         ( debugTraceMsg, putMsg, MsgDoc )
61 import Exception
62
63 import System.Directory
64 import System.FilePath as FilePath
65 import qualified System.FilePath.Posix as FilePath.Posix
66 import Control.Monad
67 import Data.Char (isSpace)
68 import Data.List as List
69 import Data.Map (Map)
70 import qualified Data.Map as Map
71 import qualified FiniteMap as Map
72 import qualified Data.Set as Set
73
74 -- ---------------------------------------------------------------------------
75 -- The Package state
76
77 -- | Package state is all stored in 'DynFlags', including the details of
78 -- all packages, which packages are exposed, and which modules they
79 -- provide.
80 --
81 -- The package state is computed by 'initPackages', and kept in DynFlags.
82 -- It is influenced by various package flags:
83 --
84 --   * @-package <pkg>@ and @-package-id <pkg>@ cause @<pkg>@ to become exposed.
85 --     If @-hide-all-packages@ was not specified, these commands also cause
86 --      all other packages with the same name to become hidden.
87 --
88 --   * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.
89 --
90 --   * (there are a few more flags, check below for their semantics)
91 --
92 -- The package state has the following properties.
93 --
94 --   * Let @exposedPackages@ be the set of packages thus exposed.
95 --     Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of
96 --     their dependencies.
97 --
98 --   * When searching for a module from an preload import declaration,
99 --     only the exposed modules in @exposedPackages@ are valid.
100 --
101 --   * When searching for a module from an implicit import, all modules
102 --     from @depExposedPackages@ are valid.
103 --
104 --   * When linking in a compilation manager mode, we link in packages the
105 --     program depends on (the compiler knows this list by the
106 --     time it gets to the link step).  Also, we link in all packages
107 --     which were mentioned with preload @-package@ flags on the command-line,
108 --     or are a transitive dependency of same, or are \"base\"\/\"rts\".
109 --     The reason for this is that we might need packages which don't
110 --     contain any Haskell modules, and therefore won't be discovered
111 --     by the normal mechanism of dependency tracking.
112
113 -- Notes on DLLs
114 -- ~~~~~~~~~~~~~
115 -- When compiling module A, which imports module B, we need to
116 -- know whether B will be in the same DLL as A.
117 --      If it's in the same DLL, we refer to B_f_closure
118 --      If it isn't, we refer to _imp__B_f_closure
119 -- When compiling A, we record in B's Module value whether it's
120 -- in a different DLL, by setting the DLL flag.
121
122 -- | The result of performing a lookup on moduleToPkgConfAll, this
123 -- is one possible provider of a module.
124 data ModuleConf = ModConf {
125   -- | The original name of the module
126   modConfName :: ModuleName,
127   -- | The original package (config) of the module
128   modConfPkg :: PackageConfig,
129   -- | Does the original package expose this module to its clients?  This
130   -- is cached result of whether or not the module name is in
131   -- exposed-modules or reexported-modules in the package config.  While
132   -- this isn't actually how we want to figure out if a module is visible,
133   -- this is important for error messages.
134   modConfExposed :: Bool,
135   -- | Is the module visible to our current compilation?  Interestingly,
136   -- this is not the same as if it was exposed: if the package is hidden
137   -- then exposed modules are not visible.  However, if another exposed
138   -- package reexports the module in question, it's now visible!  You
139   -- can't tell this just by looking at the original name, so we
140   -- record the calculation here.
141   modConfVisible :: Bool
142   }
143
144 -- | Map from 'PackageId' (used for documentation)
145 type PackageIdMap = UniqFM
146
147 -- | Map from 'Module' to 'PackageId' to 'ModuleConf', see 'moduleToPkgConfAll'
148 type ModuleToPkgConfAll = UniqFM (PackageIdMap ModuleConf)
149
150 data PackageState = PackageState {
151   pkgIdMap              :: PackageConfigMap, -- PackageKey   -> PackageConfig
152         -- The exposed flags are adjusted according to -package and
153         -- -hide-package flags, and -ignore-package removes packages.
154
155   preloadPackages      :: [PackageKey],
156         -- The packages we're going to link in eagerly.  This list
157         -- should be in reverse dependency order; that is, a package
158         -- is always mentioned before the packages it depends on.
159
160   -- | ModuleEnv mapping, derived from 'pkgIdMap'.
161   -- Maps 'Module' to an original module which is providing the module name.
162   -- Since the module may be provided by multiple packages, this result
163   -- is further recorded in a map of the original package IDs to
164   -- module information.  The 'modSummaryPkgConf' should agree with
165   -- this key.  Generally, 'modSummaryName' will be the same as the
166   -- module key, unless there is renaming.
167   moduleToPkgConfAll    :: ModuleToPkgConfAll,
168
169   installedPackageIdMap :: InstalledPackageIdMap
170   }
171
172 -- | A PackageConfigMap maps a 'PackageKey' to a 'PackageConfig'
173 type PackageConfigMap = UniqFM PackageConfig
174
175 type InstalledPackageIdMap = Map InstalledPackageId PackageKey
176
177 type InstalledPackageIndex = Map InstalledPackageId PackageConfig
178
179 emptyPackageConfigMap :: PackageConfigMap
180 emptyPackageConfigMap = emptyUFM
181
182 -- | Find the package we know about with the given id (e.g. \"foo-1.0\"), if any
183 lookupPackage :: PackageConfigMap -> PackageKey -> Maybe PackageConfig
184 lookupPackage = lookupUFM
185
186 extendPackageConfigMap
187    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
188 extendPackageConfigMap pkg_map new_pkgs
189   = foldl add pkg_map new_pkgs
190   where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
191
192 -- | Looks up the package with the given id in the package state, panicing if it is
193 -- not found
194 getPackageDetails :: PackageState -> PackageKey -> PackageConfig
195 getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdMap ps) pid)
196
197 -- ----------------------------------------------------------------------------
198 -- Loading the package db files and building up the package state
199
200 -- | Call this after 'DynFlags.parseDynFlags'.  It reads the package
201 -- database files, and sets up various internal tables of package
202 -- information, according to the package-related flags on the
203 -- command-line (@-package@, @-hide-package@ etc.)
204 --
205 -- Returns a list of packages to link in if we're doing dynamic linking.
206 -- This list contains the packages that the user explicitly mentioned with
207 -- @-package@ flags.
208 --
209 -- 'initPackages' can be called again subsequently after updating the
210 -- 'packageFlags' field of the 'DynFlags', and it will update the
211 -- 'pkgState' in 'DynFlags' and return a list of packages to
212 -- link in.
213 initPackages :: DynFlags -> IO (DynFlags, [PackageKey])
214 initPackages dflags = do
215   pkg_db <- case pkgDatabase dflags of
216                 Nothing -> readPackageConfigs dflags
217                 Just db -> return $ setBatchPackageFlags dflags db
218   (pkg_state, preload, this_pkg)
219         <- mkPackageState dflags pkg_db [] (thisPackage dflags)
220   return (dflags{ pkgDatabase = Just pkg_db,
221                   pkgState = pkg_state,
222                   thisPackage = this_pkg },
223           preload)
224
225 -- -----------------------------------------------------------------------------
226 -- Reading the package database(s)
227
228 readPackageConfigs :: DynFlags -> IO [PackageConfig]
229 readPackageConfigs dflags = do
230   let system_conf_refs = [UserPkgConf, GlobalPkgConf]
231
232   e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
233   let base_conf_refs = case e_pkg_path of
234         Left _ -> system_conf_refs
235         Right path
236          | null (last cs)
237          -> map PkgConfFile (init cs) ++ system_conf_refs
238          | otherwise
239          -> map PkgConfFile cs
240          where cs = parseSearchPath path
241          -- if the path ends in a separator (eg. "/foo/bar:")
242          -- then we tack on the system paths.
243
244   let conf_refs = reverse (extraPkgConfs dflags base_conf_refs)
245   -- later packages shadow earlier ones.  extraPkgConfs
246   -- is in the opposite order to the flags on the
247   -- command line.
248   confs <- liftM catMaybes $ mapM (resolvePackageConfig dflags) conf_refs
249
250   liftM concat $ mapM (readPackageConfig dflags) confs
251
252 resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
253 resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)
254 resolvePackageConfig _ UserPkgConf = handleIO (\_ -> return Nothing) $ do
255   appdir <- getAppUserDataDirectory "ghc"
256   let dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
257       pkgconf = dir </> "package.conf.d"
258   exist <- doesDirectoryExist pkgconf
259   return $ if exist then Just pkgconf else Nothing
260 resolvePackageConfig _ (PkgConfFile name) = return $ Just name
261
262 readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
263 readPackageConfig dflags conf_file = do
264   isdir <- doesDirectoryExist conf_file
265
266   proto_pkg_configs <-
267     if isdir
268        then do let filename = conf_file </> "package.cache"
269                debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
270                conf <- readBinPackageDB filename
271                return (map installedPackageInfoToPackageConfig conf)
272
273        else do
274             isfile <- doesFileExist conf_file
275             when (not isfile) $
276               throwGhcExceptionIO $ InstallationError $
277                 "can't find a package database at " ++ conf_file
278             debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
279             str <- readFile conf_file
280             case reads str of
281                 [(configs, rest)]
282                     | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
283                 _ -> throwGhcExceptionIO $ InstallationError $
284                         "invalid package database file " ++ conf_file
285
286   let
287       top_dir = topDir dflags
288       pkgroot = takeDirectory conf_file
289       pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
290       pkg_configs2 = setBatchPackageFlags dflags pkg_configs1
291   --
292   return pkg_configs2
293
294 setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
295 setBatchPackageFlags dflags pkgs = (maybeDistrustAll . maybeHideAll) pkgs
296   where
297     maybeHideAll pkgs'
298       | gopt Opt_HideAllPackages dflags = map hide pkgs'
299       | otherwise                       = pkgs'
300
301     maybeDistrustAll pkgs'
302       | gopt Opt_DistrustAllPackages dflags = map distrust pkgs'
303       | otherwise                           = pkgs'
304
305     hide pkg = pkg{ exposed = False }
306     distrust pkg = pkg{ trusted = False }
307
308 -- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
309 mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
310 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
311 -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
312 -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
313 -- The "pkgroot" is the directory containing the package database.
314 --
315 -- Also perform a similar substitution for the older GHC-specific
316 -- "$topdir" variable. The "topdir" is the location of the ghc
317 -- installation (obtained from the -B option).
318 mungePackagePaths top_dir pkgroot pkg =
319     pkg {
320       importDirs  = munge_paths (importDirs pkg),
321       includeDirs = munge_paths (includeDirs pkg),
322       libraryDirs = munge_paths (libraryDirs pkg),
323       frameworkDirs = munge_paths (frameworkDirs pkg),
324       haddockInterfaces = munge_paths (haddockInterfaces pkg),
325       haddockHTMLs = munge_urls (haddockHTMLs pkg)
326     }
327   where
328     munge_paths = map munge_path
329     munge_urls  = map munge_url
330
331     munge_path p
332       | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
333       | Just p' <- stripVarPrefix "$topdir"    p = top_dir ++ p'
334       | otherwise                                = p
335
336     munge_url p
337       | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
338       | Just p' <- stripVarPrefix "$httptopdir"   p = toUrlPath top_dir p'
339       | otherwise                                   = p
340
341     toUrlPath r p = "file:///"
342                  -- URLs always use posix style '/' separators:
343                  ++ FilePath.Posix.joinPath
344                         (r : -- We need to drop a leading "/" or "\\"
345                              -- if there is one:
346                              dropWhile (all isPathSeparator)
347                                        (FilePath.splitDirectories p))
348
349     -- We could drop the separator here, and then use </> above. However,
350     -- by leaving it in and using ++ we keep the same path separator
351     -- rather than letting FilePath change it to use \ as the separator
352     stripVarPrefix var path = case stripPrefix var path of
353                               Just [] -> Just []
354                               Just cs@(c : _) | isPathSeparator c -> Just cs
355                               _ -> Nothing
356
357
358 -- -----------------------------------------------------------------------------
359 -- Modify our copy of the package database based on a package flag
360 -- (-package, -hide-package, -ignore-package).
361
362 applyPackageFlag
363    :: DynFlags
364    -> UnusablePackages
365    -> [PackageConfig]           -- Initial database
366    -> PackageFlag               -- flag to apply
367    -> IO [PackageConfig]        -- new database
368
369 applyPackageFlag dflags unusable pkgs flag =
370   case flag of
371     ExposePackage str ->
372        case selectPackages (matchingStr str) pkgs unusable of
373          Left ps         -> packageFlagErr dflags flag ps
374          Right (p:ps,qs) -> return (p':ps')
375           where p' = p {exposed=True}
376                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
377          _ -> panic "applyPackageFlag"
378
379     ExposePackageId str ->
380        case selectPackages (matchingId str) pkgs unusable of
381          Left ps         -> packageFlagErr dflags flag ps
382          Right (p:ps,qs) -> return (p':ps')
383           where p' = p {exposed=True}
384                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
385          _ -> panic "applyPackageFlag"
386
387     ExposePackageKey str ->
388        case selectPackages (matchingKey str) pkgs unusable of
389          Left ps         -> packageFlagErr dflags flag ps
390          Right (p:ps,qs) -> return (p':ps')
391           where p' = p {exposed=True}
392                 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
393          _ -> panic "applyPackageFlag"
394
395     HidePackage str ->
396        case selectPackages (matchingStr str) pkgs unusable of
397          Left ps       -> packageFlagErr dflags flag ps
398          Right (ps,qs) -> return (map hide ps ++ qs)
399           where hide p = p {exposed=False}
400
401     -- we trust all matching packages. Maybe should only trust first one?
402     -- and leave others the same or set them untrusted
403     TrustPackage str ->
404        case selectPackages (matchingStr str) pkgs unusable of
405          Left ps       -> packageFlagErr dflags flag ps
406          Right (ps,qs) -> return (map trust ps ++ qs)
407           where trust p = p {trusted=True}
408
409     DistrustPackage str ->
410        case selectPackages (matchingStr str) pkgs unusable of
411          Left ps       -> packageFlagErr dflags flag ps
412          Right (ps,qs) -> return (map distrust ps ++ qs)
413           where distrust p = p {trusted=False}
414
415     _ -> panic "applyPackageFlag"
416
417    where
418         -- When a package is requested to be exposed, we hide all other
419         -- packages with the same name if -hide-all-packages was not specified.
420         -- If it was specified, we expect users to not try to expose a package
421         -- multiple times, so don't hide things.
422         hideAll name ps = map maybe_hide ps
423           where maybe_hide p
424                    | gopt Opt_HideAllPackages dflags     = p
425                    | pkgName (sourcePackageId p) == name = p {exposed=False}
426                    | otherwise                           = p
427
428
429 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
430                -> UnusablePackages
431                -> Either [(PackageConfig, UnusablePackageReason)]
432                   ([PackageConfig], [PackageConfig])
433 selectPackages matches pkgs unusable
434   = let
435         (ps,rest) = partition matches pkgs
436         reasons = [ (p, Map.lookup (installedPackageId p) unusable)
437                   | p <- ps ]
438     in
439     if all (isJust.snd) reasons
440        then Left  [ (p, reason) | (p,Just reason) <- reasons ]
441        else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
442
443 -- A package named on the command line can either include the
444 -- version, or just the name if it is unambiguous.
445 matchingStr :: String -> PackageConfig -> Bool
446 matchingStr str p
447         =  str == display (sourcePackageId p)
448         || str == display (pkgName (sourcePackageId p))
449
450 matchingId :: String -> PackageConfig -> Bool
451 matchingId str p =  InstalledPackageId str == installedPackageId p
452
453 matchingKey :: String -> PackageConfig -> Bool
454 matchingKey str p = str == display (packageKey p)
455
456 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
457 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
458
459 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
460 comparing f a b = f a `compare` f b
461
462 packageFlagErr :: DynFlags
463                -> PackageFlag
464                -> [(PackageConfig, UnusablePackageReason)]
465                -> IO a
466
467 -- for missing DPH package we emit a more helpful error message, because
468 -- this may be the result of using -fdph-par or -fdph-seq.
469 packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
470   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
471   where dph_err = text "the " <> text pkg <> text " package is not installed."
472                   $$ text "To install it: \"cabal install dph\"."
473         is_dph_package pkg = "dph" `isPrefixOf` pkg
474
475 packageFlagErr dflags flag reasons
476   = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
477   where err = text "cannot satisfy " <> ppr_flag <>
478                 (if null reasons then empty else text ": ") $$
479               nest 4 (ppr_reasons $$
480                       -- ToDo: this admonition seems a bit dodgy
481                       text "(use -v for more information)")
482         ppr_flag = case flag of
483                      IgnorePackage p -> text "-ignore-package " <> text p
484                      HidePackage p   -> text "-hide-package " <> text p
485                      ExposePackage p -> text "-package " <> text p
486                      ExposePackageId p -> text "-package-id " <> text p
487                      ExposePackageKey p -> text "-package-key " <> text p
488                      TrustPackage p    -> text "-trust " <> text p
489                      DistrustPackage p -> text "-distrust " <> text p
490         ppr_reasons = vcat (map ppr_reason reasons)
491         ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
492
493 -- -----------------------------------------------------------------------------
494 -- Hide old versions of packages
495
496 --
497 -- hide all packages for which there is also a later version
498 -- that is already exposed.  This just makes it non-fatal to have two
499 -- versions of a package exposed, which can happen if you install a
500 -- later version of a package in the user database, for example.
501 -- However, don't do this if @-hide-all-packages@ was passed.
502 --
503 hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
504 hideOldPackages dflags pkgs = mapM maybe_hide pkgs
505   where maybe_hide p
506            | gopt Opt_HideAllPackages dflags = return p
507            | not (exposed p) = return p
508            | (p' : _) <- later_versions = do
509                 debugTraceMsg dflags 2 $
510                    (ptext (sLit "hiding package") <+> pprSPkg p <+>
511                     ptext (sLit "to avoid conflict with later version") <+>
512                     pprSPkg p')
513                 return (p {exposed=False})
514            | otherwise = return p
515           where myname = pkgName (sourcePackageId p)
516                 myversion = pkgVersion (sourcePackageId p)
517                 later_versions = [ p | p <- pkgs, exposed p,
518                                        let pkg = sourcePackageId p,
519                                        pkgName pkg == myname,
520                                        pkgVersion pkg > myversion ]
521
522 -- -----------------------------------------------------------------------------
523 -- Wired-in packages
524
525 findWiredInPackages
526    :: DynFlags
527    -> [PackageConfig]           -- database
528    -> IO [PackageConfig]
529
530 findWiredInPackages dflags pkgs = do
531   --
532   -- Now we must find our wired-in packages, and rename them to
533   -- their canonical names (eg. base-1.0 ==> base).
534   --
535   let
536         wired_in_pkgids :: [String]
537         wired_in_pkgids = map packageKeyString wiredInPackageKeys
538
539         matches :: PackageConfig -> String -> Bool
540         pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
541
542         -- find which package corresponds to each wired-in package
543         -- delete any other packages with the same name
544         -- update the package and any dependencies to point to the new
545         -- one.
546         --
547         -- When choosing which package to map to a wired-in package
548         -- name, we prefer exposed packages, and pick the latest
549         -- version.  To override the default choice, -hide-package
550         -- could be used to hide newer versions.
551         --
552         findWiredInPackage :: [PackageConfig] -> String
553                            -> IO (Maybe InstalledPackageId)
554         findWiredInPackage pkgs wired_pkg =
555            let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
556            case all_ps of
557                 []   -> notfound
558                 many -> pick (head (sortByVersion many))
559           where
560                 notfound = do
561                           debugTraceMsg dflags 2 $
562                             ptext (sLit "wired-in package ")
563                                  <> text wired_pkg
564                                  <> ptext (sLit " not found.")
565                           return Nothing
566                 pick :: InstalledPackageInfo_ ModuleName
567                      -> IO (Maybe InstalledPackageId)
568                 pick pkg = do
569                         debugTraceMsg dflags 2 $
570                             ptext (sLit "wired-in package ")
571                                  <> text wired_pkg
572                                  <> ptext (sLit " mapped to ")
573                                  <> pprIPkg pkg
574                         return (Just (installedPackageId pkg))
575
576
577   mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
578   let
579         wired_in_ids = catMaybes mb_wired_in_ids
580
581         -- this is old: we used to assume that if there were
582         -- multiple versions of wired-in packages installed that
583         -- they were mutually exclusive.  Now we're assuming that
584         -- you have one "main" version of each wired-in package
585         -- (the latest version), and the others are backward-compat
586         -- wrappers that depend on this one.  e.g. base-4.0 is the
587         -- latest, base-3.0 is a compat wrapper depending on base-4.0.
588         {-
589         deleteOtherWiredInPackages pkgs = filterOut bad pkgs
590           where bad p = any (p `matches`) wired_in_pkgids
591                       && package p `notElem` map fst wired_in_ids
592         -}
593
594         updateWiredInDependencies pkgs = map upd_pkg pkgs
595           where upd_pkg p
596                   | installedPackageId p `elem` wired_in_ids
597                   = let pid = (sourcePackageId p) { pkgVersion = Version [] [] }
598                     in p { sourcePackageId = pid
599                          , packageKey = OldPackageKey pid }
600                   | otherwise
601                   = p
602
603   return $ updateWiredInDependencies pkgs
604
605 -- ----------------------------------------------------------------------------
606
607 data UnusablePackageReason
608   = IgnoredWithFlag
609   | MissingDependencies [InstalledPackageId]
610   | ShadowedBy InstalledPackageId
611
612 type UnusablePackages = Map InstalledPackageId UnusablePackageReason
613
614 pprReason :: SDoc -> UnusablePackageReason -> SDoc
615 pprReason pref reason = case reason of
616   IgnoredWithFlag ->
617       pref <+> ptext (sLit "ignored due to an -ignore-package flag")
618   MissingDependencies deps ->
619       pref <+>
620       ptext (sLit "unusable due to missing or recursive dependencies:") $$
621         nest 2 (hsep (map (text.display) deps))
622   ShadowedBy ipid ->
623       pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
624
625 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
626 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
627   where
628     report (ipid, reason) =
629        debugTraceMsg dflags 2 $
630          pprReason
631            (ptext (sLit "package") <+>
632             text (display ipid) <+> text "is") reason
633
634 -- ----------------------------------------------------------------------------
635 --
636 -- Detect any packages that have missing dependencies, and also any
637 -- mutually-recursive groups of packages (loops in the package graph
638 -- are not allowed).  We do this by taking the least fixpoint of the
639 -- dependency graph, repeatedly adding packages whose dependencies are
640 -- satisfied until no more can be added.
641 --
642 findBroken :: [PackageConfig] -> UnusablePackages
643 findBroken pkgs = go [] Map.empty pkgs
644  where
645    go avail ipids not_avail =
646      case partitionWith (depsAvailable ipids) not_avail of
647         ([], not_avail) ->
648             Map.fromList [ (installedPackageId p, MissingDependencies deps)
649                          | (p,deps) <- not_avail ]
650         (new_avail, not_avail) ->
651             go (new_avail ++ avail) new_ipids (map fst not_avail)
652             where new_ipids = Map.insertList
653                                 [ (installedPackageId p, p) | p <- new_avail ]
654                                 ipids
655
656    depsAvailable :: InstalledPackageIndex
657                  -> PackageConfig
658                  -> Either PackageConfig (PackageConfig, [InstalledPackageId])
659    depsAvailable ipids pkg
660         | null dangling = Left pkg
661         | otherwise     = Right (pkg, dangling)
662         where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
663
664 -- -----------------------------------------------------------------------------
665 -- Eliminate shadowed packages, giving the user some feedback
666
667 -- later packages in the list should shadow earlier ones with the same
668 -- package name/version.  Additionally, a package may be preferred if
669 -- it is in the transitive closure of packages selected using -package-id
670 -- flags.
671 shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
672 shadowPackages pkgs preferred
673  = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
674    in  Map.fromList shadowed
675  where
676  check (shadowed,pkgmap) pkg
677       | Just oldpkg <- lookupUFM pkgmap pkgid
678       , let
679             ipid_new = installedPackageId pkg
680             ipid_old = installedPackageId oldpkg
681         --
682       , ipid_old /= ipid_new
683       = if ipid_old `elem` preferred
684            then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
685            else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
686       | otherwise
687       = (shadowed, pkgmap')
688       where
689         pkgid = mkFastString (display (sourcePackageId pkg))
690         pkgmap' = addToUFM pkgmap pkgid pkg
691
692 -- -----------------------------------------------------------------------------
693
694 ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
695 ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
696   where
697   doit (IgnorePackage str) =
698      case partition (matchingStr str) pkgs of
699          (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
700                     | p <- ps ]
701         -- missing package is not an error for -ignore-package,
702         -- because a common usage is to -ignore-package P as
703         -- a preventative measure just in case P exists.
704   doit _ = panic "ignorePackages"
705
706 -- -----------------------------------------------------------------------------
707
708 depClosure :: InstalledPackageIndex
709            -> [InstalledPackageId]
710            -> [InstalledPackageId]
711 depClosure index ipids = closure Map.empty ipids
712   where
713    closure set [] = Map.keys set
714    closure set (ipid : ipids)
715      | ipid `Map.member` set = closure set ipids
716      | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
717                                                  (depends p ++ ipids)
718      | otherwise = closure set ipids
719
720 -- -----------------------------------------------------------------------------
721 -- When all the command-line options are in, we can process our package
722 -- settings and populate the package state.
723
724 mkPackageState
725     :: DynFlags
726     -> [PackageConfig]          -- initial database
727     -> [PackageKey]              -- preloaded packages
728     -> PackageKey                -- this package
729     -> IO (PackageState,
730            [PackageKey],         -- new packages to preload
731            PackageKey) -- this package, might be modified if the current
732                       -- package is a wired-in package.
733
734 mkPackageState dflags pkgs0 preload0 this_package = do
735
736 {-
737    Plan.
738
739    1. P = transitive closure of packages selected by -package-id
740
741    2. Apply shadowing.  When there are multiple packages with the same
742       packageKey,
743         * if one is in P, use that one
744         * otherwise, use the one highest in the package stack
745       [
746        rationale: we cannot use two packages with the same packageKey
747        in the same program, because packageKey is the symbol prefix.
748        Hence we must select a consistent set of packages to use.  We have
749        a default algorithm for doing this: packages higher in the stack
750        shadow those lower down.  This default algorithm can be overriden
751        by giving explicit -package-id flags; then we have to take these
752        preferences into account when selecting which other packages are
753        made available.
754
755        Our simple algorithm throws away some solutions: there may be other
756        consistent sets that would satisfy the -package flags, but it's
757        not GHC's job to be doing constraint solving.
758       ]
759
760    3. remove packages selected by -ignore-package
761
762    4. remove any packages with missing dependencies, or mutually recursive
763       dependencies.
764
765    5. report (with -v) any packages that were removed by steps 2-4
766
767    6. apply flags to set exposed/hidden on the resulting packages
768       - if any flag refers to a package which was removed by 2-4, then
769         we can give an error message explaining why
770
771    7. hide any packages which are superseded by later exposed packages
772 -}
773
774   let
775       flags = reverse (packageFlags dflags)
776
777       -- pkgs0 with duplicate packages filtered out.  This is
778       -- important: it is possible for a package in the global package
779       -- DB to have the same IPID as a package in the user DB, and
780       -- we want the latter to take precedence.  This is not the same
781       -- as shadowing (below), since in this case the two packages
782       -- have the same ABI and are interchangeable.
783       --
784       -- #4072: note that we must retain the ordering of the list here
785       -- so that shadowing behaves as expected when we apply it later.
786       pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
787           where del p (s,ps)
788                   | pid `Set.member` s = (s,ps)
789                   | otherwise          = (Set.insert pid s, p:ps)
790                   where pid = installedPackageId p
791           -- XXX this is just a variant of nub
792
793       ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
794       -- NB: Prefer the last one (i.e. the one highest in the package stack
795       pk_map = Map.fromList [ (packageConfigId p, p) | p <- pkgs0 ]
796
797       ipid_selected = depClosure ipid_map ([ InstalledPackageId i
798                                            | ExposePackageId i <- flags ]
799                                         ++ [ installedPackageId pkg
800                                            | ExposePackageKey k <- flags
801                                            , Just pkg <- [Map.lookup
802                                                 (stringToPackageKey k) pk_map]])
803
804       (ignore_flags, other_flags) = partition is_ignore flags
805       is_ignore IgnorePackage{} = True
806       is_ignore _ = False
807
808       shadowed = shadowPackages pkgs0_unique ipid_selected
809
810       ignored  = ignorePackages ignore_flags pkgs0_unique
811
812       pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
813       broken   = findBroken pkgs0'
814       unusable = shadowed `Map.union` ignored `Map.union` broken
815
816   reportUnusable dflags unusable
817
818   --
819   -- Modify the package database according to the command-line flags
820   -- (-package, -hide-package, -ignore-package, -hide-all-packages).
821   --
822   pkgs1 <- foldM (applyPackageFlag dflags unusable) pkgs0_unique other_flags
823   let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
824
825   -- Here we build up a set of the packages mentioned in -package
826   -- flags on the command line; these are called the "preload"
827   -- packages.  we link these packages in eagerly.  The preload set
828   -- should contain at least rts & base, which is why we pretend that
829   -- the command line contains -package rts & -package base.
830   --
831   let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
832
833       get_exposed (ExposePackage   s)
834          = take 1 $ sortByVersion (filter (matchingStr s) pkgs2)
835          --  -package P means "the latest version of P" (#7030)
836       get_exposed (ExposePackageId s) = filter (matchingId  s) pkgs2
837       get_exposed (ExposePackageKey s) = filter (matchingKey s) pkgs2
838       get_exposed _                   = []
839
840   -- hide packages that are subsumed by later versions
841   pkgs3 <- hideOldPackages dflags pkgs2
842
843   -- sort out which packages are wired in
844   pkgs4 <- findWiredInPackages dflags pkgs3
845
846   let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
847
848       ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
849                               | p <- pkgs4 ]
850
851       lookupIPID ipid@(InstalledPackageId str)
852          | Just pid <- Map.lookup ipid ipid_map = return pid
853          | otherwise                            = missingPackageErr dflags str
854
855   preload2 <- mapM lookupIPID preload1
856
857   let
858       -- add base & rts to the preload packages
859       basicLinkedPackages
860        | gopt Opt_AutoLinkPackages dflags
861           = filter (flip elemUFM pkg_db) [basePackageKey, rtsPackageKey]
862        | otherwise = []
863       -- but in any case remove the current package from the set of
864       -- preloaded packages so that base/rts does not end up in the
865       -- set up preloaded package when we are just building it
866       preload3 = nub $ filter (/= this_package)
867                      $ (basicLinkedPackages ++ preload2)
868
869   -- Close the preload packages with their dependencies
870   dep_preload <- closeDeps dflags pkg_db ipid_map (zip preload3 (repeat Nothing))
871   let new_dep_preload = filter (`notElem` preload0) dep_preload
872
873   let pstate = PackageState{ preloadPackages     = dep_preload,
874                              pkgIdMap            = pkg_db,
875                              moduleToPkgConfAll  = mkModuleMap pkg_db ipid_map,
876                              installedPackageIdMap = ipid_map
877                            }
878
879   return (pstate, new_dep_preload, this_package)
880
881
882 -- -----------------------------------------------------------------------------
883 -- | Makes the mapping from module to package info for 'moduleToPkgConfAll'
884
885 mkModuleMap
886   :: PackageConfigMap
887   -> InstalledPackageIdMap
888   -> ModuleToPkgConfAll
889 mkModuleMap pkg_db ipid_map = foldr extend_modmap emptyUFM pkgids
890   where
891     pkgids = map packageConfigId (eltsUFM pkg_db)
892
893     extend_modmap pkgid modmap = addListToUFM_C (plusUFM_C merge) modmap es
894       where -- Invariant: m == m' && pkg == pkg' && e == e'
895             --              && (e || not (v || v'))
896             -- Some notes about the assert. Merging only ever occurs when
897             -- we find a reexport.  The interesting condition:
898             --      e || not (v || v')
899             -- says that a non-exposed module cannot ever become visible.
900             -- However, an invisible (but exported) module may become
901             -- visible when it is reexported by a visible package,
902             -- which is why we merge visibility using logical OR.
903             merge a b = a { modConfVisible =
904                                    modConfVisible a || modConfVisible b }
905             es = [(m, unitUFM pkgid  (ModConf m pkg True (exposed pkg)))
906                  | m <- exposed_mods] ++
907                  [(m, unitUFM pkgid  (ModConf m pkg False False))
908                  | m <- hidden_mods] ++
909                  [(m, unitUFM pkgid' (ModConf m' pkg' True (exposed pkg)))
910                  | ModuleExport{ exportName = m
911                                , exportCachedTrueOrig = Just (ipid', m')}
912                         <- reexported_mods
913                  , Just pkgid' <- [Map.lookup ipid' ipid_map]
914                  , let pkg' = pkg_lookup pkgid' ]
915             pkg = pkg_lookup pkgid
916             pkg_lookup = expectJust "mkModuleMap" . lookupPackage pkg_db
917             exposed_mods = exposedModules pkg
918             reexported_mods = reexportedModules pkg
919             hidden_mods  = hiddenModules pkg
920
921 pprSPkg :: PackageConfig -> SDoc
922 pprSPkg p = text (display (sourcePackageId p))
923
924 pprIPkg :: PackageConfig -> SDoc
925 pprIPkg p = text (display (installedPackageId p))
926
927 -- -----------------------------------------------------------------------------
928 -- Extracting information from the packages in scope
929
930 -- Many of these functions take a list of packages: in those cases,
931 -- the list is expected to contain the "dependent packages",
932 -- i.e. those packages that were found to be depended on by the
933 -- current module/program.  These can be auto or non-auto packages, it
934 -- doesn't really matter.  The list is always combined with the list
935 -- of preload (command-line) packages to determine which packages to
936 -- use.
937
938 -- | Find all the include directories in these and the preload packages
939 getPackageIncludePath :: DynFlags -> [PackageKey] -> IO [String]
940 getPackageIncludePath dflags pkgs =
941   collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
942
943 collectIncludeDirs :: [PackageConfig] -> [FilePath]
944 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
945
946 -- | Find all the library paths in these and the preload packages
947 getPackageLibraryPath :: DynFlags -> [PackageKey] -> IO [String]
948 getPackageLibraryPath dflags pkgs =
949   collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
950
951 collectLibraryPaths :: [PackageConfig] -> [FilePath]
952 collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
953
954 -- | Find all the link options in these and the preload packages,
955 -- returning (package hs lib options, extra library options, other flags)
956 getPackageLinkOpts :: DynFlags -> [PackageKey] -> IO ([String], [String], [String])
957 getPackageLinkOpts dflags pkgs =
958   collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
959
960 collectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])
961 collectLinkOpts dflags ps =
962     (
963         concatMap (map ("-l" ++) . packageHsLibs dflags) ps,
964         concatMap (map ("-l" ++) . extraLibraries) ps,
965         concatMap ldOptions ps
966     )
967
968 packageHsLibs :: DynFlags -> PackageConfig -> [String]
969 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
970   where
971         ways0 = ways dflags
972
973         ways1 = filter (/= WayDyn) ways0
974         -- the name of a shared library is libHSfoo-ghc<version>.so
975         -- we leave out the _dyn, because it is superfluous
976
977         -- debug RTS includes support for -eventlog
978         ways2 | WayDebug `elem` ways1
979               = filter (/= WayEventLog) ways1
980               | otherwise
981               = ways1
982
983         tag     = mkBuildTag (filter (not . wayRTSOnly) ways2)
984         rts_tag = mkBuildTag ways2
985
986         mkDynName x
987          | gopt Opt_Static dflags       = x
988          | "HS" `isPrefixOf` x          = x ++ "-ghc" ++ cProjectVersion
989            -- For non-Haskell libraries, we use the name "Cfoo". The .a
990            -- file is libCfoo.a, and the .so is libfoo.so. That way the
991            -- linker knows what we mean for the vanilla (-lCfoo) and dyn
992            -- (-lfoo) ways. We therefore need to strip the 'C' off here.
993          | Just x' <- stripPrefix "C" x = x'
994          | otherwise
995             = panic ("Don't understand library name " ++ x)
996
997         addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)
998         addSuffix other_lib      = other_lib ++ (expandTag tag)
999
1000         expandTag t | null t = ""
1001                     | otherwise = '_':t
1002
1003 -- | Find all the C-compiler options in these and the preload packages
1004 getPackageExtraCcOpts :: DynFlags -> [PackageKey] -> IO [String]
1005 getPackageExtraCcOpts dflags pkgs = do
1006   ps <- getPreloadPackagesAnd dflags pkgs
1007   return (concatMap ccOptions ps)
1008
1009 -- | Find all the package framework paths in these and the preload packages
1010 getPackageFrameworkPath  :: DynFlags -> [PackageKey] -> IO [String]
1011 getPackageFrameworkPath dflags pkgs = do
1012   ps <- getPreloadPackagesAnd dflags pkgs
1013   return (nub (filter notNull (concatMap frameworkDirs ps)))
1014
1015 -- | Find all the package frameworks in these and the preload packages
1016 getPackageFrameworks  :: DynFlags -> [PackageKey] -> IO [String]
1017 getPackageFrameworks dflags pkgs = do
1018   ps <- getPreloadPackagesAnd dflags pkgs
1019   return (concatMap frameworks ps)
1020
1021 -- -----------------------------------------------------------------------------
1022 -- Package Utils
1023
1024 -- | Takes a 'ModuleName', and if the module is in any package returns
1025 -- a map of package IDs to 'ModuleConf', describing where the module lives
1026 -- and whether or not it is exposed.
1027 lookupModuleInAllPackages :: DynFlags
1028                           -> ModuleName
1029                           -> PackageIdMap ModuleConf
1030 lookupModuleInAllPackages dflags m
1031   = case lookupModuleWithSuggestions dflags m of
1032       Right pbs -> pbs
1033       Left  _   -> emptyUFM
1034
1035 lookupModuleWithSuggestions
1036   :: DynFlags -> ModuleName
1037   -> Either [Module] (PackageIdMap ModuleConf)
1038          -- Lookup module in all packages
1039          -- Right pbs   =>   found in pbs
1040          -- Left  ms    =>   not found; but here are sugestions
1041 lookupModuleWithSuggestions dflags m
1042   = case lookupUFM (moduleToPkgConfAll pkg_state) m of
1043         Nothing -> Left suggestions
1044         Just ps -> Right ps
1045   where
1046     pkg_state = pkgState dflags
1047     suggestions
1048       | gopt Opt_HelpfulErrors dflags =
1049            fuzzyLookup (moduleNameString m) all_mods
1050       | otherwise = []
1051
1052     all_mods :: [(String, Module)]     -- All modules
1053     all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
1054                | pkg_config <- eltsUFM (pkgIdMap pkg_state)
1055                , let pkg_id = packageConfigId pkg_config
1056                , mod_nm <- exposedModules pkg_config
1057                         ++ map exportName (reexportedModules pkg_config) ]
1058
1059 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
1060 -- 'PackageConfig's
1061 getPreloadPackagesAnd :: DynFlags -> [PackageKey] -> IO [PackageConfig]
1062 getPreloadPackagesAnd dflags pkgids =
1063   let
1064       state   = pkgState dflags
1065       pkg_map = pkgIdMap state
1066       ipid_map = installedPackageIdMap state
1067       preload = preloadPackages state
1068       pairs = zip pkgids (repeat Nothing)
1069   in do
1070   all_pkgs <- throwErr dflags (foldM (add_package pkg_map ipid_map) preload pairs)
1071   return (map (getPackageDetails state) all_pkgs)
1072
1073 -- Takes a list of packages, and returns the list with dependencies included,
1074 -- in reverse dependency order (a package appears before those it depends on).
1075 closeDeps :: DynFlags
1076           -> PackageConfigMap
1077           -> Map InstalledPackageId PackageKey
1078           -> [(PackageKey, Maybe PackageKey)]
1079           -> IO [PackageKey]
1080 closeDeps dflags pkg_map ipid_map ps
1081     = throwErr dflags (closeDepsErr pkg_map ipid_map ps)
1082
1083 throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
1084 throwErr dflags m
1085               = case m of
1086                 Failed e    -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))
1087                 Succeeded r -> return r
1088
1089 closeDepsErr :: PackageConfigMap
1090              -> Map InstalledPackageId PackageKey
1091              -> [(PackageKey,Maybe PackageKey)]
1092              -> MaybeErr MsgDoc [PackageKey]
1093 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
1094
1095 -- internal helper
1096 add_package :: PackageConfigMap
1097             -> Map InstalledPackageId PackageKey
1098             -> [PackageKey]
1099             -> (PackageKey,Maybe PackageKey)
1100             -> MaybeErr MsgDoc [PackageKey]
1101 add_package pkg_db ipid_map ps (p, mb_parent)
1102   | p `elem` ps = return ps     -- Check if we've already added this package
1103   | otherwise =
1104       case lookupPackage pkg_db p of
1105         Nothing -> Failed (missingPackageMsg (packageKeyString p) <>
1106                            missingDependencyMsg mb_parent)
1107         Just pkg -> do
1108            -- Add the package's dependents also
1109            ps' <- foldM add_package_ipid ps (depends pkg)
1110            return (p : ps')
1111           where
1112             add_package_ipid ps ipid@(InstalledPackageId str)
1113               | Just pid <- Map.lookup ipid ipid_map
1114               = add_package pkg_db ipid_map ps (pid, Just p)
1115               | otherwise
1116               = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
1117
1118 missingPackageErr :: DynFlags -> String -> IO a
1119 missingPackageErr dflags p
1120     = throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
1121
1122 missingPackageMsg :: String -> SDoc
1123 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
1124
1125 missingDependencyMsg :: Maybe PackageKey -> SDoc
1126 missingDependencyMsg Nothing = empty
1127 missingDependencyMsg (Just parent)
1128   = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent))
1129
1130 -- -----------------------------------------------------------------------------
1131
1132 packageKeyPackageIdString :: DynFlags -> PackageKey -> String
1133 packageKeyPackageIdString dflags pkg_key
1134     | pkg_key == mainPackageKey = "main"
1135     | otherwise = maybe "(unknown)"
1136                       (display . sourcePackageId)
1137                       (lookupPackage (pkgIdMap (pkgState dflags)) pkg_key)
1138
1139 -- | Will the 'Name' come from a dynamically linked library?
1140 isDllName :: DynFlags -> PackageKey -> Module -> Name -> Bool
1141 -- Despite the "dll", I think this function just means that
1142 -- the synbol comes from another dynamically-linked package,
1143 -- and applies on all platforms, not just Windows
1144 isDllName dflags _this_pkg this_mod name
1145   | gopt Opt_Static dflags = False
1146   | Just mod <- nameModule_maybe name
1147     -- Issue #8696 - when GHC is dynamically linked, it will attempt
1148     -- to load the dynamic dependencies of object files at compile
1149     -- time for things like QuasiQuotes or
1150     -- TemplateHaskell. Unfortunately, this interacts badly with
1151     -- intra-package linking, because we don't generate indirect
1152     -- (dynamic) symbols for intra-package calls. This means that if a
1153     -- module with an intra-package call is loaded without its
1154     -- dependencies, then GHC fails to link. This is the cause of #
1155     --
1156     -- In the mean time, always force dynamic indirections to be
1157     -- generated: when the module name isn't the module being
1158     -- compiled, references are dynamic.
1159     = if mod /= this_mod
1160       then True
1161       else case dllSplit dflags of
1162            Nothing -> False
1163            Just ss ->
1164                let findMod m = let modStr = moduleNameString (moduleName m)
1165                                in case find (modStr `Set.member`) ss of
1166                                   Just i -> i
1167                                   Nothing -> panic ("Can't find " ++ modStr ++ "in DLL split")
1168                in findMod mod /= findMod this_mod
1169        
1170   | otherwise = False  -- no, it is not even an external name
1171
1172 -- -----------------------------------------------------------------------------
1173 -- Displaying packages
1174
1175 -- | Show (very verbose) package info on console, if verbosity is >= 5
1176 dumpPackages :: DynFlags -> IO ()
1177 dumpPackages = dumpPackages' showInstalledPackageInfo
1178
1179 dumpPackages' :: (InstalledPackageInfo -> String) -> DynFlags -> IO ()
1180 dumpPackages' showIPI dflags
1181   = do let pkg_map = pkgIdMap (pkgState dflags)
1182        putMsg dflags $
1183              vcat (map (text . showIPI
1184                              . packageConfigToInstalledPackageInfo)
1185                        (eltsUFM pkg_map))
1186
1187 -- | Show simplified package info on console, if verbosity == 4.
1188 -- The idea is to only print package id, and any information that might
1189 -- be different from the package databases (exposure, trust)
1190 simpleDumpPackages :: DynFlags -> IO ()
1191 simpleDumpPackages = dumpPackages' showIPI
1192     where showIPI ipi = let InstalledPackageId i = installedPackageId ipi
1193                             e = if exposed ipi then "E" else " "
1194                             t = if trusted ipi then "T" else " "
1195                         in e ++ t ++ "  " ++ i
1196
1197 \end{code}