Commit 018ec60f authored by Simon Marlow's avatar Simon Marlow
Browse files

Add the ABI hash to the InstalledPackageId for inplace registrations too

Previously, we just added a -inplace suffix, but this will cause
problems when developing multiple packages inplace, and then
installing them.

Also, there was a round of refactoring: registerPackage now takes the
InstalledPackageId as an argument, and generateRegistrationInfo is
exposed for constructing it.  This means that callers of
registerPackage get to munge the InstalledPackageInfo before it is
registered.
parent 40568e3f
......@@ -80,7 +80,7 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.BuildPaths
( autogenModulesDir, autogenModuleName, cppHeaderName )
import Distribution.Simple.Register
( registerPackage )
( registerPackage, generateRegistrationInfo )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, rewriteFile
, die, info, setupMessage )
......@@ -117,10 +117,13 @@ build pkg_descr lbi flags suffixes = do
info verbosity "Building library..."
buildLib verbosity pkg_descr lbi lib clbi
installedPkgInfo <- generateRegistrationInfo verbosity pkg_descr lib
lbi clbi True{-inplace-} distPref
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
registerPackage verbosity
pkg_descr lib lbi clbi distPref True internalPackageDB
installedPkgInfo pkg_descr lbi True{-inplace-} internalPackageDB
-- Use the internal package db for the exes.
let lbi' = lbi { withPackageDB = withPackageDB lbi ++ [internalPackageDB] }
......
......@@ -58,6 +58,7 @@ module Distribution.Simple.Register (
unregister,
registerPackage,
generateRegistrationInfo,
inplaceInstalledPackageInfo,
absoluteInstalledPackageInfo,
generalInstalledPackageInfo,
......@@ -120,11 +121,17 @@ register :: PackageDescription -> LocalBuildInfo
-> IO ()
register pkg@PackageDescription { library = Just lib }
lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags
= do
installedPkgInfo <- generateRegistrationInfo
verbosity pkg lib lbi clbi inplace distPref
-- Three different modes:
| modeGenerateRegFile = writeRegistrationFile
| modeGenerateRegScript = writeRegisterScript
| otherwise = registerPackage verbosity
pkg lib lbi clbi distPref inplace packageDb
case () of
_ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo
| modeGenerateRegScript -> writeRegisterScript installedPkgInfo
| otherwise -> registerPackage verbosity
installedPkgInfo pkg lbi inplace packageDb
where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
......@@ -139,18 +146,16 @@ register pkg@PackageDescription { library = Just lib }
distPref = fromFlag (regDistPref regFlags)
verbosity = fromFlag (regVerbosity regFlags)
writeRegistrationFile = do
installedPkgInfo <- generateRegistrationInfo verbosity
pkg lib lbi clbi inplace distPref
writeRegistrationFile installedPkgInfo = do
notice verbosity ("Creating package registration file: " ++ regFile)
writeFileAtomic regFile (showInstalledPackageInfo installedPkgInfo ++ "\n")
writeRegisterScript =
writeRegisterScript installedPkgInfo =
case compilerFlavor (compiler lbi) of
GHC -> do (ghcPkg, _) <- requireProgram verbosity ghcPkgProgram (withPrograms lbi)
writeHcPkgRegisterScript verbosity ghcPkg pkg lib lbi clbi distPref inplace packageDb
writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDb
LHC -> do (lhcPkg, _) <- requireProgram verbosity lhcPkgProgram (withPrograms lbi)
writeHcPkgRegisterScript verbosity lhcPkg pkg lib lbi clbi distPref inplace packageDb
writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDb
Hugs -> notice verbosity "Registration scripts not needed for hugs"
JHC -> notice verbosity "Registration scripts not needed for jhc"
NHC -> notice verbosity "Registration scripts not needed for nhc98"
......@@ -176,39 +181,36 @@ generateRegistrationInfo verbosity pkg lib lbi clbi inplace distPref = do
--TODO: the method of setting the InstalledPackageId is compiler specific
-- this aspect should be delegated to a per-compiler helper.
let comp = compiler lbi
ipid_suffix <-
if inplace
then return "inplace"
else if compilerFlavor comp == GHC &&
compilerVersion comp >= Version [6,11] []
then GHC.libAbiHash verbosity pkg lbi lib clbi
else return "installed"
let ipid = InstalledPackageId (display (packageId pkg) ++ '-':ipid_suffix)
ipid <-
case compilerFlavor comp of
GHC | compilerVersion comp >= Version [6,11] [] -> do
s <- GHC.libAbiHash verbosity pkg lbi lib clbi
return (InstalledPackageId (display (packageId pkg) ++ '-':s))
_other -> do
return (InstalledPackageId (display (packageId pkg)))
let installedPkgInfo
| inplace = inplaceInstalledPackageInfo pwd distPref
pkg lib lbi clbi
| otherwise = absoluteInstalledPackageInfo
pkg lib lbi clbi
return installedPkgInfo{ IPI.installedPackageId = ipid }
registerPackage :: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Bool
-> PackageDB
-> IO ()
registerPackage verbosity pkg lib lbi clbi distPref inplace packageDb = do
registerPackage verbosity installedPkgInfo pkg lbi inplace packageDb = do
setupMessage verbosity "Registering" (packageId pkg)
case compilerFlavor (compiler lbi) of
GHC -> registerPackageGHC verbosity pkg lib lbi clbi distPref inplace packageDb
LHC -> registerPackageLHC verbosity pkg lib lbi clbi distPref inplace packageDb
Hugs -> registerPackageHugs verbosity pkg lib lbi clbi distPref inplace packageDb
GHC -> registerPackageGHC verbosity installedPkgInfo pkg lbi inplace packageDb
LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDb
Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDb
JHC -> notice verbosity "Registering for jhc (nothing to do)"
NHC -> notice verbosity "Registering for nhc98 (nothing to do)"
_ -> die "Registering is not implemented for this compiler"
......@@ -216,32 +218,22 @@ registerPackage verbosity pkg lib lbi clbi distPref inplace packageDb = do
registerPackageGHC, registerPackageLHC, registerPackageHugs
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Bool
-> PackageDB
-> IO ()
registerPackageGHC verbosity pkg lib lbi clbi distPref inplace packageDb = do
installedPkgInfo <- generateRegistrationInfo verbosity
pkg lib lbi clbi inplace distPref
registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do
let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity ghcPkg packageDb (Right installedPkgInfo)
registerPackageLHC verbosity pkg lib lbi clbi distPref inplace packageDb = do
installedPkgInfo <- generateRegistrationInfo verbosity
pkg lib lbi clbi inplace distPref
registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do
let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity lhcPkg packageDb (Right installedPkgInfo)
registerPackageHugs verbosity pkg lib lbi clbi distPref inplace _packageDb = do
registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDb = do
when inplace $ die "--inplace is not supported with Hugs"
installedPkgInfo <- generateRegistrationInfo verbosity
pkg lib lbi clbi inplace distPref
let installDirs = absoluteInstallDirs pkg lbi NoCopyDest
createDirectoryIfMissingVerbose verbosity True (libdir installDirs)
writeFileAtomic (libdir installDirs </> "package.conf")
......@@ -249,19 +241,11 @@ registerPackageHugs verbosity pkg lib lbi clbi distPref inplace _packageDb = do
writeHcPkgRegisterScript :: Verbosity
-> InstalledPackageInfo
-> ConfiguredProgram
-> PackageDescription
-> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> FilePath
-> Bool
-> PackageDB
-> IO ()
writeHcPkgRegisterScript verbosity hcPkg pkg lib lbi clbi distPref inplace packageDb = do
installedPkgInfo <- generateRegistrationInfo verbosity
pkg lib lbi clbi inplace distPref
writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDb = do
let invocation = HcPkg.reregisterInvocation hcPkg Verbosity.normal
packageDb (Right installedPkgInfo)
regScript = invocationAsSystemScript buildOS invocation
......
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