-- * Reading the package config, and processing cmdline args
PackageIdH(..), isHomePackage,
- PackageState(..),
+ PackageState(..),
+ mkPackageState,
initPackages,
getPackageDetails,
checkForPackageConflicts,
#ifdef mingw32_TARGET_OS
import Data.List ( isPrefixOf )
#endif
+import Data.List ( isSuffixOf )
import FastString
import EXCEPTION ( throwDyn )
readPackageConfig
:: DynFlags -> PackageConfigMap -> FilePath -> IO PackageConfigMap
readPackageConfig dflags pkg_map conf_file = do
- debugTraceMsg dflags 2 ("Using package config file: " ++ conf_file)
+ debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
proto_pkg_configs <- loadPackageConfig conf_file
top_dir <- getTopDir
let pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
-- versions of a package exposed, which can happen if you install a
-- later version of a package in the user database, for example.
--
- let
- pkgs2 = map maybe_hide pkgs1
- where maybe_hide p
- | a_later_version_is_exposed = p {exposed=False}
- | otherwise = p
- where myname = pkgName (package p)
- myversion = pkgVersion (package p)
- a_later_version_is_exposed
- = not (null [ p | p <- pkgs1, let pkg = package p,
- pkgName pkg == myname,
- pkgVersion pkg > myversion ])
+ let maybe_hide p
+ | not (exposed p) = return p
+ | (p' : _) <- later_versions = do
+ debugTraceMsg dflags 2 $
+ (ptext SLIT("hiding package") <+> text (showPackageId (package p)) <+>
+ ptext SLIT("to avoid conflict with later version") <+>
+ text (showPackageId (package p')))
+ return (p {exposed=False})
+ | otherwise = return p
+ where myname = pkgName (package p)
+ myversion = pkgVersion (package p)
+ later_versions = [ p | p <- pkgs1, exposed p,
+ let pkg = package p,
+ pkgName pkg == myname,
+ pkgVersion pkg > myversion ]
+ a_later_version_is_exposed
+ = not (null later_versions)
+
+ pkgs2 <- mapM maybe_hide pkgs1
--
-- Eliminate any packages which have dangling dependencies (perhaps
-- because the package was removed by -ignore-package).
--
let
elimDanglingDeps pkgs =
- case partition (hasDanglingDeps pkgs) pkgs of
- ([],ps) -> ps
- (ps,qs) -> elimDanglingDeps qs
-
- hasDanglingDeps pkgs p = any dangling (depends p)
+ case partition (not.null.snd) (map (getDanglingDeps pkgs) pkgs) of
+ ([],ps) -> return (map fst ps)
+ (ps,qs) -> do
+ mapM_ reportElim ps
+ elimDanglingDeps (map fst qs)
+
+ reportElim (p, deps) =
+ debugTraceMsg dflags 2 $
+ (ptext SLIT("package") <+> pprPkg p <+>
+ ptext SLIT("will be ignored due to missing dependencies:") $$
+ nest 2 (hsep (map (text.showPackageId) deps)))
+
+ getDanglingDeps pkgs p = (p, filter dangling (depends p))
where dangling pid = pid `notElem` all_pids
all_pids = map package pkgs
--
- let pkgs = elimDanglingDeps pkgs2
- pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
+ pkgs <- elimDanglingDeps pkgs2
+ let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
--
-- Find the transitive closure of dependencies of exposed
--
msg (mod,pkgs) =
text "conflict: module" <+> quotes (ppr mod)
<+> ptext SLIT("is present in multiple packages:")
- <+> hsep (punctuate comma (map (text.showPackageId.package) pkgs))
+ <+> hsep (punctuate comma (map pprPkg pkgs))
modOverlapError overlaps = vcat (map msg overlaps)
where
quotes (ppr mod),
ptext SLIT("belongs to the current program/library"),
ptext SLIT("and also to package"),
- text (showPackageId (package pkg)) ]
+ pprPkg pkg ]
+
+pprPkg :: PackageConfig -> SDoc
+pprPkg p = text (showPackageId (package p))
-- -----------------------------------------------------------------------------
-- Extracting information from the packages in scope
rts_tag = rtsBuildTag dflags
let
imp = if opt_Static then "" else "_dyn"
- libs p = map ((++imp) . addSuffix) (hACK (hsLibraries p)) ++ extraLibraries p
+ libs p = map ((++imp) . addSuffix) (hACK (hsLibraries p))
+ ++ hACK_dyn (extraLibraries p)
all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
suffix = if null tag then "" else '_':tag
addSuffix rts@"HSrts" = rts ++ rts_suffix
addSuffix other_lib = other_lib ++ suffix
+ -- This is a hack that's even more horrible (and hopefully more temporary)
+ -- than the one below. HSbase_cbits and friends require the _dyn suffix
+ -- for dynamic linking, but not _p or other 'way' suffix. So we just add
+ -- _dyn to extraLibraries if they already have a _cbits suffix.
+
+ hACK_dyn = map hack
+ where hack lib | not opt_Static && "_cbits" `isSuffixOf` lib = lib ++ "_dyn"
+ | otherwise = lib
+
return (concat (map all_opts ps))
where
libs
# endif
+
getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
getPackageExtraCcOpts dflags pkgs = do
ps <- getExplicitPackagesAnd dflags pkgs
| p `elem` ps = return ps -- Check if we've already added this package
| otherwise =
case lookupPackage pkg_db p of
- Nothing -> Failed (missingPackageErr (packageIdString p))
+ Nothing -> Failed (missingPackageMsg (packageIdString p))
Just pkg -> do
-- Add the package's dependents also
let deps = map mkPackageId (depends pkg)
return (p : ps')
missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
-missingPackageMsg p = ptext SLIT("unknown package:") <> text p
+missingPackageMsg p = ptext SLIT("unknown package:") <+> text p
-- -----------------------------------------------------------------------------
-- The home module set
-- Show package info on console, if verbosity is >= 3
dumpPackages dflags
= do let pkg_map = pkgIdMap (pkgState dflags)
- putMsg $ showSDoc $
+ putMsg dflags $
vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map))
\end{code}
projects / ghc-hetmet.git / blobdiff