Commit 41610a0b authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Implement package keys, distinguishing packages built with different deps/flags



Previously, the GHC ecosystem assumed that for any package ID (foo-0.1), there
would only be one instance of it in the installed packages database.  This
posed problems for situations where you want a package compiled twice against
different sets of dependencies: they could not both exist in the package
database.

Package keys are a hash of the package ID and package
dependencies, which identify a package more uniquely than a package ID, but less
uniquely than an installed package ID. Unlike installed package IDs, these can
be computed immediately after dependency resolution, rather than after
compilation.  Package keys require support from the compiler.  At the moment,
only GHC 7.10 supports package keys (the reason is that old versions of GHC
do a sannity check to see that the <pkg-name>-<pkg-version> stored in the
package database matches with the -package-name embedded in an hi file; so
the format is fixed.) We fallback to package keys == package IDs for old
versions.

Note: the ./Setup configure fallback script does not try particularly hard to
pick consistent sets of dependencies.  If your package database is too difficult
for it to resolve, manually provide installed package IDs or use cabal-install's
dependency solver.

Note: This patch *suspends* the reinstall check unless it would result in
a different package, so cabal-install will now happily reinstall foo-0.1
compiled against bar-0.2 if foo-0.1 already exists.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent c0537226
...@@ -77,7 +77,7 @@ import Distribution.License ( License(..) ) ...@@ -77,7 +77,7 @@ import Distribution.License ( License(..) )
import Distribution.Package import Distribution.Package
( PackageName(..), PackageIdentifier(..) ( PackageName(..), PackageIdentifier(..)
, PackageId, InstalledPackageId(..) , PackageId, InstalledPackageId(..)
, packageName, packageVersion ) , packageName, packageVersion, PackageKey(..) )
import qualified Distribution.Package as Package import qualified Distribution.Package as Package
( Package(..) ) ( Package(..) )
import Distribution.ModuleName import Distribution.ModuleName
...@@ -98,6 +98,7 @@ data InstalledPackageInfo_ m ...@@ -98,6 +98,7 @@ data InstalledPackageInfo_ m
-- these parts are exactly the same as PackageDescription -- these parts are exactly the same as PackageDescription
installedPackageId :: InstalledPackageId, installedPackageId :: InstalledPackageId,
sourcePackageId :: PackageId, sourcePackageId :: PackageId,
packageKey :: PackageKey,
license :: License, license :: License,
copyright :: String, copyright :: String,
maintainer :: String, maintainer :: String,
...@@ -142,6 +143,8 @@ emptyInstalledPackageInfo ...@@ -142,6 +143,8 @@ emptyInstalledPackageInfo
= InstalledPackageInfo { = InstalledPackageInfo {
installedPackageId = InstalledPackageId "", installedPackageId = InstalledPackageId "",
sourcePackageId = PackageIdentifier (PackageName "") noVersion, sourcePackageId = PackageIdentifier (PackageName "") noVersion,
packageKey = OldPackageKey (PackageIdentifier
(PackageName "") noVersion),
license = AllRightsReserved, license = AllRightsReserved,
copyright = "", copyright = "",
maintainer = "", maintainer = "",
...@@ -213,6 +216,9 @@ basicFieldDescrs = ...@@ -213,6 +216,9 @@ basicFieldDescrs =
, simpleField "id" , simpleField "id"
disp parse disp parse
installedPackageId (\ipid pkg -> pkg{installedPackageId=ipid}) installedPackageId (\ipid pkg -> pkg{installedPackageId=ipid})
, simpleField "key"
disp parse
packageKey (\ipid pkg -> pkg{packageKey=ipid})
, simpleField "license" , simpleField "license"
disp parseLicenseQ disp parseLicenseQ
license (\l pkg -> pkg{license=l}) license (\l pkg -> pkg{license=l})
......
...@@ -22,6 +22,10 @@ module Distribution.Package ( ...@@ -22,6 +22,10 @@ module Distribution.Package (
-- * Installed package identifiers -- * Installed package identifiers
InstalledPackageId(..), InstalledPackageId(..),
-- * Package keys (used for linker symbols)
PackageKey(..),
mkPackageKey,
-- * Package source dependencies -- * Package source dependencies
Dependency(..), Dependency(..),
thisPackageVersion, thisPackageVersion,
...@@ -43,12 +47,16 @@ import Distribution.Compat.ReadP ((<++)) ...@@ -43,12 +47,16 @@ import Distribution.Compat.ReadP ((<++))
import qualified Text.PrettyPrint as Disp import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>), (<+>), text) import Text.PrettyPrint ((<>), (<+>), text)
import Control.DeepSeq (NFData(..)) import Control.DeepSeq (NFData(..))
import qualified Data.Char as Char ( isDigit, isAlphaNum ) import qualified Data.Char as Char
import Data.List ( intercalate ) ( isDigit, isAlphaNum, isUpper, isLower, ord, chr )
import Data.List ( intercalate, sort, foldl' )
import Data.Data ( Data ) import Data.Data ( Data )
import Data.Typeable ( Typeable ) import Data.Typeable ( Typeable )
import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
import Data.Word ( Word64 )
import Numeric ( showIntAtBase )
newtype PackageName = PackageName String newtype PackageName = PackageName { unPackageName :: String }
deriving (Read, Show, Eq, Ord, Typeable, Data) deriving (Read, Show, Eq, Ord, Typeable, Data)
instance Text PackageName where instance Text PackageName where
...@@ -107,6 +115,114 @@ instance Text InstalledPackageId where ...@@ -107,6 +115,114 @@ instance Text InstalledPackageId where
parse = InstalledPackageId `fmap` Parse.munch1 abi_char parse = InstalledPackageId `fmap` Parse.munch1 abi_char
where abi_char c = Char.isAlphaNum c || c `elem` ":-_." where abi_char c = Char.isAlphaNum c || c `elem` ":-_."
-- ------------------------------------------------------------
-- * Package Keys
-- ------------------------------------------------------------
-- | A 'PackageKey' is the notion of "package ID" which is visible to the
-- compiler. Why is this not a 'PackageId'? The 'PackageId' is a user-visible
-- concept written explicity in Cabal files; on the other hand, a 'PackageKey'
-- may contain, for example, information about the transitive dependency
-- tree of a package. Why is this not an 'InstalledPackageId'? A 'PackageKey'
-- affects the ABI because it is used for linker symbols; however, an
-- 'InstalledPackageId' can be used to distinguish two ABI-compatible versions
-- of a library.
data PackageKey
-- | Modern package key which is a hash of the PackageId and the transitive
-- dependency key. Manually inline it here so we can get the instances
-- we need. Also contains a short informative string
= PackageKey !String {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
-- | Old-style package key which is just a 'PackageId'. Required because
-- old versions of GHC assume that the 'sourcePackageId' recorded for an
-- installed package coincides with the package key it was compiled with.
| OldPackageKey !PackageId
deriving (Read, Show, Eq, Ord, Typeable, Data)
-- | Convenience function which converts a fingerprint into a new-style package
-- key.
fingerprintPackageKey :: String -> Fingerprint -> PackageKey
fingerprintPackageKey s (Fingerprint a b) = PackageKey s a b
-- | Generates a 'PackageKey' from a 'PackageId', sorted package keys of the
-- immediate dependencies.
mkPackageKey :: Bool -- are modern style package keys supported?
-> PackageId
-> [PackageKey] -- dependencies
-> PackageKey
mkPackageKey True pid deps = fingerprintPackageKey stubName
. fingerprintString
. ((show pid ++ "\n") ++)
$ show (sort deps)
where stubName = take 5 (filter (/= '-') (unPackageName (pkgName pid)))
mkPackageKey False pid _ = OldPackageKey pid
-- The base-62 code is based off of 'locators'
-- ((c) Operational Dynamics Consulting, BSD3 licensed)
-- Note: Instead of base-62 encoding a single 128-bit integer
-- (ceil(21.49) characters), we'll base-62 a pair of 64-bit integers
-- (2 * ceil(10.75) characters). Luckily for us, it's the same number of
-- characters! In the long term, this should go in GHC.Fingerprint,
-- but not now...
-- | Size of a 64-bit word when written as a base-62 string
word64Base62Len :: Int
word64Base62Len = 11
-- | Converts a 64-bit word into a base-62 string
toBase62 :: Word64 -> String
toBase62 w = pad ++ str
where
pad = replicate len '0'
len = word64Base62Len - length str -- 11 == ceil(64 / lg 62)
str = showIntAtBase 62 represent w ""
represent :: Int -> Char
represent x
| x < 10 = Char.chr (48 + x)
| x < 36 = Char.chr (65 + x - 10)
| x < 62 = Char.chr (97 + x - 36)
| otherwise = error ("represent (base 62): impossible!")
-- | Parses a base-62 string into a 64-bit word
fromBase62 :: String -> Word64
fromBase62 ss = foldl' multiply 0 ss
where
value :: Char -> Int
value c
| Char.isDigit c = Char.ord c - 48
| Char.isUpper c = Char.ord c - 65 + 10
| Char.isLower c = Char.ord c - 97 + 36
| otherwise = error ("value (base 62): impossible!")
multiply :: Word64 -> Char -> Word64
multiply acc c = acc * 62 + (fromIntegral $ value c)
-- | Parses a base-62 string into a fingerprint.
readBase62Fingerprint :: String -> Fingerprint
readBase62Fingerprint s = Fingerprint w1 w2
where (s1,s2) = splitAt word64Base62Len s
w1 = fromBase62 s1
w2 = fromBase62 (take word64Base62Len s2)
instance Text PackageKey where
disp (PackageKey prefix w1 w2) = Disp.text prefix <> Disp.char '_'
<> Disp.text (toBase62 w1) <> Disp.text (toBase62 w2)
disp (OldPackageKey pid) = disp pid
parse = parseNew <++ parseOld
where parseNew = do
prefix <- Parse.munch1 (\c -> Char.isAlphaNum c || c `elem` "-")
_ <- Parse.char '_' -- if we use '-' it's ambiguous
fmap (fingerprintPackageKey prefix . readBase62Fingerprint)
. Parse.count (word64Base62Len * 2)
$ Parse.satisfy Char.isAlphaNum
parseOld = do pid <- parse
return (OldPackageKey pid)
instance NFData PackageKey where
rnf (PackageKey prefix _ _) = rnf prefix
rnf (OldPackageKey pid) = rnf pid
-- ------------------------------------------------------------ -- ------------------------------------------------------------
-- * Package source dependencies -- * Package source dependencies
-- ------------------------------------------------------------ -- ------------------------------------------------------------
......
...@@ -42,7 +42,8 @@ module Distribution.Simple.Compiler ( ...@@ -42,7 +42,8 @@ module Distribution.Simple.Compiler (
extensionsToFlags, extensionsToFlags,
unsupportedExtensions, unsupportedExtensions,
parmakeSupported, parmakeSupported,
reexportedModulesSupported reexportedModulesSupported,
packageKeySupported
) where ) where
import Distribution.Compiler import Distribution.Compiler
...@@ -196,6 +197,10 @@ parmakeSupported = ghcSupported "Support parallel --make" ...@@ -196,6 +197,10 @@ parmakeSupported = ghcSupported "Support parallel --make"
reexportedModulesSupported :: Compiler -> Bool reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported = ghcSupported "Support reexported-modules" reexportedModulesSupported = ghcSupported "Support reexported-modules"
-- | Does this compiler support package keys?
packageKeySupported :: Compiler -> Bool
packageKeySupported = ghcSupported "Uses package keys"
-- | Utility function for GHC only features -- | Utility function for GHC only features
ghcSupported :: String -> Compiler -> Bool ghcSupported :: String -> Compiler -> Bool
ghcSupported key comp = ghcSupported key comp =
......
...@@ -45,15 +45,17 @@ module Distribution.Simple.Configure (configure, ...@@ -45,15 +45,17 @@ module Distribution.Simple.Configure (configure,
import Distribution.Compiler import Distribution.Compiler
( CompilerId(..) ) ( CompilerId(..) )
import Distribution.Simple.Compiler import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion ( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion
, showCompilerId, unsupportedLanguages, unsupportedExtensions , showCompilerId, unsupportedLanguages, unsupportedExtensions
, PackageDB(..), PackageDBStack, reexportedModulesSupported ) , PackageDB(..), PackageDBStack, reexportedModulesSupported
, packageKeySupported )
import Distribution.Simple.PreProcess ( platformDefines ) import Distribution.Simple.PreProcess ( platformDefines )
import Distribution.Package import Distribution.Package
( PackageName(PackageName), PackageIdentifier(..), PackageId ( PackageName(PackageName), PackageIdentifier(..), PackageId
, packageName, packageVersion, Package(..) , packageName, packageVersion, Package(..)
, Dependency(Dependency), simplifyDependency , Dependency(Dependency), simplifyDependency
, InstalledPackageId(..), thisPackageVersion ) , InstalledPackageId(..), thisPackageVersion
, mkPackageKey, PackageKey(..) )
import Distribution.InstalledPackageInfo as Installed import Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo, InstalledPackageInfo_(..) ( InstalledPackageInfo, InstalledPackageInfo_(..)
, emptyInstalledPackageInfo ) , emptyInstalledPackageInfo )
...@@ -115,7 +117,7 @@ import Prelude hiding ( mapM ) ...@@ -115,7 +117,7 @@ import Prelude hiding ( mapM )
import Control.Monad import Control.Monad
( when, unless, foldM, filterM ) ( when, unless, foldM, filterM )
import Data.List import Data.List
( (\\), nub, partition, isPrefixOf, inits ) ( (\\), nub, partition, isPrefixOf, inits, find )
import Data.Maybe import Data.Maybe
( isNothing, catMaybes, fromMaybe ) ( isNothing, catMaybes, fromMaybe )
import Data.Monoid import Data.Monoid
...@@ -457,10 +459,17 @@ configure (pkg_descr0, pbi) cfg ...@@ -457,10 +459,17 @@ configure (pkg_descr0, pbi) cfg
| (name, uses) <- inconsistencies | (name, uses) <- inconsistencies
, (pkg, ver) <- uses ] , (pkg, ver) <- uses ]
-- Calculate the package key. We're going to store it in LocalBuildInfo
-- canonically, but ComponentsLocalBuildInfo also needs to know about it
-- XXX Do we need the internal deps?
let pkg_key = mkPackageKey (packageKeySupported comp)
(package pkg_descr)
(map packageKey externalPkgDeps)
-- internal component graph -- internal component graph
buildComponents <- buildComponents <-
case mkComponentsLocalBuildInfo pkg_descr case mkComponentsLocalBuildInfo pkg_descr
internalPkgDeps externalPkgDeps of internalPkgDeps externalPkgDeps pkg_key of
Left componentCycle -> reportComponentCycle componentCycle Left componentCycle -> reportComponentCycle componentCycle
Right components -> return components Right components -> return components
...@@ -542,6 +551,7 @@ configure (pkg_descr0, pbi) cfg ...@@ -542,6 +551,7 @@ configure (pkg_descr0, pbi) cfg
installedPkgs = packageDependsIndex, installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing, pkgDescrFile = Nothing,
localPkgDescr = pkg_descr', localPkgDescr = pkg_descr',
pkgKey = pkg_key,
withPrograms = programsConfig''', withPrograms = programsConfig''',
withVanillaLib = fromFlag $ configVanillaLib cfg, withVanillaLib = fromFlag $ configVanillaLib cfg,
withProfLib = fromFlag $ configProfLib cfg, withProfLib = fromFlag $ configProfLib cfg,
...@@ -1017,10 +1027,11 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx ...@@ -1017,10 +1027,11 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx
mkComponentsLocalBuildInfo :: PackageDescription mkComponentsLocalBuildInfo :: PackageDescription
-> [PackageId] -> [InstalledPackageInfo] -> [PackageId] -> [InstalledPackageInfo]
-> PackageKey
-> Either [ComponentName] -> Either [ComponentName]
[(ComponentName, [(ComponentName,
ComponentLocalBuildInfo, [ComponentName])] ComponentLocalBuildInfo, [ComponentName])]
mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps = mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps pkg_key =
let graph = [ (c, componentName c, componentDeps c) let graph = [ (c, componentName c, componentDeps c)
| c <- pkgEnabledComponents pkg_descr ] | c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of in case checkComponentsCyclic graph of
...@@ -1052,7 +1063,7 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps = ...@@ -1052,7 +1063,7 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps =
LibComponentLocalBuildInfo { LibComponentLocalBuildInfo {
componentPackageDeps = cpds, componentPackageDeps = cpds,
componentLibraries = [LibraryName componentLibraries = [LibraryName
("HS" ++ display (package pkg_descr))] ("HS" ++ display pkg_key)]
} }
CExe _ -> CExe _ ->
ExeComponentLocalBuildInfo { ExeComponentLocalBuildInfo {
......
...@@ -66,7 +66,7 @@ import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) ...@@ -66,7 +66,7 @@ import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils import Distribution.Simple.Utils
import Distribution.Package import Distribution.Package
( Package(..), PackageName(..) ) ( PackageName(..) )
import qualified Distribution.ModuleName as ModuleName import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration ( Program(..), ConfiguredProgram(..), ProgramConfiguration
...@@ -679,7 +679,6 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do ...@@ -679,7 +679,6 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
let libTargetDir = buildDir lbi let libTargetDir = buildDir lbi
numJobs = fromMaybe 1 $ fromFlagOrDefault Nothing numJobsFlag numJobs = fromMaybe 1 $ fromFlagOrDefault Nothing numJobsFlag
pkgid = packageId pkg_descr
whenVanillaLib forceVanilla = whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi) when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi) whenProfLib = when (withProfLib lbi)
...@@ -712,7 +711,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do ...@@ -712,7 +711,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
vanillaOpts = baseOpts `mappend` mempty { vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake, ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = toFlag numJobs, ghcOptNumJobs = toFlag numJobs,
ghcOptPackageName = toFlag pkgid, ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptInputModules = libModules lib ghcOptInputModules = libModules lib
} }
...@@ -874,7 +873,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do ...@@ -874,7 +873,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
&& ghcVersion < Version [7,8] []) && ghcVersion < Version [7,8] [])
then toFlag sharedLibInstallPath then toFlag sharedLibInstallPath
else mempty, else mempty,
ghcOptPackageName = toFlag pkgid, ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptNoAutoLinkPackages = toFlag True, ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi, ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = componentPackageDeps clbi, ghcOptPackages = componentPackageDeps clbi,
...@@ -1124,7 +1123,7 @@ getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs ...@@ -1124,7 +1123,7 @@ getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
-- --
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String -> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity pkg_descr lbi lib clbi = do libAbiHash verbosity _pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib) (compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let let
...@@ -1133,7 +1132,7 @@ libAbiHash verbosity pkg_descr lbi lib clbi = do ...@@ -1133,7 +1132,7 @@ libAbiHash verbosity pkg_descr lbi lib clbi = do
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty { `mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash, ghcOptMode = toFlag GhcModeAbiHash,
ghcOptPackageName = toFlag (packageId pkg_descr), ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptInputModules = exposedModules lib ghcOptInputModules = exposedModules lib
} }
sharedArgs = vanillaArgs `mappend` mempty { sharedArgs = vanillaArgs `mappend` mempty {
......
...@@ -66,9 +66,11 @@ mkInstalledPackageId = Current.InstalledPackageId . display ...@@ -66,9 +66,11 @@ mkInstalledPackageId = Current.InstalledPackageId . display
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} = toCurrent ipi@InstalledPackageInfo{} =
Current.InstalledPackageInfo { let pid = convertPackageId (package ipi)
in Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)), Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = convertPackageId (package ipi), Current.sourcePackageId = pid,
Current.packageKey = Current.OldPackageKey pid,
Current.license = convertLicense (license ipi), Current.license = convertLicense (license ipi),
Current.copyright = copyright ipi, Current.copyright = copyright ipi,
Current.maintainer = maintainer ipi, Current.maintainer = maintainer ipi,
......
...@@ -101,9 +101,11 @@ convertLicense OtherLicense = Current.OtherLicense ...@@ -101,9 +101,11 @@ convertLicense OtherLicense = Current.OtherLicense
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} = toCurrent ipi@InstalledPackageInfo{} =
Current.InstalledPackageInfo { let pid = convertPackageId (package ipi)
in Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)), Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = convertPackageId (package ipi), Current.sourcePackageId = pid,
Current.packageKey = Current.OldPackageKey pid,
Current.license = convertLicense (license ipi), Current.license = convertLicense (license ipi),
Current.copyright = copyright ipi, Current.copyright = copyright ipi,
Current.maintainer = maintainer ipi, Current.maintainer = maintainer ipi,
......
...@@ -65,7 +65,7 @@ import Distribution.PackageDescription ...@@ -65,7 +65,7 @@ import Distribution.PackageDescription
, Executable(exeName, buildInfo), withTest, TestSuite(..) , Executable(exeName, buildInfo), withTest, TestSuite(..)
, BuildInfo(buildable), Benchmark(..) ) , BuildInfo(buildable), Benchmark(..) )
import Distribution.Package import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..) ) ( PackageId, Package(..), InstalledPackageId(..), PackageKey )
import Distribution.Simple.Compiler import Distribution.Simple.Compiler
( Compiler(..), PackageDBStack, OptimisationLevel ) ( Compiler(..), PackageDBStack, OptimisationLevel )
import Distribution.Simple.PackageIndex import Distribution.Simple.PackageIndex
...@@ -115,6 +115,9 @@ data LocalBuildInfo = LocalBuildInfo { ...@@ -115,6 +115,9 @@ data LocalBuildInfo = LocalBuildInfo {
localPkgDescr :: PackageDescription, localPkgDescr :: PackageDescription,
-- ^ The resolved package description, that does not contain -- ^ The resolved package description, that does not contain
-- any conditionals. -- any conditionals.
pkgKey :: PackageKey,
-- ^ The package key for the current build, calculated from
-- the package ID and the dependency graph.
withPrograms :: ProgramConfiguration, -- ^Location and args for all programs withPrograms :: ProgramConfiguration, -- ^Location and args for all programs
withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user
withVanillaLib:: Bool, -- ^Whether to build normal libs. withVanillaLib:: Bool, -- ^Whether to build normal libs.
......
...@@ -67,8 +67,8 @@ data GhcOptions = GhcOptions { ...@@ -67,8 +67,8 @@ data GhcOptions = GhcOptions {
------------- -------------
-- Packages -- Packages
-- | The package name the modules will belong to; the @ghc -package-name@ flag -- | The package key the modules will belong to; the @ghc -this-package-key@ flag
ghcOptPackageName :: Flag PackageId, ghcOptPackageKey :: Flag PackageKey,
-- | GHC package databases to use, the @ghc -package-conf@ flag -- | GHC package databases to use, the @ghc -package-conf@ flag
ghcOptPackageDBs :: PackageDBStack, ghcOptPackageDBs :: PackageDBStack,
...@@ -322,7 +322,10 @@ renderGhcOptions comp opts ...@@ -322,7 +322,10 @@ renderGhcOptions comp opts
------------- -------------
-- Packages -- Packages
, concat [ ["-package-name", display pkgid] | pkgid <- flag ghcOptPackageName ] , concat [ [if packageKeySupported comp
then "-this-package-key"
else "-package-name", display pkgid]
| pkgid <- flag ghcOptPackageKey ]
, [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ] , [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ]
, [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ] , [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]
...@@ -416,7 +419,7 @@ instance Monoid GhcOptions where ...@@ -416,7 +419,7 @@ instance Monoid GhcOptions where
ghcOptOutputDynFile = mempty, ghcOptOutputDynFile = mempty,
ghcOptSourcePathClear = mempty, ghcOptSourcePathClear = mempty,
ghcOptSourcePath = mempty, ghcOptSourcePath = mempty,
ghcOptPackageName = mempty, ghcOptPackageKey = mempty,
ghcOptPackageDBs = mempty, ghcOptPackageDBs = mempty,
ghcOptPackages = mempty, ghcOptPackages = mempty,
ghcOptHideAllPackages = mempty, ghcOptHideAllPackages = mempty,
...@@ -465,7 +468,7 @@ instance Monoid GhcOptions where ...@@ -465,7 +468,7 @@ instance Monoid GhcOptions where
ghcOptOutputDynFile = combine ghcOptOutputDynFile, ghcOptOutputDynFile = combine ghcOptOutputDynFile,
ghcOptSourcePathClear = combine ghcOptSourcePathClear, ghcOptSourcePathClear = combine ghcOptSourcePathClear,
ghcOptSourcePath = combine ghcOptSourcePath, ghcOptSourcePath = combine ghcOptSourcePath,
ghcOptPackageName = combine ghcOptPackageName, ghcOptPackageKey = combine ghcOptPackageKey,
ghcOptPackageDBs = combine ghcOptPackageDBs, ghcOptPackageDBs = combine ghcOptPackageDBs,
ghcOptPackages = combine ghcOptPackages, ghcOptPackages = combine ghcOptPackages,
ghcOptHideAllPackages = combine ghcOptHideAllPackages, ghcOptHideAllPackages = combine ghcOptHideAllPackages,
......
...@@ -258,14 +258,16 @@ generalInstalledPackageInfo ...@@ -258,14 +258,16 @@ generalInstalledPackageInfo
-- absolute paths. -- absolute paths.
-> PackageDescription -> PackageDescription
-> Library -> Library
-> LocalBuildInfo
-> ComponentLocalBuildInfo -> ComponentLocalBuildInfo
-> InstallDirs FilePath -> InstallDirs FilePath
-> InstalledPackageInfo -> InstalledPackageInfo
generalInstalledPackageInfo adjustRelIncDirs pkg lib clbi installDirs = generalInstalledPackageInfo adjustRelIncDirs pkg lib lbi clbi installDirs =
InstalledPackageInfo { InstalledPackageInfo {
--TODO: do not open-code this conversion from PackageId to InstalledPackageId --TODO: do not open-code this conversion from PackageId to InstalledPackageId
IPI.installedPackageId = InstalledPackageId (display (packageId pkg)), IPI.installedPackageId = InstalledPackageId (display (packageId pkg)),
IPI.sourcePackageId = packageId pkg, IPI.sourcePackageId = packageId pkg,
IPI.packageKey = pkgKey lbi,
IPI.license = license pkg, IPI.license = license pkg,