Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
6cc46998
Commit
6cc46998
authored
Aug 04, 2014
by
Mikhail Glushenkov
Browse files
Merge pull request #2002 from ezyang/ezyang-pkg-key
Support multiple instances of package ID in database with different deps
parents
47984faa
2b50d0a7
Changes
23
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/InstalledPackageInfo.hs
View file @
6cc46998
...
...
@@ -77,7 +77,7 @@ import Distribution.License ( License(..) )
import
Distribution.Package
(
PackageName
(
..
),
PackageIdentifier
(
..
)
,
PackageId
,
InstalledPackageId
(
..
)
,
packageName
,
packageVersion
)
,
packageName
,
packageVersion
,
PackageKey
(
..
)
)
import
qualified
Distribution.Package
as
Package
(
Package
(
..
)
)
import
Distribution.ModuleName
...
...
@@ -98,6 +98,7 @@ data InstalledPackageInfo_ m
-- these parts are exactly the same as PackageDescription
installedPackageId
::
InstalledPackageId
,
sourcePackageId
::
PackageId
,
packageKey
::
PackageKey
,
license
::
License
,
copyright
::
String
,
maintainer
::
String
,
...
...
@@ -142,6 +143,8 @@ emptyInstalledPackageInfo
=
InstalledPackageInfo
{
installedPackageId
=
InstalledPackageId
""
,
sourcePackageId
=
PackageIdentifier
(
PackageName
""
)
noVersion
,
packageKey
=
OldPackageKey
(
PackageIdentifier
(
PackageName
""
)
noVersion
),
license
=
AllRightsReserved
,
copyright
=
""
,
maintainer
=
""
,
...
...
@@ -213,6 +216,9 @@ basicFieldDescrs =
,
simpleField
"id"
disp
parse
installedPackageId
(
\
ipid
pkg
->
pkg
{
installedPackageId
=
ipid
})
,
simpleField
"key"
disp
parse
packageKey
(
\
ipid
pkg
->
pkg
{
packageKey
=
ipid
})
,
simpleField
"license"
disp
parseLicenseQ
license
(
\
l
pkg
->
pkg
{
license
=
l
})
...
...
Cabal/Distribution/Package.hs
View file @
6cc46998
...
...
@@ -22,6 +22,10 @@ module Distribution.Package (
-- * Installed package identifiers
InstalledPackageId
(
..
),
-- * Package keys (used for linker symbols)
PackageKey
(
..
),
mkPackageKey
,
-- * Package source dependencies
Dependency
(
..
),
thisPackageVersion
,
...
...
@@ -43,12 +47,16 @@ import Distribution.Compat.ReadP ((<++))
import
qualified
Text.PrettyPrint
as
Disp
import
Text.PrettyPrint
((
<>
),
(
<+>
),
text
)
import
Control.DeepSeq
(
NFData
(
..
))
import
qualified
Data.Char
as
Char
(
isDigit
,
isAlphaNum
)
import
Data.List
(
intercalate
)
import
qualified
Data.Char
as
Char
(
isDigit
,
isAlphaNum
,
isUpper
,
isLower
,
ord
,
chr
)
import
Data.List
(
intercalate
,
sort
,
foldl'
)
import
Data.Data
(
Data
)
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
)
instance
Text
PackageName
where
...
...
@@ -107,6 +115,114 @@ instance Text InstalledPackageId where
parse
=
InstalledPackageId
`
fmap
`
Parse
.
munch1
abi_char
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
-- ------------------------------------------------------------
...
...
Cabal/Distribution/Simple/Bench.hs
View file @
6cc46998
...
...
@@ -123,6 +123,6 @@ benchOption pkg_descr lbi bm template =
fromPathTemplate
$
substPathTemplate
env
template
where
env
=
initialPathTemplateEnv
(
PD
.
package
pkg_descr
)
(
compilerId
$
LBI
.
compiler
lbi
)
(
LBI
.
hostPlatform
lbi
)
++
(
PD
.
package
pkg_descr
)
(
LBI
.
pkgKey
lbi
)
(
compilerId
$
LBI
.
compiler
lbi
)
(
LBI
.
hostPlatform
lbi
)
++
[(
BenchmarkNameVar
,
toPathTemplate
$
PD
.
benchmarkName
bm
)]
Cabal/Distribution/Simple/Build.hs
View file @
6cc46998
...
...
@@ -36,10 +36,10 @@ import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule
import
Distribution.Package
(
Package
(
..
),
PackageName
(
..
),
PackageIdentifier
(
..
)
,
Dependency
(
..
),
thisPackageVersion
)
,
Dependency
(
..
),
thisPackageVersion
,
mkPackageKey
)
import
Distribution.Simple.Compiler
(
Compiler
,
CompilerFlavor
(
..
),
compilerFlavor
,
PackageDB
(
..
),
PackageDBStack
)
,
PackageDB
(
..
),
PackageDBStack
,
packageKeySupported
)
import
Distribution.PackageDescription
(
PackageDescription
(
..
),
BuildInfo
(
..
),
Library
(
..
),
Executable
(
..
)
,
TestSuite
(
..
),
TestSuiteInterface
(
..
),
Benchmark
(
..
)
...
...
@@ -55,7 +55,7 @@ import Distribution.Simple.BuildTarget
import
Distribution.Simple.PreProcess
(
preprocessComponent
,
PPSuffixHandler
)
import
Distribution.Simple.LocalBuildInfo
(
LocalBuildInfo
(
compiler
,
buildDir
,
withPackageDB
,
withPrograms
)
(
LocalBuildInfo
(
compiler
,
buildDir
,
withPackageDB
,
withPrograms
,
pkgKey
)
,
Component
(
..
),
componentName
,
getComponent
,
componentBuildInfo
,
ComponentLocalBuildInfo
(
..
),
pkgEnabledComponents
,
withComponentsInBuildOrder
,
componentsInBuildOrder
...
...
@@ -226,7 +226,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
buildExe
verbosity
numJobs
pkg_descr
lbi
exe
clbi
buildComponent
verbosity
numJobs
pkg_descr
lbi
suffixes
buildComponent
verbosity
numJobs
pkg_descr
lbi
0
suffixes
comp
@
(
CTest
test
@
TestSuite
{
testInterface
=
TestSuiteLibV09
{}
})
clbi
-- This ComponentLocalBuildInfo corresponds to a detailed
...
...
@@ -236,8 +236,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
-- built.
distPref
=
do
pwd
<-
getCurrentDirectory
let
(
pkg
,
lib
,
libClbi
,
ipi
,
exe
,
exeClbi
)
=
testSuiteLibV09AsLibAndExe
pkg_descr
lbi
test
clbi
distPref
pwd
let
(
pkg
,
lib
,
libClbi
,
lbi
,
ipi
,
exe
,
exeClbi
)
=
testSuiteLibV09AsLibAndExe
pkg_descr
test
clbi
lbi0
distPref
pwd
preprocessComponent
pkg_descr
comp
lbi
False
verbosity
suffixes
info
verbosity
$
"Building test suite "
++
testName
test
++
"..."
buildLib
verbosity
numJobs
pkg
lbi
lib
libClbi
...
...
@@ -293,13 +293,13 @@ replComponent verbosity pkg_descr lbi suffixes
replExe
verbosity
pkg_descr
lbi
exe
clbi
replComponent
verbosity
pkg_descr
lbi
suffixes
replComponent
verbosity
pkg_descr
lbi
0
suffixes
comp
@
(
CTest
test
@
TestSuite
{
testInterface
=
TestSuiteLibV09
{}
})
clbi
distPref
=
do
pwd
<-
getCurrentDirectory
let
(
pkg
,
lib
,
libClbi
,
_
,
_
,
_
)
=
testSuiteLibV09AsLibAndExe
pkg_descr
lbi
test
clbi
distPref
pwd
let
(
pkg
,
lib
,
libClbi
,
lbi
,
_
,
_
,
_
)
=
testSuiteLibV09AsLibAndExe
pkg_descr
test
clbi
lbi0
distPref
pwd
preprocessComponent
pkg_descr
comp
lbi
False
verbosity
suffixes
replLib
verbosity
pkg
lbi
lib
libClbi
...
...
@@ -339,19 +339,20 @@ testSuiteExeV10AsExe TestSuite{} = error "testSuiteExeV10AsExe: wrong kind"
-- | Translate a lib-style 'TestSuite' component into a lib + exe for building
testSuiteLibV09AsLibAndExe
::
PackageDescription
->
LocalBuildInfo
->
TestSuite
->
ComponentLocalBuildInfo
->
LocalBuildInfo
->
FilePath
->
FilePath
->
(
PackageDescription
,
Library
,
ComponentLocalBuildInfo
,
LocalBuildInfo
,
IPI
.
InstalledPackageInfo_
ModuleName
,
Executable
,
ComponentLocalBuildInfo
)
testSuiteLibV09AsLibAndExe
pkg_descr
lbi
testSuiteLibV09AsLibAndExe
pkg_descr
test
@
TestSuite
{
testInterface
=
TestSuiteLibV09
_
m
}
clbi
distPref
pwd
=
(
pkg
,
lib
,
libClbi
,
ipi
,
exe
,
exeClbi
)
clbi
lbi
distPref
pwd
=
(
pkg
,
lib
,
libClbi
,
lbi'
,
ipi
,
exe
,
exeClbi
)
where
bi
=
testBuildInfo
test
lib
=
Library
{
...
...
@@ -373,6 +374,14 @@ testSuiteLibV09AsLibAndExe pkg_descr lbi
,
testSuites
=
[]
,
library
=
Just
lib
}
-- Hack to make the library compile with the right package key.
-- Probably the "right" way to do this is move this information to
-- the ComponentLocalBuildInfo, but it seems odd that a single package
-- can define multiple actual packages.
lbi'
=
lbi
{
pkgKey
=
mkPackageKey
(
packageKeySupported
(
compiler
lbi
))
(
package
pkg
)
[]
}
ipi
=
(
inplaceInstalledPackageInfo
pwd
distPref
pkg
lib
lbi
libClbi
)
{
IPI
.
installedPackageId
=
inplacePackageId
$
packageId
ipi
}
...
...
@@ -397,7 +406,7 @@ testSuiteLibV09AsLibAndExe pkg_descr lbi
in
name
==
"Cabal"
||
name
==
"base"
)
(
componentPackageDeps
clbi
))
}
testSuiteLibV09AsLibAndExe
_
_
TestSuite
{}
_
_
_
=
error
"testSuiteLibV09AsLibAndExe: wrong kind"
testSuiteLibV09AsLibAndExe
_
TestSuite
{}
_
_
_
_
=
error
"testSuiteLibV09AsLibAndExe: wrong kind"
-- | Translate a exe-style 'Benchmark' component into an exe for building
...
...
Cabal/Distribution/Simple/Compiler.hs
View file @
6cc46998
...
...
@@ -42,7 +42,8 @@ module Distribution.Simple.Compiler (
extensionsToFlags
,
unsupportedExtensions
,
parmakeSupported
,
reexportedModulesSupported
reexportedModulesSupported
,
packageKeySupported
)
where
import
Distribution.Compiler
...
...
@@ -196,6 +197,10 @@ parmakeSupported = ghcSupported "Support parallel --make"
reexportedModulesSupported
::
Compiler
->
Bool
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
ghcSupported
::
String
->
Compiler
->
Bool
ghcSupported
key
comp
=
...
...
Cabal/Distribution/Simple/Configure.hs
View file @
6cc46998
...
...
@@ -45,15 +45,17 @@ module Distribution.Simple.Configure (configure,
import
Distribution.Compiler
(
CompilerId
(
..
)
)
import
Distribution.Simple.Compiler
(
CompilerFlavor
(
..
),
Compiler
(
compilerId
),
compilerFlavor
,
compilerVersion
(
CompilerFlavor
(
..
),
Compiler
(
..
),
compilerFlavor
,
compilerVersion
,
showCompilerId
,
unsupportedLanguages
,
unsupportedExtensions
,
PackageDB
(
..
),
PackageDBStack
,
reexportedModulesSupported
)
,
PackageDB
(
..
),
PackageDBStack
,
reexportedModulesSupported
,
packageKeySupported
)
import
Distribution.Simple.PreProcess
(
platformDefines
)
import
Distribution.Package
(
PackageName
(
PackageName
),
PackageIdentifier
(
..
),
PackageId
,
packageName
,
packageVersion
,
Package
(
..
)
,
Dependency
(
Dependency
),
simplifyDependency
,
InstalledPackageId
(
..
),
thisPackageVersion
)
,
InstalledPackageId
(
..
),
thisPackageVersion
,
mkPackageKey
,
PackageKey
(
..
)
)
import
Distribution.InstalledPackageInfo
as
Installed
(
InstalledPackageInfo
,
InstalledPackageInfo_
(
..
)
,
emptyInstalledPackageInfo
)
...
...
@@ -457,10 +459,17 @@ configure (pkg_descr0, pbi) cfg
|
(
name
,
uses
)
<-
inconsistencies
,
(
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
buildComponents
<-
case
mkComponentsLocalBuildInfo
pkg_descr
internalPkgDeps
externalPkgDeps
of
internalPkgDeps
externalPkgDeps
pkg_key
of
Left
componentCycle
->
reportComponentCycle
componentCycle
Right
components
->
return
components
...
...
@@ -542,6 +551,7 @@ configure (pkg_descr0, pbi) cfg
installedPkgs
=
packageDependsIndex
,
pkgDescrFile
=
Nothing
,
localPkgDescr
=
pkg_descr'
,
pkgKey
=
pkg_key
,
withPrograms
=
programsConfig'''
,
withVanillaLib
=
fromFlag
$
configVanillaLib
cfg
,
withProfLib
=
fromFlag
$
configProfLib
cfg
,
...
...
@@ -1017,10 +1027,11 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx
mkComponentsLocalBuildInfo
::
PackageDescription
->
[
PackageId
]
->
[
InstalledPackageInfo
]
->
PackageKey
->
Either
[
ComponentName
]
[(
ComponentName
,
ComponentLocalBuildInfo
,
[
ComponentName
])]
mkComponentsLocalBuildInfo
pkg_descr
internalPkgDeps
externalPkgDeps
=
mkComponentsLocalBuildInfo
pkg_descr
internalPkgDeps
externalPkgDeps
pkg_key
=
let
graph
=
[
(
c
,
componentName
c
,
componentDeps
c
)
|
c
<-
pkgEnabledComponents
pkg_descr
]
in
case
checkComponentsCyclic
graph
of
...
...
@@ -1052,7 +1063,7 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps =
LibComponentLocalBuildInfo
{
componentPackageDeps
=
cpds
,
componentLibraries
=
[
LibraryName
(
"HS"
++
display
(
package
pkg_descr
)
)]
(
"HS"
++
display
pkg_key
)]
}
CExe
_
->
ExeComponentLocalBuildInfo
{
...
...
Cabal/Distribution/Simple/GHC.hs
View file @
6cc46998
...
...
@@ -66,7 +66,7 @@ import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import
Distribution.Simple.BuildPaths
import
Distribution.Simple.Utils
import
Distribution.Package
(
Package
(
..
),
PackageName
(
..
)
)
(
PackageName
(
..
)
)
import
qualified
Distribution.ModuleName
as
ModuleName
import
Distribution.Simple.Program
(
Program
(
..
),
ConfiguredProgram
(
..
),
ProgramConfiguration
...
...
@@ -679,7 +679,6 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
let
libTargetDir
=
buildDir
lbi
numJobs
=
fromMaybe
1
$
fromFlagOrDefault
Nothing
numJobsFlag
pkgid
=
packageId
pkg_descr
whenVanillaLib
forceVanilla
=
when
(
forceVanilla
||
withVanillaLib
lbi
)
whenProfLib
=
when
(
withProfLib
lbi
)
...
...
@@ -712,7 +711,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
vanillaOpts
=
baseOpts
`
mappend
`
mempty
{
ghcOptMode
=
toFlag
GhcModeMake
,
ghcOptNumJobs
=
toFlag
numJobs
,
ghcOptPackage
Name
=
toFlag
pkg
id
,
ghcOptPackage
Key
=
toFlag
(
pkg
Key
lbi
)
,
ghcOptInputModules
=
libModules
lib
}
...
...
@@ -874,7 +873,7 @@ buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
&&
ghcVersion
<
Version
[
7
,
8
]
[]
)
then
toFlag
sharedLibInstallPath
else
mempty
,
ghcOptPackage
Name
=
toFlag
pkg
id
,
ghcOptPackage
Key
=
toFlag
(
pkg
Key
lbi
)
,
ghcOptNoAutoLinkPackages
=
toFlag
True
,
ghcOptPackageDBs
=
withPackageDB
lbi
,
ghcOptPackages
=
componentPackageDeps
clbi
,
...
...
@@ -1124,7 +1123,7 @@ getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
--
libAbiHash
::
Verbosity
->
PackageDescription
->
LocalBuildInfo
->
Library
->
ComponentLocalBuildInfo
->
IO
String
libAbiHash
verbosity
pkg_descr
lbi
lib
clbi
=
do
libAbiHash
verbosity
_
pkg_descr
lbi
lib
clbi
=
do
libBi
<-
hackThreadedFlag
verbosity
(
compiler
lbi
)
(
withProfLib
lbi
)
(
libBuildInfo
lib
)
let
...
...
@@ -1133,7 +1132,7 @@ libAbiHash verbosity pkg_descr lbi lib clbi = do
(
componentGhcOptions
verbosity
lbi
libBi
clbi
(
buildDir
lbi
))
`
mappend
`
mempty
{
ghcOptMode
=
toFlag
GhcModeAbiHash
,
ghcOptPackage
Name
=
toFlag
(
p
ackageId
pkg_descr
),
ghcOptPackage
Key
=
toFlag
(
p
kgKey
lbi
),
ghcOptInputModules
=
exposedModules
lib
}
sharedArgs
=
vanillaArgs
`
mappend
`
mempty
{
...
...
Cabal/Distribution/Simple/GHC/IPI641.hs
View file @
6cc46998
...
...
@@ -66,9 +66,11 @@ mkInstalledPackageId = Current.InstalledPackageId . display
toCurrent
::
InstalledPackageInfo
->
Current
.
InstalledPackageInfo
toCurrent
ipi
@
InstalledPackageInfo
{}
=
Current
.
InstalledPackageInfo
{
let
pid
=
convertPackageId
(
package
ipi
)
in
Current
.
InstalledPackageInfo
{
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
.
copyright
=
copyright
ipi
,
Current
.
maintainer
=
maintainer
ipi
,
...
...
Cabal/Distribution/Simple/GHC/IPI642.hs
View file @
6cc46998
...
...
@@ -101,9 +101,11 @@ convertLicense OtherLicense = Current.OtherLicense
toCurrent
::
InstalledPackageInfo
->
Current
.
InstalledPackageInfo
toCurrent
ipi
@
InstalledPackageInfo
{}
=
Current
.
InstalledPackageInfo
{
let
pid
=
convertPackageId
(
package
ipi
)
in
Current
.
InstalledPackageInfo
{
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
.
copyright
=
copyright
ipi
,
Current
.
maintainer
=
maintainer
ipi
,
...
...
Cabal/Distribution/Simple/Haddock.hs
View file @
6cc46998
...
...
@@ -534,7 +534,7 @@ haddockPackageFlags lbi clbi htmlTemplate = do
haddockTemplateEnv
::
LocalBuildInfo
->
PackageIdentifier
->
PathTemplateEnv
haddockTemplateEnv
lbi
pkg_id
=
(
PrefixVar
,
prefix
(
installDirTemplates
lbi
))
:
initialPathTemplateEnv
pkg_id
(
compilerId
(
compiler
lbi
))
:
initialPathTemplateEnv
pkg_id
(
pkgKey
lbi
)
(
compilerId
(
compiler
lbi
))
(
hostPlatform
lbi
)
-- ------------------------------------------------------------------------------
...
...
Cabal/Distribution/Simple/InstallDirs.hs
View file @
6cc46998
...
...
@@ -49,7 +49,7 @@ import System.FilePath ((</>), isPathSeparator, pathSeparator)
import
System.FilePath
(
dropDrive
)
import
Distribution.Package
(
PackageIdentifier
,
packageName
,
packageVersion
)
(
PackageIdentifier
,
PackageKey
,
packageName
,
packageVersion
)
import
Distribution.System
(
OS
(
..
),
buildOS
,
Platform
(
..
)
)
import
Distribution.Compiler
...
...
@@ -177,7 +177,7 @@ appendSubdirs append dirs = dirs {
-- users to be able to configure @--libdir=\/usr\/lib64@ for example but
-- because by default we want to support installing multiple versions of
-- packages and building the same package for multiple compilers we append the
-- libsubdir to get: @\/usr\/lib64\/$pkg
id
\/$compiler@.
-- libsubdir to get: @\/usr\/lib64\/$pkg
key
\/$compiler@.
--
-- An additional complication is the need to support relocatable packages on
-- systems which support such things, like Windows.
...
...
@@ -211,10 +211,10 @@ defaultInstallDirs comp userInstall _hasLibs = do
JHC
->
"$compiler"
LHC
->
"$compiler"
UHC
->
"$pkgid"
_other
->
"$arch-$os-$compiler"
</>
"$pkg
id
"
,
_other
->
"$arch-$os-$compiler"
</>
"$pkg
key
"
,
dynlibdir
=
"$libdir"
,
libexecdir
=
case
buildOS
of
Windows
->
"$prefix"
</>
"$pkg
id
"
Windows
->
"$prefix"
</>
"$pkg
key
"
_other
->
"$prefix"
</>
"libexec"
,
progdir
=
"$libdir"
</>
"hugs"
</>
"programs"
,
includedir
=
"$libdir"
</>
"$libsubdir"
</>
"include"
,
...
...
@@ -283,10 +283,14 @@ substituteInstallDirTemplates env dirs = dirs'
-- | Convert from abstract install directories to actual absolute ones by
-- substituting for all the variables in the abstract paths, to get real
-- absolute path.
absoluteInstallDirs
::
PackageIdentifier
->
CompilerId
->
CopyDest
->
Platform
absoluteInstallDirs
::
PackageIdentifier
->
PackageKey
->
CompilerId
->
CopyDest
->
Platform
->
InstallDirs
PathTemplate
->
InstallDirs
FilePath
absoluteInstallDirs
pkgId
compilerId
copydest
platform
dirs
=
absoluteInstallDirs
pkgId
pkg_key
compilerId
copydest
platform
dirs
=
(
case
copydest
of
CopyTo
destdir
->
fmap
((
destdir
</>
)
.
dropDrive
)
_
->
id
)
...
...
@@ -294,7 +298,7 @@ absoluteInstallDirs pkgId compilerId copydest platform dirs =
.
fmap
fromPathTemplate
$
substituteInstallDirTemplates
env
dirs
where
env
=
initialPathTemplateEnv
pkgId
compilerId
platform
env
=
initialPathTemplateEnv
pkgId
pkg_key
compilerId
platform
-- |The location prefix for the /copy/ command.
...
...
@@ -309,10 +313,13 @@ data CopyDest
-- prevents us from making a relocatable package (also known as a \"prefix
-- independent\" package).
--
prefixRelativeInstallDirs
::
PackageIdentifier
->
CompilerId
->
Platform
prefixRelativeInstallDirs
::
PackageIdentifier
->
PackageKey
->
CompilerId
->
Platform
->
InstallDirTemplates
->
InstallDirs
(
Maybe
FilePath
)
prefixRelativeInstallDirs
pkgId
compilerId
platform
dirs
=
prefixRelativeInstallDirs
pkgId
pkg_key
compilerId
platform
dirs
=
fmap
relative
.
appendSubdirs
combinePathTemplate
$
-- substitute the path template into each other, except that we map
...
...
@@ -322,7 +329,7 @@ prefixRelativeInstallDirs pkgId compilerId platform dirs =
prefix
=
PathTemplate
[
Variable
PrefixVar
]
}
where
env
=
initialPathTemplateEnv
pkgId
compilerId
platform
env
=
initialPathTemplateEnv
pkgId
pkg_key
compilerId
platform
-- If it starts with $prefix then it's relative and produce the relative
-- path by stripping off $prefix/ or $prefix
...
...
@@ -358,6 +365,7 @@ data PathTemplateVariable =
|
PkgNameVar
-- ^ The @$pkg@ package name path variable
|
PkgVerVar
-- ^ The @$version@ package version path variable
|
PkgIdVar
-- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
|
PkgKeyVar
-- ^ The @$pkgkey@ package key path variable
|
CompilerVar
-- ^ The compiler name and version, eg @ghc-6.6.1@
|
OSVar
-- ^ The operating system name, eg @windows@ or @linux@
|
ArchVar
-- ^ The CPU architecture name, eg @i386@ or @x86_64@
...
...
@@ -395,17 +403,21 @@ substPathTemplate environment (PathTemplate template) =
Nothing
->
[
component
]
-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv
::
PackageIdentifier
->
CompilerId
->
Platform
initialPathTemplateEnv
::
PackageIdentifier
->
PackageKey
->
CompilerId
->
Platform
->
PathTemplateEnv
initialPathTemplateEnv
pkgId
compilerId
platform
=
packageTemplateEnv
pkgId
initialPathTemplateEnv
pkgId
pkg_key
compilerId
platform
=
packageTemplateEnv
pkgId
pkg_key
++
compilerTemplateEnv
compilerId
++
platformTemplateEnv
platform
packageTemplateEnv
::
PackageIdentifier
->
PathTemplateEnv
packageTemplateEnv
pkgId
=
packageTemplateEnv
::
PackageIdentifier
->
PackageKey
->
PathTemplateEnv
packageTemplateEnv
pkgId
pkg_key
=
[(
PkgNameVar
,
PathTemplate
[
Ordinary
$
display
(
packageName
pkgId
)])
,(
PkgVerVar
,
PathTemplate
[
Ordinary
$
display
(
packageVersion
pkgId
)])
,(
PkgKeyVar
,
PathTemplate
[
Ordinary
$
display
pkg_key
])
,(
PkgIdVar
,
PathTemplate
[
Ordinary
$
display
pkgId
])
]
...
...
@@ -444,6 +456,7 @@ installDirsTemplateEnv dirs =
instance
Show
PathTemplateVariable
where
show
PrefixVar
=
"prefix"
show
PkgKeyVar
=
"pkgkey"
show
BindirVar
=
"bindir"
show
LibdirVar
=
"libdir"
show
LibsubdirVar
=
"libsubdir"
...
...
@@ -468,6 +481,7 @@ instance Read PathTemplateVariable where
[
(
var
,
drop
(
length
varStr
)
s
)
|
(
varStr
,
var
)
<-
vars
,
varStr
`
isPrefixOf
`
s
]
-- NB: order matters! Longer strings first
where
vars
=
[(
"prefix"
,
PrefixVar
)