2 % (c) The University of Glasgow, 2006
5 -- | Package manipulation
9 -- * The PackageConfigMap
10 PackageConfigMap, emptyPackageConfigMap, lookupPackage,
11 extendPackageConfigMap, dumpPackages,
13 -- * Reading the package config, and processing cmdline args
17 lookupModuleInAllPackages, lookupModuleWithSuggestions,
19 -- * Inspecting the set of packages in scope
20 getPackageIncludePath,
21 getPackageLibraryPath,
23 getPackageExtraCcOpts,
24 getPackageFrameworkPath,
26 getPreloadPackagesAnd,
28 collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
36 #include "HsVersions.h"
41 import Config ( cProjectVersion )
42 import Name ( Name, nameModule_maybe )
50 import System.Environment ( getEnv )
51 import Distribution.InstalledPackageInfo
52 import Distribution.InstalledPackageInfo.Binary
53 import Distribution.Package hiding (PackageId,depends)
55 import ErrUtils ( debugTraceMsg, putMsg, Message )
58 import System.Directory
59 import System.FilePath as FilePath
60 import qualified System.FilePath.Posix as FilePath.Posix
62 import Data.List as List
64 import qualified Data.Map as Map
65 import qualified FiniteMap as Map
66 import qualified Data.Set as Set
68 -- ---------------------------------------------------------------------------
71 -- | Package state is all stored in 'DynFlag's, including the details of
72 -- all packages, which packages are exposed, and which modules they
75 -- The package state is computed by 'initPackages', and kept in DynFlags.
77 -- * @-package <pkg>@ causes @<pkg>@ to become exposed, and all other packages
78 -- with the same name to become hidden.
80 -- * @-hide-package <pkg>@ causes @<pkg>@ to become hidden.
82 -- * Let @exposedPackages@ be the set of packages thus exposed.
83 -- Let @depExposedPackages@ be the transitive closure from @exposedPackages@ of
84 -- their dependencies.
86 -- * When searching for a module from an preload import declaration,
87 -- only the exposed modules in @exposedPackages@ are valid.
89 -- * When searching for a module from an implicit import, all modules
90 -- from @depExposedPackages@ are valid.
92 -- * When linking in a compilation manager mode, we link in packages the
93 -- program depends on (the compiler knows this list by the
94 -- time it gets to the link step). Also, we link in all packages
95 -- which were mentioned with preload @-package@ flags on the command-line,
96 -- or are a transitive dependency of same, or are \"base\"\/\"rts\".
97 -- The reason for this is that we might need packages which don't
98 -- contain any Haskell modules, and therefore won't be discovered
99 -- by the normal mechanism of dependency tracking.
103 -- When compiling module A, which imports module B, we need to
104 -- know whether B will be in the same DLL as A.
105 -- If it's in the same DLL, we refer to B_f_closure
106 -- If it isn't, we refer to _imp__B_f_closure
107 -- When compiling A, we record in B's Module value whether it's
108 -- in a different DLL, by setting the DLL flag.
110 data PackageState = PackageState {
111 pkgIdMap :: PackageConfigMap, -- PackageId -> PackageConfig
112 -- The exposed flags are adjusted according to -package and
113 -- -hide-package flags, and -ignore-package removes packages.
115 preloadPackages :: [PackageId],
116 -- The packages we're going to link in eagerly. This list
117 -- should be in reverse dependency order; that is, a package
118 -- is always mentioned before the packages it depends on.
120 moduleToPkgConfAll :: UniqFM [(PackageConfig,Bool)], -- ModuleEnv mapping
121 -- Derived from pkgIdMap.
122 -- Maps Module to (pkgconf,exposed), where pkgconf is the
123 -- PackageConfig for the package containing the module, and
124 -- exposed is True if the package exposes that module.
126 installedPackageIdMap :: InstalledPackageIdMap
129 -- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig'
130 type PackageConfigMap = UniqFM PackageConfig
132 type InstalledPackageIdMap = Map InstalledPackageId PackageId
134 type InstalledPackageIndex = Map InstalledPackageId PackageConfig
136 emptyPackageConfigMap :: PackageConfigMap
137 emptyPackageConfigMap = emptyUFM
139 -- | Find the package we know about with the given id (e.g. \"foo-1.0\"), if any
140 lookupPackage :: PackageConfigMap -> PackageId -> Maybe PackageConfig
141 lookupPackage = lookupUFM
143 extendPackageConfigMap
144 :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
145 extendPackageConfigMap pkg_map new_pkgs
146 = foldl add pkg_map new_pkgs
147 where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
149 -- | Looks up the package with the given id in the package state, panicing if it is
151 getPackageDetails :: PackageState -> PackageId -> PackageConfig
152 getPackageDetails ps pid = expectJust "getPackageDetails" (lookupPackage (pkgIdMap ps) pid)
154 -- ----------------------------------------------------------------------------
155 -- Loading the package config files and building up the package state
157 -- | Call this after 'DynFlags.parseDynFlags'. It reads the package
158 -- configuration files, and sets up various internal tables of package
159 -- information, according to the package-related flags on the
160 -- command-line (@-package@, @-hide-package@ etc.)
162 -- Returns a list of packages to link in if we're doing dynamic linking.
163 -- This list contains the packages that the user explicitly mentioned with
166 -- 'initPackages' can be called again subsequently after updating the
167 -- 'packageFlags' field of the 'DynFlags', and it will update the
168 -- 'pkgState' in 'DynFlags' and return a list of packages to
170 initPackages :: DynFlags -> IO (DynFlags, [PackageId])
171 initPackages dflags = do
172 pkg_db <- case pkgDatabase dflags of
173 Nothing -> readPackageConfigs dflags
174 Just db -> return $ maybeHidePackages dflags db
175 (pkg_state, preload, this_pkg)
176 <- mkPackageState dflags pkg_db [] (thisPackage dflags)
177 return (dflags{ pkgDatabase = Just pkg_db,
178 pkgState = pkg_state,
179 thisPackage = this_pkg },
182 -- -----------------------------------------------------------------------------
183 -- Reading the package database(s)
185 readPackageConfigs :: DynFlags -> IO [PackageConfig]
186 readPackageConfigs dflags = do
187 e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
188 system_pkgconfs <- getSystemPackageConfigs dflags
190 let pkgconfs = case e_pkg_path of
191 Left _ -> system_pkgconfs
193 | last cs == "" -> init cs ++ system_pkgconfs
195 where cs = parseSearchPath path
196 -- if the path ends in a separator (eg. "/foo/bar:")
197 -- the we tack on the system paths.
199 pkgs <- mapM (readPackageConfig dflags)
200 (pkgconfs ++ reverse (extraPkgConfs dflags))
201 -- later packages shadow earlier ones. extraPkgConfs
202 -- is in the opposite order to the flags on the
208 getSystemPackageConfigs :: DynFlags -> IO [FilePath]
209 getSystemPackageConfigs dflags = do
210 -- System one always comes first
211 let system_pkgconf = systemPackageConfig dflags
213 -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
214 -- unless the -no-user-package-conf flag was given.
216 if not (dopt Opt_ReadUserPackageConf dflags) then return [] else do
217 appdir <- getAppUserDataDirectory "ghc"
219 dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
220 pkgconf = dir </> "package.conf.d"
222 exist <- doesDirectoryExist pkgconf
223 if exist then return [pkgconf] else return []
224 `catchIO` (\_ -> return [])
226 return (system_pkgconf : user_pkgconf)
228 readPackageConfig :: DynFlags -> FilePath -> IO [PackageConfig]
229 readPackageConfig dflags conf_file = do
230 isdir <- doesDirectoryExist conf_file
234 then do let filename = conf_file </> "package.cache"
235 debugTraceMsg dflags 2 (text "Using binary package database:" <+> text filename)
236 conf <- readBinPackageDB filename
237 return (map installedPackageInfoToPackageConfig conf)
240 isfile <- doesFileExist conf_file
242 ghcError $ InstallationError $
243 "can't find a package database at " ++ conf_file
244 debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
245 str <- readFile conf_file
246 return (map installedPackageInfoToPackageConfig $ read str)
249 top_dir = topDir dflags
250 pkgroot = takeDirectory conf_file
251 pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
252 pkg_configs2 = maybeHidePackages dflags pkg_configs1
256 maybeHidePackages :: DynFlags -> [PackageConfig] -> [PackageConfig]
257 maybeHidePackages dflags pkgs
258 | dopt Opt_HideAllPackages dflags = map hide pkgs
261 hide pkg = pkg{ exposed = False }
263 mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
264 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
265 -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
266 -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
267 -- The "pkgroot" is the directory containing the package database.
269 -- Also perform a similar substitution for the older GHC-specific
270 -- "$topdir" variable. The "topdir" is the location of the ghc
271 -- installation (obtained from the -B option).
272 mungePackagePaths top_dir pkgroot pkg =
274 importDirs = munge_paths (importDirs pkg),
275 includeDirs = munge_paths (includeDirs pkg),
276 libraryDirs = munge_paths (libraryDirs pkg),
277 frameworkDirs = munge_paths (frameworkDirs pkg),
278 haddockInterfaces = munge_paths (haddockInterfaces pkg),
279 haddockHTMLs = munge_urls (haddockHTMLs pkg)
282 munge_paths = map munge_path
283 munge_urls = map munge_url
286 | Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
287 | Just p' <- stripVarPrefix "$topdir" sp = top_dir </> p'
293 | Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
294 | Just p' <- stripVarPrefix "$httptopdir" sp = toUrlPath top_dir p'
299 toUrlPath r p = "file:///"
300 -- URLs always use posix style '/' separators:
301 ++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
303 stripVarPrefix var (root:path')
304 | Just [sep] <- stripPrefix var root
305 , isPathSeparator sep
306 = Just (joinPath path')
308 stripVarPrefix _ _ = Nothing
311 -- -----------------------------------------------------------------------------
312 -- Modify our copy of the package database based on a package flag
313 -- (-package, -hide-package, -ignore-package).
317 -> [PackageConfig] -- Initial database
318 -> PackageFlag -- flag to apply
319 -> IO [PackageConfig] -- new database
321 applyPackageFlag unusable pkgs flag =
324 case selectPackages (matchingStr str) pkgs unusable of
325 Left ps -> packageFlagErr flag ps
326 Right (p:ps,qs) -> return (p':ps')
327 where p' = p {exposed=True}
328 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
329 _ -> panic "applyPackageFlag"
331 ExposePackageId str ->
332 case selectPackages (matchingId str) pkgs unusable of
333 Left ps -> packageFlagErr flag ps
334 Right (p:ps,qs) -> return (p':ps')
335 where p' = p {exposed=True}
336 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
337 _ -> panic "applyPackageFlag"
340 case selectPackages (matchingStr str) pkgs unusable of
341 Left ps -> packageFlagErr flag ps
342 Right (ps,qs) -> return (map hide ps ++ qs)
343 where hide p = p {exposed=False}
345 _ -> panic "applyPackageFlag"
348 -- When a package is requested to be exposed, we hide all other
349 -- packages with the same name.
350 hideAll name ps = map maybe_hide ps
352 | pkgName (sourcePackageId p) == name = p {exposed=False}
356 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
358 -> Either [(PackageConfig, UnusablePackageReason)]
359 ([PackageConfig], [PackageConfig])
360 selectPackages matches pkgs unusable
362 (ps,rest) = partition matches pkgs
363 reasons = [ (p, Map.lookup (installedPackageId p) unusable)
366 if all (isJust.snd) reasons
367 then Left [ (p, reason) | (p,Just reason) <- reasons ]
368 else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
370 -- A package named on the command line can either include the
371 -- version, or just the name if it is unambiguous.
372 matchingStr :: String -> PackageConfig -> Bool
374 = str == display (sourcePackageId p)
375 || str == display (pkgName (sourcePackageId p))
377 matchingId :: String -> PackageConfig -> Bool
378 matchingId str p = InstalledPackageId str == installedPackageId p
380 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
381 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
383 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
384 comparing f a b = f a `compare` f b
386 packageFlagErr :: PackageFlag
387 -> [(PackageConfig, UnusablePackageReason)]
390 -- for missing DPH package we emit a more helpful error message, because
391 -- this may be the result of using -fdph-par or -fdph-seq.
392 packageFlagErr (ExposePackage pkg) [] | is_dph_package pkg
393 = ghcError (CmdLineError (showSDoc $ dph_err))
394 where dph_err = text "the " <> text pkg <> text " package is not installed."
395 $$ text "To install it: \"cabal install dph\"."
396 is_dph_package pkg = "dph" `isPrefixOf` pkg
398 packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
399 where err = text "cannot satisfy " <> ppr_flag <>
400 (if null reasons then empty else text ": ") $$
401 nest 4 (ppr_reasons $$
402 text "(use -v for more information)")
403 ppr_flag = case flag of
404 IgnorePackage p -> text "-ignore-package " <> text p
405 HidePackage p -> text "-hide-package " <> text p
406 ExposePackage p -> text "-package " <> text p
407 ExposePackageId p -> text "-package-id " <> text p
408 ppr_reasons = vcat (map ppr_reason reasons)
409 ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
411 -- -----------------------------------------------------------------------------
412 -- Hide old versions of packages
415 -- hide all packages for which there is also a later version
416 -- that is already exposed. This just makes it non-fatal to have two
417 -- versions of a package exposed, which can happen if you install a
418 -- later version of a package in the user database, for example.
420 hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
421 hideOldPackages dflags pkgs = mapM maybe_hide pkgs
423 | not (exposed p) = return p
424 | (p' : _) <- later_versions = do
425 debugTraceMsg dflags 2 $
426 (ptext (sLit "hiding package") <+> pprSPkg p <+>
427 ptext (sLit "to avoid conflict with later version") <+>
429 return (p {exposed=False})
430 | otherwise = return p
431 where myname = pkgName (sourcePackageId p)
432 myversion = pkgVersion (sourcePackageId p)
433 later_versions = [ p | p <- pkgs, exposed p,
434 let pkg = sourcePackageId p,
435 pkgName pkg == myname,
436 pkgVersion pkg > myversion ]
438 -- -----------------------------------------------------------------------------
443 -> [PackageConfig] -- database
444 -> IO [PackageConfig]
446 findWiredInPackages dflags pkgs = do
448 -- Now we must find our wired-in packages, and rename them to
449 -- their canonical names (eg. base-1.0 ==> base).
452 wired_in_pkgids :: [String]
453 wired_in_pkgids = map packageIdString
462 matches :: PackageConfig -> String -> Bool
463 pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
465 -- find which package corresponds to each wired-in package
466 -- delete any other packages with the same name
467 -- update the package and any dependencies to point to the new
470 -- When choosing which package to map to a wired-in package
471 -- name, we prefer exposed packages, and pick the latest
472 -- version. To override the default choice, -hide-package
473 -- could be used to hide newer versions.
475 findWiredInPackage :: [PackageConfig] -> String
476 -> IO (Maybe InstalledPackageId)
477 findWiredInPackage pkgs wired_pkg =
478 let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
481 many -> pick (head (sortByVersion many))
484 debugTraceMsg dflags 2 $
485 ptext (sLit "wired-in package ")
487 <> ptext (sLit " not found.")
489 pick :: InstalledPackageInfo_ ModuleName
490 -> IO (Maybe InstalledPackageId)
492 debugTraceMsg dflags 2 $
493 ptext (sLit "wired-in package ")
495 <> ptext (sLit " mapped to ")
497 return (Just (installedPackageId pkg))
500 mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
502 wired_in_ids = catMaybes mb_wired_in_ids
504 -- this is old: we used to assume that if there were
505 -- multiple versions of wired-in packages installed that
506 -- they were mutually exclusive. Now we're assuming that
507 -- you have one "main" version of each wired-in package
508 -- (the latest version), and the others are backward-compat
509 -- wrappers that depend on this one. e.g. base-4.0 is the
510 -- latest, base-3.0 is a compat wrapper depending on base-4.0.
512 deleteOtherWiredInPackages pkgs = filterOut bad pkgs
513 where bad p = any (p `matches`) wired_in_pkgids
514 && package p `notElem` map fst wired_in_ids
517 updateWiredInDependencies pkgs = map upd_pkg pkgs
519 | installedPackageId p `elem` wired_in_ids
520 = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
524 return $ updateWiredInDependencies pkgs
526 -- ----------------------------------------------------------------------------
528 data UnusablePackageReason
530 | MissingDependencies [InstalledPackageId]
531 | ShadowedBy InstalledPackageId
533 type UnusablePackages = Map InstalledPackageId UnusablePackageReason
535 pprReason :: SDoc -> UnusablePackageReason -> SDoc
536 pprReason pref reason = case reason of
538 pref <+> ptext (sLit "ignored due to an -ignore-package flag")
539 MissingDependencies deps ->
541 ptext (sLit "unusable due to missing or recursive dependencies:") $$
542 nest 2 (hsep (map (text.display) deps))
544 pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
546 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
547 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
549 report (ipid, reason) =
550 debugTraceMsg dflags 2 $
552 (ptext (sLit "package") <+>
553 text (display ipid) <+> text "is") reason
555 -- ----------------------------------------------------------------------------
557 -- Detect any packages that have missing dependencies, and also any
558 -- mutually-recursive groups of packages (loops in the package graph
559 -- are not allowed). We do this by taking the least fixpoint of the
560 -- dependency graph, repeatedly adding packages whose dependencies are
561 -- satisfied until no more can be added.
563 findBroken :: [PackageConfig] -> UnusablePackages
564 findBroken pkgs = go [] Map.empty pkgs
566 go avail ipids not_avail =
567 case partitionWith (depsAvailable ipids) not_avail of
569 Map.fromList [ (installedPackageId p, MissingDependencies deps)
570 | (p,deps) <- not_avail ]
571 (new_avail, not_avail) ->
572 go (new_avail ++ avail) new_ipids (map fst not_avail)
573 where new_ipids = Map.insertList
574 [ (installedPackageId p, p) | p <- new_avail ]
577 depsAvailable :: InstalledPackageIndex
579 -> Either PackageConfig (PackageConfig, [InstalledPackageId])
580 depsAvailable ipids pkg
581 | null dangling = Left pkg
582 | otherwise = Right (pkg, dangling)
583 where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
585 -- -----------------------------------------------------------------------------
586 -- Eliminate shadowed packages, giving the user some feedback
588 -- later packages in the list should shadow earlier ones with the same
589 -- package name/version. Additionally, a package may be preferred if
590 -- it is in the transitive closure of packages selected using -package-id
592 shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
593 shadowPackages pkgs preferred
594 = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
595 in Map.fromList shadowed
597 check (shadowed,pkgmap) pkg
598 | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
600 ipid_new = installedPackageId pkg
601 ipid_old = installedPackageId oldpkg
603 , ipid_old /= ipid_new
604 = if ipid_old `elem` preferred
605 then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
606 else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
608 = (shadowed, pkgmap')
610 pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
612 -- -----------------------------------------------------------------------------
614 ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
615 ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
617 doit (IgnorePackage str) =
618 case partition (matchingStr str) pkgs of
619 (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
621 -- missing package is not an error for -ignore-package,
622 -- because a common usage is to -ignore-package P as
623 -- a preventative measure just in case P exists.
624 doit _ = panic "ignorePackages"
626 -- -----------------------------------------------------------------------------
628 depClosure :: InstalledPackageIndex
629 -> [InstalledPackageId]
630 -> [InstalledPackageId]
631 depClosure index ipids = closure Map.empty ipids
633 closure set [] = Map.keys set
634 closure set (ipid : ipids)
635 | ipid `Map.member` set = closure set ipids
636 | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
638 | otherwise = closure set ipids
640 -- -----------------------------------------------------------------------------
641 -- When all the command-line options are in, we can process our package
642 -- settings and populate the package state.
646 -> [PackageConfig] -- initial database
647 -> [PackageId] -- preloaded packages
648 -> PackageId -- this package
650 [PackageId], -- new packages to preload
651 PackageId) -- this package, might be modified if the current
652 -- package is a wired-in package.
654 mkPackageState dflags pkgs0 preload0 this_package = do
659 1. P = transitive closure of packages selected by -package-id
661 2. Apply shadowing. When there are multiple packages with the same
663 * if one is in P, use that one
664 * otherwise, use the one highest in the package stack
666 rationale: we cannot use two packages with the same sourcePackageId
667 in the same program, because sourcePackageId is the symbol prefix.
668 Hence we must select a consistent set of packages to use. We have
669 a default algorithm for doing this: packages higher in the stack
670 shadow those lower down. This default algorithm can be overriden
671 by giving explicit -package-id flags; then we have to take these
672 preferences into account when selecting which other packages are
675 Our simple algorithm throws away some solutions: there may be other
676 consistent sets that would satisfy the -package flags, but it's
677 not GHC's job to be doing constraint solving.
680 3. remove packages selected by -ignore-package
682 4. remove any packages with missing dependencies, or mutually recursive
685 5. report (with -v) any packages that were removed by steps 2-4
687 6. apply flags to set exposed/hidden on the resulting packages
688 - if any flag refers to a package which was removed by 2-4, then
689 we can give an error message explaining why
691 7. hide any packages which are superseded by later exposed packages
695 flags = reverse (packageFlags dflags) ++ dphPackage
696 -- expose the appropriate DPH backend library
697 dphPackage = case dphBackend dflags of
698 DPHPar -> [ExposePackage "dph-prim-par", ExposePackage "dph-par"]
699 DPHSeq -> [ExposePackage "dph-prim-seq", ExposePackage "dph-seq"]
703 -- pkgs0 with duplicate packages filtered out. This is
704 -- important: it is possible for a package in the global package
705 -- DB to have the same IPID as a package in the user DB, and
706 -- we want the latter to take precedence. This is not the same
707 -- as shadowing (below), since in this case the two packages
708 -- have the same ABI and are interchangeable.
710 -- #4072: note that we must retain the ordering of the list here
711 -- so that shadowing behaves as expected when we apply it later.
712 pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
714 | pid `Set.member` s = (s,ps)
715 | otherwise = (Set.insert pid s, p:ps)
716 where pid = installedPackageId p
717 -- XXX this is just a variant of nub
719 ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
721 ipid_selected = depClosure ipid_map [ InstalledPackageId i
722 | ExposePackageId i <- flags ]
724 (ignore_flags, other_flags) = partition is_ignore flags
725 is_ignore IgnorePackage{} = True
728 shadowed = shadowPackages pkgs0_unique ipid_selected
730 ignored = ignorePackages ignore_flags pkgs0_unique
732 pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
733 broken = findBroken pkgs0'
734 unusable = shadowed `Map.union` ignored `Map.union` broken
736 reportUnusable dflags unusable
739 -- Modify the package database according to the command-line flags
740 -- (-package, -hide-package, -ignore-package, -hide-all-packages).
742 pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags
743 let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
745 -- Here we build up a set of the packages mentioned in -package
746 -- flags on the command line; these are called the "preload"
747 -- packages. we link these packages in eagerly. The preload set
748 -- should contain at least rts & base, which is why we pretend that
749 -- the command line contains -package rts & -package base.
751 let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
753 get_exposed (ExposePackage s) = filter (matchingStr s) pkgs2
754 get_exposed (ExposePackageId s) = filter (matchingId s) pkgs2
757 -- hide packages that are subsumed by later versions
758 pkgs3 <- hideOldPackages dflags pkgs2
760 -- sort out which packages are wired in
761 pkgs4 <- findWiredInPackages dflags pkgs3
763 let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
765 ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
768 lookupIPID ipid@(InstalledPackageId str)
769 | Just pid <- Map.lookup ipid ipid_map = return pid
770 | otherwise = missingPackageErr str
772 preload2 <- mapM lookupIPID preload1
775 -- add base & rts to the preload packages
777 | dopt Opt_AutoLinkPackages dflags
778 = filter (flip elemUFM pkg_db) [basePackageId, rtsPackageId]
780 -- but in any case remove the current package from the set of
781 -- preloaded packages so that base/rts does not end up in the
782 -- set up preloaded package when we are just building it
783 preload3 = nub $ filter (/= this_package)
784 $ (basicLinkedPackages ++ preload2)
786 -- Close the preload packages with their dependencies
787 dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
788 let new_dep_preload = filter (`notElem` preload0) dep_preload
790 let pstate = PackageState{ preloadPackages = dep_preload,
792 moduleToPkgConfAll = mkModuleMap pkg_db,
793 installedPackageIdMap = ipid_map
796 return (pstate, new_dep_preload, this_package)
799 -- -----------------------------------------------------------------------------
800 -- Make the mapping from module to package info
804 -> UniqFM [(PackageConfig, Bool)]
805 mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
807 pkgids = map packageConfigId (eltsUFM pkg_db)
809 extend_modmap pkgid modmap =
810 addListToUFM_C (++) modmap
811 ([(m, [(pkg, True)]) | m <- exposed_mods] ++
812 [(m, [(pkg, False)]) | m <- hidden_mods])
814 pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
815 exposed_mods = exposedModules pkg
816 hidden_mods = hiddenModules pkg
818 pprSPkg :: PackageConfig -> SDoc
819 pprSPkg p = text (display (sourcePackageId p))
821 pprIPkg :: PackageConfig -> SDoc
822 pprIPkg p = text (display (installedPackageId p))
824 -- -----------------------------------------------------------------------------
825 -- Extracting information from the packages in scope
827 -- Many of these functions take a list of packages: in those cases,
828 -- the list is expected to contain the "dependent packages",
829 -- i.e. those packages that were found to be depended on by the
830 -- current module/program. These can be auto or non-auto packages, it
831 -- doesn't really matter. The list is always combined with the list
832 -- of preload (command-line) packages to determine which packages to
835 -- | Find all the include directories in these and the preload packages
836 getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
837 getPackageIncludePath dflags pkgs =
838 collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
840 collectIncludeDirs :: [PackageConfig] -> [FilePath]
841 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
843 -- | Find all the library paths in these and the preload packages
844 getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String]
845 getPackageLibraryPath dflags pkgs =
846 collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
848 collectLibraryPaths :: [PackageConfig] -> [FilePath]
849 collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
851 -- | Find all the link options in these and the preload packages
852 getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
853 getPackageLinkOpts dflags pkgs =
854 collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
856 collectLinkOpts :: DynFlags -> [PackageConfig] -> [String]
857 collectLinkOpts dflags ps = concat (map all_opts ps)
859 libs p = packageHsLibs dflags p ++ extraLibraries p
860 all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
862 packageHsLibs :: DynFlags -> PackageConfig -> [String]
863 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
867 ways1 = filter ((/= WayDyn) . wayName) ways0
868 -- the name of a shared library is libHSfoo-ghc<version>.so
869 -- we leave out the _dyn, because it is superfluous
871 -- debug RTS includes support for -eventlog
872 ways2 | WayDebug `elem` map wayName ways1
873 = filter ((/= WayEventLog) . wayName) ways1
877 tag = mkBuildTag (filter (not . wayRTSOnly) ways2)
878 rts_tag = mkBuildTag ways2
880 mkDynName | opt_Static = id
881 | otherwise = (++ ("-ghc" ++ cProjectVersion))
883 addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
884 addSuffix other_lib = other_lib ++ (expandTag tag)
886 expandTag t | null t = ""
889 -- | Find all the C-compiler options in these and the preload packages
890 getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
891 getPackageExtraCcOpts dflags pkgs = do
892 ps <- getPreloadPackagesAnd dflags pkgs
893 return (concatMap ccOptions ps)
895 -- | Find all the package framework paths in these and the preload packages
896 getPackageFrameworkPath :: DynFlags -> [PackageId] -> IO [String]
897 getPackageFrameworkPath dflags pkgs = do
898 ps <- getPreloadPackagesAnd dflags pkgs
899 return (nub (filter notNull (concatMap frameworkDirs ps)))
901 -- | Find all the package frameworks in these and the preload packages
902 getPackageFrameworks :: DynFlags -> [PackageId] -> IO [String]
903 getPackageFrameworks dflags pkgs = do
904 ps <- getPreloadPackagesAnd dflags pkgs
905 return (concatMap frameworks ps)
907 -- -----------------------------------------------------------------------------
910 -- | Takes a 'Module', and if the module is in a package returns
911 -- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
912 -- and exposed is @True@ if the package exposes the module.
913 lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
914 lookupModuleInAllPackages dflags m
915 = case lookupModuleWithSuggestions dflags m of
919 lookupModuleWithSuggestions
920 :: DynFlags -> ModuleName
921 -> Either [Module] [(PackageConfig,Bool)]
922 -- Lookup module in all packages
923 -- Right pbs => found in pbs
924 -- Left ms => not found; but here are sugestions
925 lookupModuleWithSuggestions dflags m
926 = case lookupUFM (moduleToPkgConfAll pkg_state) m of
927 Nothing -> Left suggestions
930 pkg_state = pkgState dflags
932 | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods
935 all_mods :: [(String, Module)] -- All modules
936 all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
937 | pkg_config <- eltsUFM (pkgIdMap pkg_state)
938 , let pkg_id = packageConfigId pkg_config
939 , mod_nm <- exposedModules pkg_config ]
941 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
943 getPreloadPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig]
944 getPreloadPackagesAnd dflags pkgids =
946 state = pkgState dflags
947 pkg_map = pkgIdMap state
948 ipid_map = installedPackageIdMap state
949 preload = preloadPackages state
950 pairs = zip pkgids (repeat Nothing)
952 all_pkgs <- throwErr (foldM (add_package pkg_map ipid_map) preload pairs)
953 return (map (getPackageDetails state) all_pkgs)
955 -- Takes a list of packages, and returns the list with dependencies included,
956 -- in reverse dependency order (a package appears before those it depends on).
957 closeDeps :: PackageConfigMap
958 -> Map InstalledPackageId PackageId
959 -> [(PackageId, Maybe PackageId)]
961 closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps)
963 throwErr :: MaybeErr Message a -> IO a
964 throwErr m = case m of
965 Failed e -> ghcError (CmdLineError (showSDoc e))
966 Succeeded r -> return r
968 closeDepsErr :: PackageConfigMap
969 -> Map InstalledPackageId PackageId
970 -> [(PackageId,Maybe PackageId)]
971 -> MaybeErr Message [PackageId]
972 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
975 add_package :: PackageConfigMap
976 -> Map InstalledPackageId PackageId
978 -> (PackageId,Maybe PackageId)
979 -> MaybeErr Message [PackageId]
980 add_package pkg_db ipid_map ps (p, mb_parent)
981 | p `elem` ps = return ps -- Check if we've already added this package
983 case lookupPackage pkg_db p of
984 Nothing -> Failed (missingPackageMsg (packageIdString p) <>
985 missingDependencyMsg mb_parent)
987 -- Add the package's dependents also
988 ps' <- foldM add_package_ipid ps (depends pkg)
991 add_package_ipid ps ipid@(InstalledPackageId str)
992 | Just pid <- Map.lookup ipid ipid_map
993 = add_package pkg_db ipid_map ps (pid, Just p)
995 = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
997 missingPackageErr :: String -> IO a
998 missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p)))
1000 missingPackageMsg :: String -> SDoc
1001 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
1003 missingDependencyMsg :: Maybe PackageId -> SDoc
1004 missingDependencyMsg Nothing = empty
1005 missingDependencyMsg (Just parent)
1006 = space <> parens (ptext (sLit "dependency of") <+> ftext (packageIdFS parent))
1008 -- -----------------------------------------------------------------------------
1010 -- | Will the 'Name' come from a dynamically linked library?
1011 isDllName :: PackageId -> Name -> Bool
1012 -- Despite the "dll", I think this function just means that
1013 -- the synbol comes from another dynamically-linked package,
1014 -- and applies on all platforms, not just Windows
1015 isDllName this_pkg name
1016 | opt_Static = False
1017 | Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg
1018 | otherwise = False -- no, it is not even an external name
1020 -- -----------------------------------------------------------------------------
1021 -- Displaying packages
1023 -- | Show package info on console, if verbosity is >= 3
1024 dumpPackages :: DynFlags -> IO ()
1026 = do let pkg_map = pkgIdMap (pkgState dflags)
1028 vcat (map (text . showInstalledPackageInfo
1029 . packageConfigToInstalledPackageInfo)