extendPackageConfigMap, dumpPackages,
-- * Reading the package config, and processing cmdline args
- PackageState(..),
+ PackageIdH(..), isHomePackage,
+ PackageState(..),
initPackages,
moduleToPackageConfig,
getPackageDetails,
#include "HsVersions.h"
import PackageConfig
-import DriverState ( v_Build_tag, v_RTS_Build_tag, v_Static )
import SysTools ( getTopDir, getPackageConfigPath )
import ParsePkgConf ( loadPackageConfig )
-import CmdLineOpts ( DynFlags(..), PackageFlag(..), verbosity,
- opt_Static )
-import Config ( cTARGETARCH, cTARGETOS, cProjectVersion )
+import DynFlags ( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
+import StaticFlags ( opt_Static )
+import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import Module ( Module, mkModule )
import UniqFM
import Distribution.InstalledPackageInfo
import Distribution.Package
+import Distribution.Version
import System.IO ( hPutStrLn, stderr )
-import Data.Version
import Data.Maybe ( fromJust, isNothing )
import System.Directory ( doesFileExist )
import Control.Monad ( when, foldM )
import Data.List ( nub, partition )
+
+#ifdef mingw32_TARGET_OS
+import Data.List ( isPrefixOf )
+#endif
+
import FastString
import DATA_IOREF
import EXCEPTION ( throwDyn )
-- exposed is True if the package exposes that module.
-- The PackageIds of some known packages
- basePackageId :: Maybe PackageId,
- rtsPackageId :: Maybe PackageId,
- haskell98PackageId :: Maybe PackageId,
- thPackageId :: Maybe PackageId
+ basePackageId :: PackageIdH,
+ rtsPackageId :: PackageIdH,
+ haskell98PackageId :: PackageIdH,
+ thPackageId :: PackageIdH
}
+data PackageIdH
+ = HomePackage -- The "home" package is the package curently
+ -- being compiled
+ | ExtPackage PackageId -- An "external" package is any other package
+
+
+isHomePackage :: PackageIdH -> Bool
+isHomePackage HomePackage = True
+isHomePackage (ExtPackage _) = False
+
-- A PackageConfigMap maps a PackageId to a PackageConfig
type PackageConfigMap = UniqFM PackageConfig
-- unless the -no-user-package-conf flag was given.
-- We only do this when getAppUserDataDirectory is available
-- (GHC >= 6.3).
- appdir <- getAppUserDataDirectory "ghc"
- let
- pkgconf = appdir ++ '/':cTARGETARCH ++ '-':cTARGETOS
+ (exists, pkgconf) <- catch (do
+ appdir <- getAppUserDataDirectory "ghc"
+ let
+ pkgconf = appdir ++ '/':TARGET_ARCH ++ '-':TARGET_OS
++ '-':cProjectVersion ++ "/package.conf"
- --
- exists <- doesFileExist pkgconf
- pkg_map2 <- if (readUserPkgConf dflags && exists)
+ flg <- doesFileExist pkgconf
+ return (flg, pkgconf))
+ -- gobble them all up and turn into False.
+ (\ _ -> return (False, ""))
+ pkg_map2 <- if (dopt Opt_ReadUserPackageConf dflags && exists)
then readPackageConfig dflags pkg_map1 pkgconf
else return pkg_map1
:: DynFlags -> PackageConfigMap -> FilePath -> IO PackageConfigMap
readPackageConfig dflags pkg_map conf_file = do
when (verbosity dflags >= 2) $
- hPutStrLn stderr ("Reading package config file: "
+ hPutStrLn stderr ("Using package config file: "
++ conf_file)
proto_pkg_configs <- loadPackageConfig conf_file
top_dir <- getTopDir
mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$libdir" at the beginning of a path
--- with the current libdir (obtained from the -B option).
+-- Replace the string "$topdir" at the beginning of a path
+-- with the current topdir (obtained from the -B option).
mungePackagePaths top_dir ps = map munge_pkg ps
where
munge_pkg p = p{ importDirs = munge_paths (importDirs p),
munge_paths = map munge_path
munge_path p
- | Just p' <- maybePrefixMatch "$libdir" p = top_dir ++ p'
+ | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
| otherwise = p
(ps,_) -> multiplePackagesErr str ps
procflags pkgs expl (IgnorePackage str : flags) = do
case partition (matches str) pkgs of
- ([],_) -> missingPackageErr str
(ps,qs) -> procflags qs expl flags
+ -- missing package is not an error for -ignore-package,
+ -- because a common usage is to -ignore-package P as
+ -- a preventative measure just in case P exists.
-- A package named on the command line can either include the
-- version, or just the name if it is unambiguous.
-- Look up some known PackageIds
--
let
+ lookupPackageByName :: FastString -> PackageIdH
lookupPackageByName nm =
case [ conf | p <- dep_exposed,
Just conf <- [lookupPackage pkg_db p],
nm == mkFastString (pkgName (package conf)) ] of
- [] -> Nothing
- (p:ps) -> Just (mkPackageId (package p))
+ [] -> HomePackage
+ (p:ps) -> ExtPackage (mkPackageId (package p))
-- Get the PackageIds for some known packages (we know the names,
-- but we don't know the versions). Some of these packages might
-- add base & rts to the explicit packages
basicLinkedPackages = [basePackageId,rtsPackageId]
explicit' = addListToUniqSet explicit
- [ p | Just p <- basicLinkedPackages ]
+ [ p | ExtPackage p <- basicLinkedPackages ]
--
-- Close the explicit packages with their dependencies
--
multiplePackagesErr str ps =
throwDyn (CmdLineError (showSDoc (
text "Error; multiple packages match" <+>
- text str <> colon <>
+ text str <> colon <+>
sep (punctuate comma (map (text.showPackageId.package) ps))
)))
getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
getPackageLinkOpts dflags pkgs = do
ps <- getExplicitPackagesAnd dflags pkgs
- tag <- readIORef v_Build_tag
- rts_tag <- readIORef v_RTS_Build_tag
- static <- readIORef v_Static
+ let tag = buildTag dflags
+ rts_tag = rtsBuildTag dflags
let
- imp = if static then "" else "_imp"
- libs p = map addSuffix (hACK (hsLibraries p)) ++ extraLibraries p
- imp_libs p = map (++imp) (libs p)
- all_opts p = map ("-l" ++) (imp_libs p) ++ extraLdOpts p
+ imp = if opt_Static then "" else "_dyn"
+ libs p = map ((++imp) . addSuffix) (hACK (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
getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
getPackageExtraCcOpts dflags pkgs = do
ps <- getExplicitPackagesAnd dflags pkgs
- return (concatMap extraCcOpts ps)
+ return (concatMap ccOptions ps)
getPackageFrameworkPath :: DynFlags -> [PackageId] -> IO [String]
getPackageFrameworkPath dflags pkgs = do
getPackageFrameworks :: DynFlags -> [PackageId] -> IO [String]
getPackageFrameworks dflags pkgs = do
ps <- getExplicitPackagesAnd dflags pkgs
- return (concatMap extraFrameworks ps)
+ return (concatMap frameworks ps)
-- -----------------------------------------------------------------------------
-- Package Utils
projects / ghc-hetmet.git / blobdiff