% Package manipulation
%
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module Packages (
module PackageConfig,
import Panic
import Outputable
-#if __GLASGOW_HASKELL__ < 603
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
import Compat.Directory ( getAppUserDataDirectory )
#endif
import ErrUtils ( debugTraceMsg, putMsg, Message )
import System.Directory
+import System.FilePath
import Data.Maybe
import Control.Monad
import Data.List
-- to maintain the package database on systems with a package
-- management system, or systems that don't want to run ghc-pkg
-- to register or unregister packages. Undocumented feature for now.
- let system_pkgconf_dir = system_pkgconf ++ ".d"
+ let system_pkgconf_dir = system_pkgconf <.> "d"
system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
system_pkgconfs <-
if system_pkgconf_dir_exists
then do files <- getDirectoryContents system_pkgconf_dir
- return [ system_pkgconf_dir ++ '/' : file
+ return [ system_pkgconf_dir </> file
| file <- files
- , isSuffixOf ".conf" file]
+ , takeExtension file == ".conf" ]
else return []
-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
appdir <- getAppUserDataDirectory "ghc"
let
pkgconf = appdir
- `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
- `joinFileName` "package.conf"
+ </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+ </> "package.conf"
flg <- doesFileExist pkgconf
if (flg && dopt Opt_ReadUserPackageConf dflags)
then return [pkgconf]
munge_paths = map munge_path
munge_path p
- | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
+ | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
+ | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
| otherwise = p
+ toHttpPath p = "file:///" ++ p
+
-- -----------------------------------------------------------------------------
-- Modify our copy of the package database based on a package flag
wired_in_pkgids = [ basePackageId,
rtsPackageId,
haskell98PackageId,
- thPackageId ]
+ thPackageId,
+ ndpPackageId ]
wired_in_names = map packageIdString wired_in_pkgids
-- add base & rts to the preload packages
basicLinkedPackages = filter (flip elemUFM pkg_db)
[basePackageId,rtsPackageId]
- preload2 = nub (basicLinkedPackages ++ map mkPackageId preload1)
+ -- but in any case remove the current package from the set of
+ -- preloaded packages so that base/rts does not end up in the
+ -- set up preloaded package when we are just building it
+ preload2 = nub (filter (/= new_this_pkg)
+ (basicLinkedPackages ++ map mkPackageId preload1))
-- Close the preload packages with their dependencies
dep_preload <- closeDeps pkg_db (zip preload2 (repeat Nothing))
extend_modmap pkgid modmap =
addListToUFM_C (++) modmap
- [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods]
+ ([(m, [(pkg, True)]) | m <- exposed_mods] ++
+ [(m, [(pkg, False)]) | m <- hidden_mods])
where
pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgid)
- exposed_mods = map mkModuleName (exposedModules pkg)
- hidden_mods = map mkModuleName (hiddenModules pkg)
- all_mods = exposed_mods ++ hidden_mods
+ exposed_mods = exposedModules pkg
+ hidden_mods = hiddenModules pkg
pprPkg :: PackageConfig -> SDoc
pprPkg p = text (showPackageId (package p))
let tag = buildTag dflags
rts_tag = rtsBuildTag dflags
let
- imp = if opt_Static then "" else "_dyn"
- libs p = map ((++imp) . addSuffix) (hsLibraries p)
- ++ hACK_dyn (extraLibraries p)
+ mkDynName | opt_Static = id
+ | otherwise = (++ ("-ghc" ++ cProjectVersion))
+ libs p = map (mkDynName . addSuffix) (hsLibraries p)
+ ++ extraLibraries p
all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
- suffix = if null tag then "" else '_':tag
- rts_suffix = if null rts_tag then "" else '_':rts_tag
+ addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
+ addSuffix other_lib = other_lib ++ (expandTag 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 [referring to previous splittage of HSbase into chunks
- -- to work around GNU ld bug]. 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
+ expandTag t | null t = ""
+ | otherwise = '_':t
return (concat (map all_opts ps))
dumpPackages dflags
= do let pkg_map = pkgIdMap (pkgState dflags)
putMsg dflags $
- vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map))
+ vcat (map (text.showInstalledPackageInfo.to_ipi) (eltsUFM pkg_map))
+ where
+ to_ipi pkgconf@InstalledPackageInfo_{ exposedModules = e,
+ hiddenModules = h } =
+ pkgconf{ exposedModules = map moduleNameString e,
+ hiddenModules = map moduleNameString h }
\end{code}
projects / ghc-hetmet.git / blobdiff