Commit 65e4acd1 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Add mkLegacyUnitId and use it where appropriate.


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent b713bf52
......@@ -26,6 +26,7 @@ module Distribution.Package (
ComponentId(..),
UnitId(..),
mkUnitId,
mkLegacyUnitId,
getHSLibraryName,
InstalledPackageId, -- backwards compat
......@@ -147,6 +148,10 @@ newtype UnitId = SimpleUnitId ComponentId
mkUnitId :: String -> UnitId
mkUnitId = SimpleUnitId . ComponentId
-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = SimpleUnitId . ComponentId . display
-- ------------------------------------------------------------
-- * Package source dependencies
-- ------------------------------------------------------------
......
......@@ -434,7 +434,7 @@ configure (pkg_descr0, pbi) cfg = do
let pseudoTopPkg = emptyInstalledPackageInfo {
Installed.installedUnitId =
mkUnitId (display (packageId pkg_descr)),
mkLegacyUnitId (packageId pkg_descr),
Installed.sourcePackageId = packageId pkg_descr,
Installed.depends =
map Installed.installedUnitId installDeps
......@@ -737,10 +737,9 @@ getInternalPackages pkg_descr0 =
internalPackage = emptyInstalledPackageInfo {
--TODO: should use a per-compiler method to map the source
-- package ID into an installed package id we can use
-- for the internal package set. The open-codes use of
-- mkUnitId here is a hack.
Installed.installedUnitId =
mkUnitId $ display $ pid,
-- for the internal package set. The use of
-- mkLegacyUnitId here is a hack.
Installed.installedUnitId = mkLegacyUnitId pid,
Installed.sourcePackageId = pid
}
in PackageIndex.fromList [internalPackage]
......
......@@ -61,16 +61,13 @@ data InstalledPackageInfo = InstalledPackageInfo {
}
deriving Read
mkUnitId :: Current.PackageIdentifier -> Current.UnitId
mkUnitId = Current.mkUnitId . display
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} =
let pid = convertPackageId (package ipi)
mkExposedModule m = Current.ExposedModule m Nothing
in Current.InstalledPackageInfo {
Current.sourcePackageId = pid,
Current.installedUnitId = mkUnitId pid,
Current.installedUnitId = Current.mkLegacyUnitId pid,
Current.compatPackageKey = "",
Current.abiHash = Current.AbiHash "", -- bogus but old GHCs don't care.
Current.license = convertLicense (license ipi),
......@@ -95,7 +92,7 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.extraGHCiLibraries = extraGHCiLibraries ipi,
Current.includeDirs = includeDirs ipi,
Current.includes = includes ipi,
Current.depends = map (mkUnitId.convertPackageId) (depends ipi),
Current.depends = map (Current.mkLegacyUnitId . convertPackageId) (depends ipi),
Current.ccOptions = ccOptions ipi,
Current.ldOptions = ldOptions ipi,
Current.frameworkDirs = frameworkDirs ipi,
......
......@@ -623,7 +623,9 @@ haddockPackageFlags lbi clbi htmlTemplate = do
haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
haddockTemplateEnv lbi pkg_id =
(PrefixVar, prefix (installDirTemplates lbi))
: initialPathTemplateEnv pkg_id (mkUnitId (display pkg_id)) (compilerInfo (compiler lbi))
-- We want the legacy unit ID here, because it gives us nice paths
-- (Haddock people don't care about the dependencies)
: initialPathTemplateEnv pkg_id (mkLegacyUnitId pkg_id) (compilerInfo (compiler lbi))
(hostPlatform lbi)
-- ------------------------------------------------------------------------------
......
......@@ -99,7 +99,7 @@ getInstalledPackages verbosity _packageDBs conf = do
return $
PackageIndex.fromList $
map (\p -> emptyInstalledPackageInfo {
InstalledPackageInfo.installedUnitId = mkUnitId (display p),
InstalledPackageInfo.installedUnitId = mkLegacyUnitId p,
InstalledPackageInfo.sourcePackageId = p
}) $
concatMap parseLine $
......
......@@ -152,7 +152,7 @@ localComponentId lbi
-- the package ID.
localUnitId :: LocalBuildInfo -> UnitId
localUnitId lbi =
foldr go (mkUnitId (display (package (localPkgDescr lbi)))) (componentsConfigs lbi)
foldr go (mkLegacyUnitId (package (localPkgDescr lbi))) (componentsConfigs lbi)
where go (_, clbi, _) old_uid = case clbi of
LibComponentLocalBuildInfo { componentUnitId = uid } -> uid
_ -> old_uid
......
......@@ -310,9 +310,7 @@ setUnitId pkginfo@InstalledPackageInfo {
sourcePackageId = pkgid
}
= pkginfo {
--TODO use a proper named function for the conversion
-- from source package id to installed package id
installedUnitId = mkUnitId (display pkgid)
installedUnitId = mkLegacyUnitId pkgid
}
setUnitId pkginfo = pkginfo
......
......@@ -157,8 +157,8 @@ parsePackage x = map fst (filter (\ (_,y) -> null y) (readP_to_S parse x))
-- | Create a trivial package info from a directory name.
mkInstalledPackageInfo :: PackageId -> InstalledPackageInfo
mkInstalledPackageInfo p = emptyInstalledPackageInfo
{ installedUnitId = mkUnitId (display p),
sourcePackageId = p }
{ installedUnitId = mkLegacyUnitId p,
sourcePackageId = p }
-- -----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment