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 -- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
264 mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
265 -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
266 -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
267 -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
268 -- The "pkgroot" is the directory containing the package database.
270 -- Also perform a similar substitution for the older GHC-specific
271 -- "$topdir" variable. The "topdir" is the location of the ghc
272 -- installation (obtained from the -B option).
273 mungePackagePaths top_dir pkgroot pkg =
275 importDirs = munge_paths (importDirs pkg),
276 includeDirs = munge_paths (includeDirs pkg),
277 libraryDirs = munge_paths (libraryDirs pkg),
278 frameworkDirs = munge_paths (frameworkDirs pkg),
279 haddockInterfaces = munge_paths (haddockInterfaces pkg),
280 haddockHTMLs = munge_urls (haddockHTMLs pkg)
283 munge_paths = map munge_path
284 munge_urls = map munge_url
287 | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
288 | Just p' <- stripVarPrefix "$topdir" p = top_dir ++ p'
292 | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
293 | Just p' <- stripVarPrefix "$httptopdir" p = toUrlPath top_dir p'
296 toUrlPath r p = "file:///"
297 -- URLs always use posix style '/' separators:
298 ++ FilePath.Posix.joinPath
299 (r : -- We need to drop a leading "/" or "\\"
301 dropWhile (all isPathSeparator)
302 (FilePath.splitDirectories p))
304 -- We could drop the separator here, and then use </> above. However,
305 -- by leaving it in and using ++ we keep the same path separator
306 -- rather than letting FilePath change it to use \ as the separator
307 stripVarPrefix var path = case stripPrefix var path of
309 Just cs@(c : _) | isPathSeparator c -> Just cs
313 -- -----------------------------------------------------------------------------
314 -- Modify our copy of the package database based on a package flag
315 -- (-package, -hide-package, -ignore-package).
319 -> [PackageConfig] -- Initial database
320 -> PackageFlag -- flag to apply
321 -> IO [PackageConfig] -- new database
323 applyPackageFlag unusable pkgs flag =
326 case selectPackages (matchingStr str) pkgs unusable of
327 Left ps -> packageFlagErr flag ps
328 Right (p:ps,qs) -> return (p':ps')
329 where p' = p {exposed=True}
330 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
331 _ -> panic "applyPackageFlag"
333 ExposePackageId str ->
334 case selectPackages (matchingId str) pkgs unusable of
335 Left ps -> packageFlagErr flag ps
336 Right (p:ps,qs) -> return (p':ps')
337 where p' = p {exposed=True}
338 ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs)
339 _ -> panic "applyPackageFlag"
342 case selectPackages (matchingStr str) pkgs unusable of
343 Left ps -> packageFlagErr flag ps
344 Right (ps,qs) -> return (map hide ps ++ qs)
345 where hide p = p {exposed=False}
347 _ -> panic "applyPackageFlag"
350 -- When a package is requested to be exposed, we hide all other
351 -- packages with the same name.
352 hideAll name ps = map maybe_hide ps
354 | pkgName (sourcePackageId p) == name = p {exposed=False}
358 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
360 -> Either [(PackageConfig, UnusablePackageReason)]
361 ([PackageConfig], [PackageConfig])
362 selectPackages matches pkgs unusable
364 (ps,rest) = partition matches pkgs
365 reasons = [ (p, Map.lookup (installedPackageId p) unusable)
368 if all (isJust.snd) reasons
369 then Left [ (p, reason) | (p,Just reason) <- reasons ]
370 else Right (sortByVersion [ p | (p,Nothing) <- reasons ], rest)
372 -- A package named on the command line can either include the
373 -- version, or just the name if it is unambiguous.
374 matchingStr :: String -> PackageConfig -> Bool
376 = str == display (sourcePackageId p)
377 || str == display (pkgName (sourcePackageId p))
379 matchingId :: String -> PackageConfig -> Bool
380 matchingId str p = InstalledPackageId str == installedPackageId p
382 sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m]
383 sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId)))
385 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
386 comparing f a b = f a `compare` f b
388 packageFlagErr :: PackageFlag
389 -> [(PackageConfig, UnusablePackageReason)]
392 -- for missing DPH package we emit a more helpful error message, because
393 -- this may be the result of using -fdph-par or -fdph-seq.
394 packageFlagErr (ExposePackage pkg) [] | is_dph_package pkg
395 = ghcError (CmdLineError (showSDoc $ dph_err))
396 where dph_err = text "the " <> text pkg <> text " package is not installed."
397 $$ text "To install it: \"cabal install dph\"."
398 is_dph_package pkg = "dph" `isPrefixOf` pkg
400 packageFlagErr flag reasons = ghcError (CmdLineError (showSDoc $ err))
401 where err = text "cannot satisfy " <> ppr_flag <>
402 (if null reasons then empty else text ": ") $$
403 nest 4 (ppr_reasons $$
404 text "(use -v for more information)")
405 ppr_flag = case flag of
406 IgnorePackage p -> text "-ignore-package " <> text p
407 HidePackage p -> text "-hide-package " <> text p
408 ExposePackage p -> text "-package " <> text p
409 ExposePackageId p -> text "-package-id " <> text p
410 ppr_reasons = vcat (map ppr_reason reasons)
411 ppr_reason (p, reason) = pprReason (pprIPkg p <+> text "is") reason
413 -- -----------------------------------------------------------------------------
414 -- Hide old versions of packages
417 -- hide all packages for which there is also a later version
418 -- that is already exposed. This just makes it non-fatal to have two
419 -- versions of a package exposed, which can happen if you install a
420 -- later version of a package in the user database, for example.
422 hideOldPackages :: DynFlags -> [PackageConfig] -> IO [PackageConfig]
423 hideOldPackages dflags pkgs = mapM maybe_hide pkgs
425 | not (exposed p) = return p
426 | (p' : _) <- later_versions = do
427 debugTraceMsg dflags 2 $
428 (ptext (sLit "hiding package") <+> pprSPkg p <+>
429 ptext (sLit "to avoid conflict with later version") <+>
431 return (p {exposed=False})
432 | otherwise = return p
433 where myname = pkgName (sourcePackageId p)
434 myversion = pkgVersion (sourcePackageId p)
435 later_versions = [ p | p <- pkgs, exposed p,
436 let pkg = sourcePackageId p,
437 pkgName pkg == myname,
438 pkgVersion pkg > myversion ]
440 -- -----------------------------------------------------------------------------
445 -> [PackageConfig] -- database
446 -> IO [PackageConfig]
448 findWiredInPackages dflags pkgs = do
450 -- Now we must find our wired-in packages, and rename them to
451 -- their canonical names (eg. base-1.0 ==> base).
454 wired_in_pkgids :: [String]
455 wired_in_pkgids = map packageIdString
464 matches :: PackageConfig -> String -> Bool
465 pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid
467 -- find which package corresponds to each wired-in package
468 -- delete any other packages with the same name
469 -- update the package and any dependencies to point to the new
472 -- When choosing which package to map to a wired-in package
473 -- name, we prefer exposed packages, and pick the latest
474 -- version. To override the default choice, -hide-package
475 -- could be used to hide newer versions.
477 findWiredInPackage :: [PackageConfig] -> String
478 -> IO (Maybe InstalledPackageId)
479 findWiredInPackage pkgs wired_pkg =
480 let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ] in
483 many -> pick (head (sortByVersion many))
486 debugTraceMsg dflags 2 $
487 ptext (sLit "wired-in package ")
489 <> ptext (sLit " not found.")
491 pick :: InstalledPackageInfo_ ModuleName
492 -> IO (Maybe InstalledPackageId)
494 debugTraceMsg dflags 2 $
495 ptext (sLit "wired-in package ")
497 <> ptext (sLit " mapped to ")
499 return (Just (installedPackageId pkg))
502 mb_wired_in_ids <- mapM (findWiredInPackage pkgs) wired_in_pkgids
504 wired_in_ids = catMaybes mb_wired_in_ids
506 -- this is old: we used to assume that if there were
507 -- multiple versions of wired-in packages installed that
508 -- they were mutually exclusive. Now we're assuming that
509 -- you have one "main" version of each wired-in package
510 -- (the latest version), and the others are backward-compat
511 -- wrappers that depend on this one. e.g. base-4.0 is the
512 -- latest, base-3.0 is a compat wrapper depending on base-4.0.
514 deleteOtherWiredInPackages pkgs = filterOut bad pkgs
515 where bad p = any (p `matches`) wired_in_pkgids
516 && package p `notElem` map fst wired_in_ids
519 updateWiredInDependencies pkgs = map upd_pkg pkgs
521 | installedPackageId p `elem` wired_in_ids
522 = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } }
526 return $ updateWiredInDependencies pkgs
528 -- ----------------------------------------------------------------------------
530 data UnusablePackageReason
532 | MissingDependencies [InstalledPackageId]
533 | ShadowedBy InstalledPackageId
535 type UnusablePackages = Map InstalledPackageId UnusablePackageReason
537 pprReason :: SDoc -> UnusablePackageReason -> SDoc
538 pprReason pref reason = case reason of
540 pref <+> ptext (sLit "ignored due to an -ignore-package flag")
541 MissingDependencies deps ->
543 ptext (sLit "unusable due to missing or recursive dependencies:") $$
544 nest 2 (hsep (map (text.display) deps))
546 pref <+> ptext (sLit "shadowed by package ") <> text (display ipid)
548 reportUnusable :: DynFlags -> UnusablePackages -> IO ()
549 reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs)
551 report (ipid, reason) =
552 debugTraceMsg dflags 2 $
554 (ptext (sLit "package") <+>
555 text (display ipid) <+> text "is") reason
557 -- ----------------------------------------------------------------------------
559 -- Detect any packages that have missing dependencies, and also any
560 -- mutually-recursive groups of packages (loops in the package graph
561 -- are not allowed). We do this by taking the least fixpoint of the
562 -- dependency graph, repeatedly adding packages whose dependencies are
563 -- satisfied until no more can be added.
565 findBroken :: [PackageConfig] -> UnusablePackages
566 findBroken pkgs = go [] Map.empty pkgs
568 go avail ipids not_avail =
569 case partitionWith (depsAvailable ipids) not_avail of
571 Map.fromList [ (installedPackageId p, MissingDependencies deps)
572 | (p,deps) <- not_avail ]
573 (new_avail, not_avail) ->
574 go (new_avail ++ avail) new_ipids (map fst not_avail)
575 where new_ipids = Map.insertList
576 [ (installedPackageId p, p) | p <- new_avail ]
579 depsAvailable :: InstalledPackageIndex
581 -> Either PackageConfig (PackageConfig, [InstalledPackageId])
582 depsAvailable ipids pkg
583 | null dangling = Left pkg
584 | otherwise = Right (pkg, dangling)
585 where dangling = filter (not . (`Map.member` ipids)) (depends pkg)
587 -- -----------------------------------------------------------------------------
588 -- Eliminate shadowed packages, giving the user some feedback
590 -- later packages in the list should shadow earlier ones with the same
591 -- package name/version. Additionally, a package may be preferred if
592 -- it is in the transitive closure of packages selected using -package-id
594 shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
595 shadowPackages pkgs preferred
596 = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
597 in Map.fromList shadowed
599 check (shadowed,pkgmap) pkg
600 | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg)
602 ipid_new = installedPackageId pkg
603 ipid_old = installedPackageId oldpkg
605 , ipid_old /= ipid_new
606 = if ipid_old `elem` preferred
607 then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
608 else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
610 = (shadowed, pkgmap')
612 pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
614 -- -----------------------------------------------------------------------------
616 ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
617 ignorePackages flags pkgs = Map.fromList (concatMap doit flags)
619 doit (IgnorePackage str) =
620 case partition (matchingStr str) pkgs of
621 (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
623 -- missing package is not an error for -ignore-package,
624 -- because a common usage is to -ignore-package P as
625 -- a preventative measure just in case P exists.
626 doit _ = panic "ignorePackages"
628 -- -----------------------------------------------------------------------------
630 depClosure :: InstalledPackageIndex
631 -> [InstalledPackageId]
632 -> [InstalledPackageId]
633 depClosure index ipids = closure Map.empty ipids
635 closure set [] = Map.keys set
636 closure set (ipid : ipids)
637 | ipid `Map.member` set = closure set ipids
638 | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set)
640 | otherwise = closure set ipids
642 -- -----------------------------------------------------------------------------
643 -- When all the command-line options are in, we can process our package
644 -- settings and populate the package state.
648 -> [PackageConfig] -- initial database
649 -> [PackageId] -- preloaded packages
650 -> PackageId -- this package
652 [PackageId], -- new packages to preload
653 PackageId) -- this package, might be modified if the current
654 -- package is a wired-in package.
656 mkPackageState dflags pkgs0 preload0 this_package = do
661 1. P = transitive closure of packages selected by -package-id
663 2. Apply shadowing. When there are multiple packages with the same
665 * if one is in P, use that one
666 * otherwise, use the one highest in the package stack
668 rationale: we cannot use two packages with the same sourcePackageId
669 in the same program, because sourcePackageId is the symbol prefix.
670 Hence we must select a consistent set of packages to use. We have
671 a default algorithm for doing this: packages higher in the stack
672 shadow those lower down. This default algorithm can be overriden
673 by giving explicit -package-id flags; then we have to take these
674 preferences into account when selecting which other packages are
677 Our simple algorithm throws away some solutions: there may be other
678 consistent sets that would satisfy the -package flags, but it's
679 not GHC's job to be doing constraint solving.
682 3. remove packages selected by -ignore-package
684 4. remove any packages with missing dependencies, or mutually recursive
687 5. report (with -v) any packages that were removed by steps 2-4
689 6. apply flags to set exposed/hidden on the resulting packages
690 - if any flag refers to a package which was removed by 2-4, then
691 we can give an error message explaining why
693 7. hide any packages which are superseded by later exposed packages
697 flags = reverse (packageFlags dflags) ++ dphPackage
698 -- expose the appropriate DPH backend library
699 dphPackage = case dphBackend dflags of
700 DPHPar -> [ExposePackage "dph-prim-par", ExposePackage "dph-par"]
701 DPHSeq -> [ExposePackage "dph-prim-seq", ExposePackage "dph-seq"]
705 -- pkgs0 with duplicate packages filtered out. This is
706 -- important: it is possible for a package in the global package
707 -- DB to have the same IPID as a package in the user DB, and
708 -- we want the latter to take precedence. This is not the same
709 -- as shadowing (below), since in this case the two packages
710 -- have the same ABI and are interchangeable.
712 -- #4072: note that we must retain the ordering of the list here
713 -- so that shadowing behaves as expected when we apply it later.
714 pkgs0_unique = snd $ foldr del (Set.empty,[]) pkgs0
716 | pid `Set.member` s = (s,ps)
717 | otherwise = (Set.insert pid s, p:ps)
718 where pid = installedPackageId p
719 -- XXX this is just a variant of nub
721 ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
723 ipid_selected = depClosure ipid_map [ InstalledPackageId i
724 | ExposePackageId i <- flags ]
726 (ignore_flags, other_flags) = partition is_ignore flags
727 is_ignore IgnorePackage{} = True
730 shadowed = shadowPackages pkgs0_unique ipid_selected
732 ignored = ignorePackages ignore_flags pkgs0_unique
734 pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique
735 broken = findBroken pkgs0'
736 unusable = shadowed `Map.union` ignored `Map.union` broken
738 reportUnusable dflags unusable
741 -- Modify the package database according to the command-line flags
742 -- (-package, -hide-package, -ignore-package, -hide-all-packages).
744 pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags
745 let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1
747 -- Here we build up a set of the packages mentioned in -package
748 -- flags on the command line; these are called the "preload"
749 -- packages. we link these packages in eagerly. The preload set
750 -- should contain at least rts & base, which is why we pretend that
751 -- the command line contains -package rts & -package base.
753 let preload1 = [ installedPackageId p | f <- flags, p <- get_exposed f ]
755 get_exposed (ExposePackage s) = filter (matchingStr s) pkgs2
756 get_exposed (ExposePackageId s) = filter (matchingId s) pkgs2
759 -- hide packages that are subsumed by later versions
760 pkgs3 <- hideOldPackages dflags pkgs2
762 -- sort out which packages are wired in
763 pkgs4 <- findWiredInPackages dflags pkgs3
765 let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4
767 ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
770 lookupIPID ipid@(InstalledPackageId str)
771 | Just pid <- Map.lookup ipid ipid_map = return pid
772 | otherwise = missingPackageErr str
774 preload2 <- mapM lookupIPID preload1
777 -- add base & rts to the preload packages
779 | dopt Opt_AutoLinkPackages dflags
780 = filter (flip elemUFM pkg_db) [basePackageId, rtsPackageId]
782 -- but in any case remove the current package from the set of
783 -- preloaded packages so that base/rts does not end up in the
784 -- set up preloaded package when we are just building it
785 preload3 = nub $ filter (/= this_package)
786 $ (basicLinkedPackages ++ preload2)
788 -- Close the preload packages with their dependencies
789 dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
790 let new_dep_preload = filter (`notElem` preload0) dep_preload
792 let pstate = PackageState{ preloadPackages = dep_preload,
794 moduleToPkgConfAll = mkModuleMap pkg_db,
795 installedPackageIdMap = ipid_map
798 return (pstate, new_dep_preload, this_package)
801 -- -----------------------------------------------------------------------------
802 -- Make the mapping from module to package info
806 -> UniqFM [(PackageConfig, Bool)]
807 mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids
809 pkgids = map packageConfigId (eltsUFM pkg_db)
811 extend_modmap pkgid modmap =
812 addListToUFM_C (++) modmap
813 ([(m, [(pkg, True)]) | m <- exposed_mods] ++
814 [(m, [(pkg, False)]) | m <- hidden_mods])
816 pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
817 exposed_mods = exposedModules pkg
818 hidden_mods = hiddenModules pkg
820 pprSPkg :: PackageConfig -> SDoc
821 pprSPkg p = text (display (sourcePackageId p))
823 pprIPkg :: PackageConfig -> SDoc
824 pprIPkg p = text (display (installedPackageId p))
826 -- -----------------------------------------------------------------------------
827 -- Extracting information from the packages in scope
829 -- Many of these functions take a list of packages: in those cases,
830 -- the list is expected to contain the "dependent packages",
831 -- i.e. those packages that were found to be depended on by the
832 -- current module/program. These can be auto or non-auto packages, it
833 -- doesn't really matter. The list is always combined with the list
834 -- of preload (command-line) packages to determine which packages to
837 -- | Find all the include directories in these and the preload packages
838 getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
839 getPackageIncludePath dflags pkgs =
840 collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
842 collectIncludeDirs :: [PackageConfig] -> [FilePath]
843 collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
845 -- | Find all the library paths in these and the preload packages
846 getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String]
847 getPackageLibraryPath dflags pkgs =
848 collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
850 collectLibraryPaths :: [PackageConfig] -> [FilePath]
851 collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
853 -- | Find all the link options in these and the preload packages
854 getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
855 getPackageLinkOpts dflags pkgs =
856 collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
858 collectLinkOpts :: DynFlags -> [PackageConfig] -> [String]
859 collectLinkOpts dflags ps = concat (map all_opts ps)
861 libs p = packageHsLibs dflags p ++ extraLibraries p
862 all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
864 packageHsLibs :: DynFlags -> PackageConfig -> [String]
865 packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
869 ways1 = filter ((/= WayDyn) . wayName) ways0
870 -- the name of a shared library is libHSfoo-ghc<version>.so
871 -- we leave out the _dyn, because it is superfluous
873 -- debug RTS includes support for -eventlog
874 ways2 | WayDebug `elem` map wayName ways1
875 = filter ((/= WayEventLog) . wayName) ways1
879 tag = mkBuildTag (filter (not . wayRTSOnly) ways2)
880 rts_tag = mkBuildTag ways2
882 mkDynName | opt_Static = id
883 | otherwise = (++ ("-ghc" ++ cProjectVersion))
885 addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
886 addSuffix other_lib = other_lib ++ (expandTag tag)
888 expandTag t | null t = ""
891 -- | Find all the C-compiler options in these and the preload packages
892 getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
893 getPackageExtraCcOpts dflags pkgs = do
894 ps <- getPreloadPackagesAnd dflags pkgs
895 return (concatMap ccOptions ps)
897 -- | Find all the package framework paths in these and the preload packages
898 getPackageFrameworkPath :: DynFlags -> [PackageId] -> IO [String]
899 getPackageFrameworkPath dflags pkgs = do
900 ps <- getPreloadPackagesAnd dflags pkgs
901 return (nub (filter notNull (concatMap frameworkDirs ps)))
903 -- | Find all the package frameworks in these and the preload packages
904 getPackageFrameworks :: DynFlags -> [PackageId] -> IO [String]
905 getPackageFrameworks dflags pkgs = do
906 ps <- getPreloadPackagesAnd dflags pkgs
907 return (concatMap frameworks ps)
909 -- -----------------------------------------------------------------------------
912 -- | Takes a 'Module', and if the module is in a package returns
913 -- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
914 -- and exposed is @True@ if the package exposes the module.
915 lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
916 lookupModuleInAllPackages dflags m
917 = case lookupModuleWithSuggestions dflags m of
921 lookupModuleWithSuggestions
922 :: DynFlags -> ModuleName
923 -> Either [Module] [(PackageConfig,Bool)]
924 -- Lookup module in all packages
925 -- Right pbs => found in pbs
926 -- Left ms => not found; but here are sugestions
927 lookupModuleWithSuggestions dflags m
928 = case lookupUFM (moduleToPkgConfAll pkg_state) m of
929 Nothing -> Left suggestions
932 pkg_state = pkgState dflags
934 | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods
937 all_mods :: [(String, Module)] -- All modules
938 all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
939 | pkg_config <- eltsUFM (pkgIdMap pkg_state)
940 , let pkg_id = packageConfigId pkg_config
941 , mod_nm <- exposedModules pkg_config ]
943 -- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
945 getPreloadPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig]
946 getPreloadPackagesAnd dflags pkgids =
948 state = pkgState dflags
949 pkg_map = pkgIdMap state
950 ipid_map = installedPackageIdMap state
951 preload = preloadPackages state
952 pairs = zip pkgids (repeat Nothing)
954 all_pkgs <- throwErr (foldM (add_package pkg_map ipid_map) preload pairs)
955 return (map (getPackageDetails state) all_pkgs)
957 -- Takes a list of packages, and returns the list with dependencies included,
958 -- in reverse dependency order (a package appears before those it depends on).
959 closeDeps :: PackageConfigMap
960 -> Map InstalledPackageId PackageId
961 -> [(PackageId, Maybe PackageId)]
963 closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps)
965 throwErr :: MaybeErr Message a -> IO a
966 throwErr m = case m of
967 Failed e -> ghcError (CmdLineError (showSDoc e))
968 Succeeded r -> return r
970 closeDepsErr :: PackageConfigMap
971 -> Map InstalledPackageId PackageId
972 -> [(PackageId,Maybe PackageId)]
973 -> MaybeErr Message [PackageId]
974 closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps
977 add_package :: PackageConfigMap
978 -> Map InstalledPackageId PackageId
980 -> (PackageId,Maybe PackageId)
981 -> MaybeErr Message [PackageId]
982 add_package pkg_db ipid_map ps (p, mb_parent)
983 | p `elem` ps = return ps -- Check if we've already added this package
985 case lookupPackage pkg_db p of
986 Nothing -> Failed (missingPackageMsg (packageIdString p) <>
987 missingDependencyMsg mb_parent)
989 -- Add the package's dependents also
990 ps' <- foldM add_package_ipid ps (depends pkg)
993 add_package_ipid ps ipid@(InstalledPackageId str)
994 | Just pid <- Map.lookup ipid ipid_map
995 = add_package pkg_db ipid_map ps (pid, Just p)
997 = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
999 missingPackageErr :: String -> IO a
1000 missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p)))
1002 missingPackageMsg :: String -> SDoc
1003 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
1005 missingDependencyMsg :: Maybe PackageId -> SDoc
1006 missingDependencyMsg Nothing = empty
1007 missingDependencyMsg (Just parent)
1008 = space <> parens (ptext (sLit "dependency of") <+> ftext (packageIdFS parent))
1010 -- -----------------------------------------------------------------------------
1012 -- | Will the 'Name' come from a dynamically linked library?
1013 isDllName :: PackageId -> Name -> Bool
1014 -- Despite the "dll", I think this function just means that
1015 -- the synbol comes from another dynamically-linked package,
1016 -- and applies on all platforms, not just Windows
1017 isDllName this_pkg name
1018 | opt_Static = False
1019 | Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg
1020 | otherwise = False -- no, it is not even an external name
1022 -- -----------------------------------------------------------------------------
1023 -- Displaying packages
1025 -- | Show package info on console, if verbosity is >= 3
1026 dumpPackages :: DynFlags -> IO ()
1028 = do let pkg_map = pkgIdMap (pkgState dflags)
1030 vcat (map (text . showInstalledPackageInfo
1031 . packageConfigToInstalledPackageInfo)