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
6892a378
Commit
6892a378
authored
Oct 30, 2013
by
Mikhail Glushenkov
Browse files
Merge pull request #1567 from haskell/installed-packageids
Installed packageids
parents
16920c6b
3622d17c
Changes
12
Hide whitespace changes
Inline
Side-by-side
Cabal/Cabal.cabal
View file @
6892a378
name: Cabal
version: 1.19.
0
version: 1.19.
1
copyright: 2003-2006, Isaac Jones
2005-2011, Duncan Coutts
license: BSD3
...
...
Cabal/Distribution/InstalledPackageInfo.hs
View file @
6892a378
...
...
@@ -75,7 +75,8 @@ import Distribution.ParseUtils
,
parseFreeText
,
showFreeText
)
import
Distribution.License
(
License
(
..
)
)
import
Distribution.Package
(
PackageName
(
..
),
PackageIdentifier
(
..
),
PackageId
,
InstalledPackageId
(
..
)
(
PackageName
(
..
),
PackageIdentifier
(
..
)
,
PackageId
,
InstalledPackageId
(
..
)
,
packageName
,
packageVersion
)
import
qualified
Distribution.Package
as
Package
(
Package
(
..
)
)
...
...
Cabal/Distribution/ParseUtils.hs
View file @
6892a378
...
...
@@ -87,7 +87,7 @@ import Data.Char (isSpace, toLower, isAlphaNum, isDigit)
import
Data.Maybe
(
fromMaybe
)
import
Data.Tree
as
Tree
(
Tree
(
..
),
flatten
)
import
qualified
Data.Map
as
Map
import
Control.Monad
(
foldM
,
ap
)
import
Control.Monad
(
foldM
,
ap
)
import
Control.Applicative
(
Applicative
(
..
))
import
System.FilePath
(
normalise
)
import
Data.List
(
sortBy
)
...
...
@@ -119,11 +119,11 @@ data ParseResult a = ParseFailed PError | ParseOk [PWarning] a
instance
Functor
ParseResult
where
fmap
_
(
ParseFailed
err
)
=
ParseFailed
err
fmap
f
(
ParseOk
ws
x
)
=
ParseOk
ws
$
f
x
instance
Applicative
ParseResult
where
pure
=
return
(
<*>
)
=
ap
instance
Monad
ParseResult
where
return
=
ParseOk
[]
...
...
Cabal/Distribution/Simple/Configure.hs
View file @
6892a378
...
...
@@ -82,7 +82,7 @@ import Distribution.Package
(
PackageName
(
PackageName
),
PackageIdentifier
(
..
),
PackageId
,
packageName
,
packageVersion
,
Package
(
..
)
,
Dependency
(
Dependency
),
simplifyDependency
,
InstalledPackageId
(
..
)
)
,
InstalledPackageId
(
..
)
,
thisPackageVersion
)
import
Distribution.InstalledPackageInfo
as
Installed
(
InstalledPackageInfo
,
InstalledPackageInfo_
(
..
)
,
emptyInstalledPackageInfo
)
...
...
@@ -147,6 +147,8 @@ import Data.Maybe
(
isNothing
,
catMaybes
,
fromMaybe
)
import
Data.Monoid
(
Monoid
(
..
)
)
import
qualified
Data.Map
as
Map
import
Data.Map
(
Map
)
import
System.Directory
(
doesFileExist
,
createDirectoryIfMissing
,
getTemporaryDirectory
)
import
System.FilePath
...
...
@@ -158,7 +160,8 @@ import System.IO
import
Distribution.Text
(
Text
(
disp
),
display
,
simpleParse
)
import
Text.PrettyPrint
(
comma
,
punctuate
,
render
,
nest
,
sep
)
(
render
,
(
<>
),
(
$+$
),
char
,
text
,
comma
,
quotes
,
punctuate
,
nest
,
sep
,
hsep
)
import
Distribution.Compat.Exception
(
catchExit
,
catchIO
)
import
qualified
Data.ByteString.Lazy.Char8
as
BS.Char8
...
...
@@ -352,13 +355,18 @@ configure (pkg_descr0, pbi) cfg
pkg_descr0''
=
pkg_descr0
{
condTestSuites
=
flaggedTests
,
condBenchmarks
=
flaggedBenchmarks
}
(
allConstraints
,
requiredDepsMap
)
<-
either
die
return
$
combinedConstraints
(
configConstraints
cfg
)
(
configDependencies
cfg
)
installedPackageSet
(
pkg_descr0'
,
flags
)
<-
case
finalizePackageDescription
(
configConfigurationsFlags
cfg
)
dependencySatisfiable
compPlatform
(
compilerId
comp
)
(
config
Constraints
cfg
)
all
Constraints
pkg_descr0''
of
Right
r
->
return
r
Left
missing
->
...
...
@@ -381,9 +389,12 @@ configure (pkg_descr0, pbi) cfg
checkPackageProblems
verbosity
pkg_descr0
(
updatePackageDescription
pbi
pkg_descr
)
let
selectDependencies
=
let
selectDependencies
::
[
Dependency
]
->
([
FailedDependency
],
[
ResolvedDependency
])
selectDependencies
=
(
\
xs
->
([
x
|
Left
x
<-
xs
],
[
x
|
Right
x
<-
xs
]))
.
map
(
selectDependency
internalPackageSet
installedPackageSet
)
.
map
(
selectDependency
internalPackageSet
installedPackageSet
requiredDepsMap
)
(
failedDeps
,
allPkgDeps
)
=
selectDependencies
(
buildDepends
pkg_descr
)
...
...
@@ -620,9 +631,11 @@ data FailedDependency = DependencyNotExists PackageName
-- | Test for a package dependency and record the version we have installed.
selectDependency
::
PackageIndex
-- ^ Internally defined packages
->
PackageIndex
-- ^ Installed packages
->
Map
PackageName
InstalledPackageInfo
-- ^ Packages for which we have been given specific deps to use
->
Dependency
->
Either
FailedDependency
ResolvedDependency
selectDependency
internalIndex
installedIndex
selectDependency
internalIndex
installedIndex
requiredDepsMap
dep
@
(
Dependency
pkgname
vr
)
=
-- If the dependency specification matches anything in the internal package
-- index, then we prefer that match to anything in the second.
...
...
@@ -645,9 +658,14 @@ selectDependency internalIndex installedIndex
_
->
case
PackageIndex
.
lookupDependency
installedIndex
dep
of
[]
->
Left
$
DependencyNotExists
pkgname
pkgs
->
Right
$
ExternalDependency
dep
$
-- by default we just pick the latest
case
last
pkgs
of
(
_ver
,
instances
)
->
head
instances
-- the first preference
case
Map
.
lookup
pkgname
requiredDepsMap
of
-- if we know the exact pkg to use then use it
Just
pkginstance
->
pkginstance
-- otherwise we just pick an arbirary instance of the
-- latest version
Nothing
->
case
last
pkgs
of
(
_ver
,
pkginstances
)
->
head
pkginstances
reportSelectedDependencies
::
Verbosity
->
[
ResolvedDependency
]
->
IO
()
...
...
@@ -738,6 +756,79 @@ newPackageDepsBehaviour :: PackageDescription -> Bool
newPackageDepsBehaviour
pkg
=
specVersion
pkg
>=
newPackageDepsBehaviourMinVersion
-- We are given both --constraint="foo < 2.0" style constraints and also
-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".
--
-- When finalising the package we have to take into account the specific
-- installed deps we've been given, and the finalise function expects
-- constraints, so we have to translate these deps into version constraints.
--
-- But after finalising we then have to make sure we pick the right specific
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints
::
[
Dependency
]
->
[(
PackageName
,
InstalledPackageId
)]
->
PackageIndex
->
Either
String
([
Dependency
],
Map
PackageName
InstalledPackageInfo
)
combinedConstraints
constraints
dependencies
installedPackages
=
do
when
(
not
(
null
badInstalledPackageIds
))
$
Left
$
render
$
text
"The following package dependencies were requested"
$+$
nest
4
(
dispDependencies
badInstalledPackageIds
)
$+$
text
"however the given installed package instance does not exist."
when
(
not
(
null
badNames
))
$
Left
$
render
$
text
"The following package dependencies were requested"
$+$
nest
4
(
dispDependencies
badNames
)
$+$
text
"however the installed package's name does not match the name given."
--TODO: we don't check that all dependencies are used!
return
(
allConstraints
,
idConstraintMap
)
where
allConstraints
::
[
Dependency
]
allConstraints
=
constraints
++
[
thisPackageVersion
(
packageId
pkg
)
|
(
_
,
_
,
Just
pkg
)
<-
dependenciesPkgInfo
]
idConstraintMap
::
Map
PackageName
InstalledPackageInfo
idConstraintMap
=
Map
.
fromList
[
(
packageName
pkg
,
pkg
)
|
(
_
,
_
,
Just
pkg
)
<-
dependenciesPkgInfo
]
-- The dependencies along with the installed package info, if it exists
dependenciesPkgInfo
::
[(
PackageName
,
InstalledPackageId
,
Maybe
InstalledPackageInfo
)]
dependenciesPkgInfo
=
[
(
pkgname
,
ipkgid
,
mpkg
)
|
(
pkgname
,
ipkgid
)
<-
dependencies
,
let
mpkg
=
PackageIndex
.
lookupInstalledPackageId
installedPackages
ipkgid
]
-- If we looked up a package specified by an installed package id
-- (i.e. someone has written a hash) and didn't find it then it's
-- an error.
badInstalledPackageIds
=
[
(
pkgname
,
ipkgid
)
|
(
pkgname
,
ipkgid
,
Nothing
)
<-
dependenciesPkgInfo
]
-- If someone has written e.g.
-- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have
-- probably made a mistake.
badNames
=
[
(
requestedPkgName
,
ipkgid
)
|
(
requestedPkgName
,
ipkgid
,
Just
pkg
)
<-
dependenciesPkgInfo
,
let
foundPkgName
=
packageName
pkg
,
requestedPkgName
/=
foundPkgName
]
dispDependencies
deps
=
hsep
[
text
"--dependency="
<>
quotes
(
disp
pkgname
<>
char
'='
<>
disp
ipkgid
)
|
(
pkgname
,
ipkgid
)
<-
deps
]
-- -----------------------------------------------------------------------------
-- Configuring program dependencies
...
...
Cabal/Distribution/Simple/Setup.hs
View file @
6892a378
...
...
@@ -97,7 +97,9 @@ import Distribution.Text
(
Text
(
..
),
display
)
import
qualified
Distribution.Compat.ReadP
as
Parse
import
qualified
Text.PrettyPrint
as
Disp
import
Distribution.Package
(
Dependency
(
..
)
)
import
Distribution.Package
(
Dependency
(
..
)
,
PackageName
,
InstalledPackageId
)
import
Distribution.PackageDescription
(
FlagName
(
..
),
FlagAssignment
)
import
Distribution.Simple.Command
hiding
(
boolOpt
,
boolOpt'
)
...
...
@@ -307,6 +309,7 @@ data ConfigFlags = ConfigFlags {
configStripExes
::
Flag
Bool
,
-- ^Enable executable stripping
configConstraints
::
[
Dependency
],
-- ^Additional constraints for
-- dependencies
configDependencies
::
[(
PackageName
,
InstalledPackageId
)],
-- ^The packages depended on
configConfigurationsFlags
::
FlagAssignment
,
configTests
::
Flag
Bool
,
-- ^Enable test suite compilation
configBenchmarks
::
Flag
Bool
,
-- ^Enable benchmark compilation
...
...
@@ -506,14 +509,24 @@ configureOptions showOrParseArgs =
(
reqArg
"DEPENDENCY"
(
readP_to_E
(
const
"dependency expected"
)
((
\
x
->
[
x
])
`
fmap
`
parse
))
(
map
(
\
x
->
display
x
)))
,
option
""
[
"dependency"
]
"A list of exact dependencies. E.g., --dependency=
\"
void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309
\"
"
configDependencies
(
\
v
flags
->
flags
{
configDependencies
=
v
})
(
reqArg
"NAME=ID"
(
readP_to_E
(
const
"dependency expected"
)
((
\
x
->
[
x
])
`
fmap
`
parseDependency
))
(
map
(
\
x
->
display
(
fst
x
)
++
"="
++
display
(
snd
x
))))
,
option
""
[
"tests"
]
"dependency checking and compilation for test suites listed in the package description file."
configTests
(
\
v
flags
->
flags
{
configTests
=
v
})
(
boolOpt
[]
[]
)
,
option
""
[
"library-coverage"
]
"build library and test suites with Haskell Program Coverage enabled. (GHC only)"
configLibCoverage
(
\
v
flags
->
flags
{
configLibCoverage
=
v
})
(
boolOpt
[]
[]
)
,
option
""
[
"benchmarks"
]
"dependency checking and compilation for benchmarks listed in the package description file."
configBenchmarks
(
\
v
flags
->
flags
{
configBenchmarks
=
v
})
...
...
@@ -550,6 +563,13 @@ configureOptions showOrParseArgs =
reqArgFlag
title
_sf
_lf
d
(
fmap
fromPathTemplate
.
get
)
(
set
.
fmap
toPathTemplate
)
parseDependency
::
Parse
.
ReadP
r
(
PackageName
,
InstalledPackageId
)
parseDependency
=
do
x
<-
parse
_
<-
Parse
.
char
'='
y
<-
parse
return
(
x
,
y
)
installDirsOptions
::
[
OptionField
(
InstallDirs
(
Flag
PathTemplate
))]
installDirsOptions
=
[
option
""
[
"prefix"
]
...
...
@@ -644,6 +664,7 @@ instance Monoid ConfigFlags where
configStripExes
=
mempty
,
configExtraLibDirs
=
mempty
,
configConstraints
=
mempty
,
configDependencies
=
mempty
,
configExtraIncludeDirs
=
mempty
,
configConfigurationsFlags
=
mempty
,
configTests
=
mempty
,
...
...
@@ -678,6 +699,7 @@ instance Monoid ConfigFlags where
configStripExes
=
combine
configStripExes
,
configExtraLibDirs
=
combine
configExtraLibDirs
,
configConstraints
=
combine
configConstraints
,
configDependencies
=
combine
configDependencies
,
configExtraIncludeDirs
=
combine
configExtraIncludeDirs
,
configConfigurationsFlags
=
combine
configConfigurationsFlags
,
configTests
=
combine
configTests
,
...
...
cabal-install/Distribution/Client/BuildReports/Anonymous.hs
View file @
6892a378
...
...
@@ -146,17 +146,17 @@ new os' arch' comp (ConfiguredPackage pkg flags _ deps) result =
Left
(
BR
.
BuildFailed
_
)
->
BuildFailed
Left
(
BR
.
TestsFailed
_
)
->
TestsFailed
Left
(
BR
.
InstallFailed
_
)
->
InstallFailed
Right
(
BR
.
BuildOk
_
_
)
->
InstallOk
Right
(
BR
.
BuildOk
_
_
_
)
->
InstallOk
convertDocsOutcome
=
case
result
of
Left
_
->
NotTried
Right
(
BR
.
BuildOk
BR
.
DocsNotTried
_
)
->
NotTried
Right
(
BR
.
BuildOk
BR
.
DocsFailed
_
)
->
Failed
Right
(
BR
.
BuildOk
BR
.
DocsOk
_
)
->
Ok
Right
(
BR
.
BuildOk
BR
.
DocsNotTried
_
_
)
->
NotTried
Right
(
BR
.
BuildOk
BR
.
DocsFailed
_
_
)
->
Failed
Right
(
BR
.
BuildOk
BR
.
DocsOk
_
_
)
->
Ok
convertTestsOutcome
=
case
result
of
Left
(
BR
.
TestsFailed
_
)
->
Failed
Left
_
->
NotTried
Right
(
BR
.
BuildOk
_
BR
.
TestsNotTried
)
->
NotTried
Right
(
BR
.
BuildOk
_
BR
.
TestsOk
)
->
Ok
Right
(
BR
.
BuildOk
_
BR
.
TestsNotTried
_
)
->
NotTried
Right
(
BR
.
BuildOk
_
BR
.
TestsOk
_
)
->
Ok
cabalInstallID
::
PackageIdentifier
cabalInstallID
=
...
...
cabal-install/Distribution/Client/Configure.hs
View file @
6892a378
...
...
@@ -80,7 +80,7 @@ configure verbosity packageDBs repos comp platform conf
Left
message
->
die
message
Right
installPlan
->
case
InstallPlan
.
ready
installPlan
of
[
pkg
@
(
ConfiguredPackage
(
SourcePackage
_
_
(
LocalUnpackedPackage
_
)
_
)
_
_
_
)]
->
[
(
pkg
@
(
ConfiguredPackage
(
SourcePackage
_
_
(
LocalUnpackedPackage
_
)
_
)
_
_
_
),
_
)]
->
configurePackage
verbosity
(
InstallPlan
.
planPlatform
installPlan
)
(
InstallPlan
.
planCompiler
installPlan
)
...
...
cabal-install/Distribution/Client/Install.hs
View file @
6892a378
...
...
@@ -112,7 +112,8 @@ import qualified Distribution.Simple.Setup as Cabal
,
registerCommand
,
RegisterFlags
(
..
),
emptyRegisterFlags
,
testCommand
,
TestFlags
(
..
),
emptyTestFlags
)
import
Distribution.Simple.Utils
(
rawSystemExit
,
comparing
,
writeFileAtomic
)
(
rawSystemExit
,
comparing
,
writeFileAtomic
,
withTempFile
,
withFileContents
)
import
Distribution.Simple.InstallDirs
as
InstallDirs
(
PathTemplate
,
fromPathTemplate
,
toPathTemplate
,
substPathTemplate
,
initialPathTemplateEnv
,
installDirsTemplateEnv
)
...
...
@@ -126,6 +127,8 @@ import Distribution.PackageDescription
,
FlagName
(
..
),
FlagAssignment
)
import
Distribution.PackageDescription.Configuration
(
finalizePackageDescription
)
import
Distribution.ParseUtils
(
showPWarning
)
import
Distribution.Version
(
Version
,
anyVersion
,
thisVersion
)
import
Distribution.Simple.Utils
as
Utils
...
...
@@ -491,12 +494,13 @@ linearizeInstallPlan installedPkgIndex plan =
where
next
plan'
=
case
InstallPlan
.
ready
plan'
of
[]
->
Nothing
(
pkg
:
_
)
->
Just
((
pkg
,
status
),
plan''
)
(
(
pkg
,
_
)
:
_
)
->
Just
((
pkg
,
status
),
plan''
)
where
pkgid
=
packageId
pkg
status
=
packageStatus
installedPkgIndex
pkg
plan''
=
InstallPlan
.
completed
pkgid
(
BuildOk
DocsNotTried
TestsNotTried
)
(
BuildOk
DocsNotTried
TestsNotTried
(
Just
Installed
.
emptyInstalledPackageInfo
))
(
InstallPlan
.
processing
[
pkg
]
plan'
)
--FIXME: This is a bit of a hack,
-- pretending that each package is installed
...
...
@@ -750,7 +754,7 @@ regenerateHaddockIndex verbosity packageDBs comp platform conf
normalUserInstall
=
(
UserPackageDB
`
elem
`
packageDBs
)
&&
all
(
not
.
isSpecificPackageDB
)
packageDBs
installedDocs
(
InstallPlan
.
Installed
_
(
BuildOk
DocsOk
_
))
=
True
installedDocs
(
InstallPlan
.
Installed
_
(
BuildOk
DocsOk
_
_
))
=
True
installedDocs
_
=
False
isSpecificPackageDB
(
SpecificPackageDB
_
)
=
True
isSpecificPackageDB
_
=
False
...
...
@@ -886,9 +890,9 @@ performInstallations verbosity
installLock
<-
newLock
-- serialise installation
cacheLock
<-
newLock
-- serialise access to setup exe cache
executeInstallPlan
verbosity
jobControl
useLogFile
installPlan
$
\
cpkg
->
executeInstallPlan
verbosity
jobControl
useLogFile
installPlan
$
\
cpkg
deps
->
installConfiguredPackage
platform
compid
configFlags
cpkg
$
\
configFlags'
src
pkg
pkgoverride
->
cpkg
deps
$
\
configFlags'
src
pkg
pkgoverride
->
fetchSourcePackage
verbosity
fetchLimit
src
$
\
src'
->
installLocalPackage
verbosity
buildLimit
(
packageId
pkg
)
src'
$
\
mpath
->
installUnpackedPackage
verbosity
buildLimit
installLock
numJobs
...
...
@@ -993,7 +997,8 @@ executeInstallPlan :: Verbosity
->
JobControl
IO
(
PackageId
,
BuildResult
)
->
UseLogFile
->
InstallPlan
->
(
ConfiguredPackage
->
IO
BuildResult
)
->
(
ConfiguredPackage
->
[
Installed
.
InstalledPackageInfo
]
->
IO
BuildResult
)
->
IO
InstallPlan
executeInstallPlan
verbosity
jobCtl
useLogFile
plan0
installPkg
=
tryNewTasks
0
plan0
...
...
@@ -1006,13 +1011,13 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
sequence_
[
do
info
verbosity
$
"Ready to install "
++
display
pkgid
spawnJob
jobCtl
$
do
buildResult
<-
installPkg
pkg
buildResult
<-
installPkg
pkg
deps
return
(
packageId
pkg
,
buildResult
)
|
pkg
<-
pkgs
|
(
pkg
,
deps
)
<-
pkgs
,
let
pkgid
=
packageId
pkg
]
let
taskCount'
=
taskCount
+
length
pkgs
plan'
=
InstallPlan
.
processing
pkgs
plan
plan'
=
InstallPlan
.
processing
(
map
fst
pkgs
)
plan
waitForTasks
taskCount'
plan'
waitForTasks
taskCount
plan
=
do
...
...
@@ -1067,17 +1072,26 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
-- assignment or dependency constraints and use the new ones.
--
installConfiguredPackage
::
Platform
->
CompilerId
->
ConfigFlags
->
ConfiguredPackage
->
ConfigFlags
->
ConfiguredPackage
->
[
Installed
.
InstalledPackageInfo
]
->
(
ConfigFlags
->
PackageLocation
(
Maybe
FilePath
)
->
PackageDescription
->
PackageDescriptionOverride
->
a
)
->
a
installConfiguredPackage
platform
comp
configFlags
(
ConfiguredPackage
(
SourcePackage
_
gpkg
source
pkgoverride
)
flags
stanzas
deps
)
flags
stanzas
_
)
deps
installPkg
=
installPkg
configFlags
{
configConfigurationsFlags
=
flags
,
configConstraints
=
map
thisPackageVersion
deps
,
-- We generate the legacy constraints as well as the new style precise deps.
-- In the end only one set gets passed to Setup.hs configure, depending on
-- the Cabal version we are talking to.
configConstraints
=
[
thisPackageVersion
(
packageId
deppkg
)
|
deppkg
<-
deps
],
configDependencies
=
[
(
packageName
(
Installed
.
sourcePackageId
deppkg
),
Installed
.
installedPackageId
deppkg
)
|
deppkg
<-
deps
],
configBenchmarks
=
toFlag
False
,
configTests
=
toFlag
(
TestStanzas
`
elem
`
stanzas
)
}
source
pkg
pkgoverride
...
...
@@ -1225,7 +1239,11 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
|
otherwise
=
TestsNotTried
-- Install phase
onFailure
InstallFailed
$
criticalSection
installLock
$
onFailure
InstallFailed
$
criticalSection
installLock
$
do
-- Capture installed package configuration file
maybePkgConf
<-
maybeRegister
-- Actual installation
withWin32SelfUpgrade
verbosity
configFlags
compid
platform
pkg
$
do
case
rootCmd
miscOptions
of
(
Just
cmd
)
->
reexec
cmd
...
...
@@ -1233,7 +1251,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
setup
Cabal
.
copyCommand
copyFlags
when
shouldRegister
$
do
setup
Cabal
.
registerCommand
registerFlags
return
(
Right
(
BuildOk
docsResult
testsResult
))
return
(
Right
(
BuildOk
docsResult
testsResult
maybePkgConf
))
where
pkgid
=
packageId
pkg
...
...
@@ -1262,6 +1280,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
Cabal
.
regVerbosity
=
toFlag
verbosity'
}
verbosity'
=
maybe
verbosity
snd
useLogFile
tempTemplate
name
=
name
++
"-"
++
display
pkgid
addDefaultInstallDirs
::
ConfigFlags
->
IO
ConfigFlags
addDefaultInstallDirs
configFlags'
=
do
...
...
@@ -1278,6 +1297,30 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
userInstall
=
fromFlagOrDefault
defaultUserInstall
(
configUserInstall
configFlags'
)
maybeRegister
::
IO
(
Maybe
Installed
.
InstalledPackageInfo
)
maybeRegister
=
if
shouldRegister
then
do
tmp
<-
getTemporaryDirectory
withTempFile
tmp
(
tempTemplate
"pkgConf"
)
$
\
pkgConfFile
handle
->
do
hClose
handle
let
registerFlags'
version
=
(
registerFlags
version
)
{
Cabal
.
regGenPkgConf
=
toFlag
(
Just
pkgConfFile
)
}
setup
Cabal
.
registerCommand
registerFlags'
withFileContents
pkgConfFile
$
\
pkgConfText
->
case
Installed
.
parseInstalledPackageInfo
pkgConfText
of
Installed
.
ParseFailed
perror
->
pkgConfParseFailed
perror
Installed
.
ParseOk
warns
pkgConf
->
do
unless
(
null
warns
)
$
warn
verbosity
$
unlines
(
map
(
showPWarning
pkgConfFile
)
warns
)
return
(
Just
pkgConf
)
else
return
Nothing
pkgConfParseFailed
::
Installed
.
PError
->
IO
a
pkgConfParseFailed
perror
=
die
$
"Couldn't parse the output of 'setup register --gen-pkg-config':"
++
show
perror
setup
cmd
flags
=
do
Exception
.
bracket
(
case
useLogFile
of
...
...
cabal-install/Distribution/Client/InstallPlan.hs
View file @
6892a378
...
...
@@ -47,7 +47,8 @@ module Distribution.Client.InstallPlan (
import
Distribution.Client.Types
(
SourcePackage
(
packageDescription
),
ConfiguredPackage
(
..
)
,
InstalledPackage
,
BuildFailure
,
BuildSuccess
,
enableStanzas
)
,
InstalledPackage
,
BuildFailure
,
BuildSuccess
(
..
),
enableStanzas
,
InstalledPackage
(
..
)
)
import
Distribution.Package
(
PackageIdentifier
(
..
),
PackageName
(
..
),
Package
(
..
),
packageName
,
PackageFixedDeps
(
..
),
Dependency
(
..
)
)
...
...
@@ -73,11 +74,12 @@ import Distribution.Client.Utils
(
duplicates
,
duplicatesBy
,
mergeBy
,
MergeResult
(
..
)
)
import
Distribution.Simple.Utils
(
comparing
,
intercalate
)
import
qualified
Distribution.InstalledPackageInfo
as
Installed
import
Data.List
(
sort
,
sortBy
)
import
Data.Maybe
(
fromMaybe
)
(
fromMaybe
,
maybeToList
)
import
qualified
Data.Graph
as
Graph
import
Data.Graph
(
Graph
)
import
Control.Exception
...
...
@@ -204,7 +206,7 @@ remove shouldRemove plan =
-- configured state and have all their dependencies installed already.
-- The plan is complete if the result is @[]@.
--
ready
::
InstallPlan
->
[
ConfiguredPackage
]
ready
::
InstallPlan
->
[
(
ConfiguredPackage
,
[
Installed
.
InstalledPackageInfo
])
]
ready
plan
=
assert
check
readyPackages
where
check
=
if
null
readyPackages
&&
null
processingPackages
...
...
@@ -212,17 +214,31 @@ ready plan = assert check readyPackages
else
True
configuredPackages
=
[
pkg
|
Configured
pkg
<-
toList
plan
]
processingPackages
=
[
pkg
|
Processing
pkg
<-
toList
plan
]
readyPackages
=
filter
(
all
isInstalled
.
depends
)
configuredPackages
isInstalled
pkg
=
case
PackageIndex
.
lookupPackageId
(
planIndex
plan
)
pkg
of
Just
(
Configured
_
)
->
False
Just
(
Processing
_
)
->
False
Just
(
Failed
_
_
)
->
internalError
depOnFailed
Just
(
PreExisting
_
)
->
True
Just
(
Installed
_
_
)
->
True
Nothing
->
internalError
incomplete
readyPackages
::
[(
ConfiguredPackage
,
[
Installed
.
InstalledPackageInfo
])]
readyPackages
=
[
(
pkg
,
deps
)
|
pkg
<-
configuredPackages
-- select only the package that have all of their deps installed:
,
deps
<-
maybeToList
(
hasAllInstalledDeps
pkg
)
]
hasAllInstalledDeps
::
ConfiguredPackage
->
Maybe
[
Installed
.
InstalledPackageInfo
]
hasAllInstalledDeps
=
mapM
isInstalledDep
.
depends
isInstalledDep
::
PackageIdentifier
->
Maybe
Installed
.
InstalledPackageInfo
isInstalledDep
pkgid
=
case
PackageIndex
.
lookupPackageId
(
planIndex
plan
)
pkgid
of
Just
(
Configured
_
)
->
Nothing
Just
(
Processing
_
)
->
Nothing
Just
(
Failed
_
_
)
->
internalError
depOnFailed
Just
(
PreExisting
(
InstalledPackage
instPkg
_
))
->
Just
instPkg
Just
(
Installed
_
(
BuildOk
_
_
(
Just
instPkg
)))
->
Just
instPkg
Just
(
Installed
_
(
BuildOk
_
_
Nothing
))
->
internalError
depOnNonLib
Nothing
->
internalError
incomplete
incomplete
=
"install plan is not closed"
depOnFailed
=
"configured package depends on failed package"
depOnNonLib
=
"configured package depends on a non-library package"
-- | Marks packages in the graph as currently processing (e.g. building).
--
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
6892a378
...
...
@@ -241,24 +241,28 @@ configureOptions = commandOptions configureCommand
filterConfigureFlags
::
ConfigFlags
->
Version
->
ConfigFlags
filterConfigureFlags
flags
cabalLibVersion
|
cabalLibVersion
>=
Version
[
1
,
1
8
,
0
]
[]
=
flags
|
cabalLibVersion
>=
Version
[
1
,
1
9
,
1
]
[]
=
flags
_latest
|
cabalLibVersion
<
Version
[
1
,
3
,
10
]
[]
=
flags_1_3_10
|
cabalLibVersion
<
Version
[
1
,
10
,
0
]
[]
=
flags_1_10_0
|
cabalLibVersion
<
Version
[
1
,
14
,
0
]
[]
=
flags_1_14_0
|
cabalLibVersion
<
Version
[
1
,
18
,
0
]
[]
=
flags_1_18_0
-- A no-op that silences the "pattern match is non-exhaustive" warning.
|
otherwise
=
flags
|
cabalLibVersion
<
Version
[
1
,
19
,
1
]
[]
=
flags_1_19_0
|
otherwise
=
flags_latest
where
-- Cabal >= 1.19.1 uses --dependency and does not need --constraint
flags_latest
=
flags
{
configConstraints
=
[]
}
-- Cabal < 1.19.1 does not grok the --dependency flag.
flags_1_19_0
=
flags
{
configDependencies
=
[]
}
-- Cabal < 1.18.0 doesn't know about --extra-prog-path and --sysconfdir.
flags_1_18_0
=
flags
{
configProgramPathExtra
=
[]
flags_1_18_0
=
flags
_1_19_0
{
configProgramPathExtra
=
[]
,
configInstallDirs
=
configInstallDirs_1_18_0
}
configInstallDirs_1_18_0
=
(
configInstallDirs
flags
)
{
sysconfdir
=
NoFlag
}
-- Cabal < 1.14.0 doesn't know about --disable-benchmarks.
flags_1_14_0
=
flags_1_18_0
{
configBenchmarks
=
NoFlag
}
-- Cabal < 1.10.0 doesn't know about --disable-tests.
flags_1_10_0
=
flags_1_14_0
{
configTests
=
NoFlag
}
-- Cabal < 1.3.10 does not grok the constraints flag.
-- Cabal < 1.3.10 does not grok the
--
constraints flag.
flags_1_3_10
=
flags_1_10_0
{
configConstraints
=
[]
}