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
76adc3b5
Commit
76adc3b5
authored
Mar 05, 2016
by
bardur.arantsson
Browse files
Parameterize SourcePackage and ConfiguredPackage on package location
This is a step towards breaking the dependency from the modular solver on cabal-install.
parent
fc00e33c
Changes
19
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Dependency.hs
View file @
76adc3b5
...
...
@@ -73,6 +73,7 @@ import Distribution.Client.PkgConfigDb (PkgConfigDb)
import
Distribution.Client.Types
(
SourcePackageDb
(
SourcePackageDb
),
SourcePackage
(
..
)
,
ConfiguredPackage
(
..
),
ConfiguredId
(
..
)
,
UnresolvedPkgLoc
,
OptionalStanza
(
..
),
enableStanzas
)
import
Distribution.Client.Dependency.Types
(
PreSolver
(
..
),
Solver
(
..
),
DependencyResolver
,
ResolverPackage
(
..
)
...
...
@@ -145,7 +146,7 @@ data DepResolverParams = DepResolverParams {
depResolverPreferences
::
[
PackagePreference
],
depResolverPreferenceDefault
::
PackagesPreferenceDefault
,
depResolverInstalledPkgIndex
::
InstalledPackageIndex
,
depResolverSourcePkgIndex
::
PackageIndex
.
PackageIndex
SourcePackage
,
depResolverSourcePkgIndex
::
PackageIndex
.
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
,
depResolverReorderGoals
::
Bool
,
depResolverIndependentGoals
::
Bool
,
depResolverAvoidReinstalls
::
Bool
,
...
...
@@ -207,7 +208,7 @@ showPackagePreference (PackageStanzasPreference pn st) =
display
pn
++
" "
++
show
st
basicDepResolverParams
::
InstalledPackageIndex
->
PackageIndex
.
PackageIndex
SourcePackage
->
PackageIndex
.
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
DepResolverParams
basicDepResolverParams
installedPkgIndex
sourcePkgIndex
=
DepResolverParams
{
...
...
@@ -312,7 +313,7 @@ dontUpgradeNonUpgradeablePackages params =
.
InstalledPackageIndex
.
lookupPackageName
(
depResolverInstalledPkgIndex
params
)
addSourcePackages
::
[
SourcePackage
]
addSourcePackages
::
[
SourcePackage
UnresolvedPkgLoc
]
->
DepResolverParams
->
DepResolverParams
addSourcePackages
pkgs
params
=
params
{
...
...
@@ -381,7 +382,7 @@ removeUpperBounds allowNewer params =
where
sourcePkgIndex'
=
fmap
relaxDeps
$
depResolverSourcePkgIndex
params
relaxDeps
::
SourcePackage
->
SourcePackage
relaxDeps
::
SourcePackage
UnresolvedPkgLoc
->
SourcePackage
UnresolvedPkgLoc
relaxDeps
srcPkg
=
srcPkg
{
packageDescription
=
relaxPackageDeps
allowNewer
(
packageDescription
srcPkg
)
...
...
@@ -393,7 +394,7 @@ removeUpperBounds allowNewer params =
-- 'addSourcePackages'. Otherwise, the packages inserted by
-- 'addSourcePackages' won't have upper bounds in dependencies relaxed.
--
addDefaultSetupDependencies
::
(
SourcePackage
->
[
Dependency
])
addDefaultSetupDependencies
::
(
SourcePackage
UnresolvedPkgLoc
->
[
Dependency
])
->
DepResolverParams
->
DepResolverParams
addDefaultSetupDependencies
defaultSetupDeps
params
=
params
{
...
...
@@ -401,7 +402,7 @@ addDefaultSetupDependencies defaultSetupDeps params =
fmap
applyDefaultSetupDeps
(
depResolverSourcePkgIndex
params
)
}
where
applyDefaultSetupDeps
::
SourcePackage
->
SourcePackage
applyDefaultSetupDeps
::
SourcePackage
UnresolvedPkgLoc
->
SourcePackage
UnresolvedPkgLoc
applyDefaultSetupDeps
srcpkg
=
srcpkg
{
packageDescription
=
gpkgdesc
{
...
...
@@ -431,7 +432,7 @@ reinstallTargets params =
standardInstallPolicy
::
InstalledPackageIndex
->
SourcePackageDb
->
[
PackageSpecifier
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
DepResolverParams
standardInstallPolicy
installedPkgIndex
(
SourcePackageDb
sourcePkgIndex
sourcePkgPrefs
)
...
...
@@ -512,7 +513,7 @@ chooseSolver verbosity preSolver _cinfo =
info
verbosity
"Choosing modular solver."
return
Modular
runSolver
::
Solver
->
SolverConfig
->
DependencyResolver
runSolver
::
Solver
->
SolverConfig
->
DependencyResolver
UnresolvedPkgLoc
runSolver
TopDown
=
const
topDownResolver
-- TODO: warn about unsupported options
runSolver
Modular
=
modularResolver
...
...
@@ -619,7 +620,7 @@ interpretPackagesPreference selected defaultPref prefs =
validateSolverResult
::
Platform
->
CompilerInfo
->
Bool
->
[
ResolverPackage
]
->
[
ResolverPackage
UnresolvedPkgLoc
]
->
InstallPlan
validateSolverResult
platform
comp
indepGoals
pkgs
=
case
planPackagesProblems
platform
comp
pkgs
of
...
...
@@ -647,7 +648,7 @@ validateSolverResult platform comp indepGoals pkgs =
data
PlanPackageProblem
=
InvalidConfiguredPackage
ConfiguredPackage
[
PackageProblem
]
InvalidConfiguredPackage
(
ConfiguredPackage
UnresolvedPkgLoc
)
[
PackageProblem
]
showPlanPackageProblem
::
PlanPackageProblem
->
String
showPlanPackageProblem
(
InvalidConfiguredPackage
pkg
packageProblems
)
=
...
...
@@ -657,7 +658,7 @@ showPlanPackageProblem (InvalidConfiguredPackage pkg packageProblems) =
|
problem
<-
packageProblems
]
planPackagesProblems
::
Platform
->
CompilerInfo
->
[
ResolverPackage
]
->
[
ResolverPackage
UnresolvedPkgLoc
]
->
[
PlanPackageProblem
]
planPackagesProblems
platform
cinfo
pkgs
=
[
InvalidConfiguredPackage
pkg
packageProblems
...
...
@@ -706,7 +707,7 @@ showPackageProblem (InvalidDep dep pkgid) =
-- dependencies are satisfied by the specified packages.
--
configuredPackageProblems
::
Platform
->
CompilerInfo
->
ConfiguredPackage
->
[
PackageProblem
]
->
ConfiguredPackage
UnresolvedPkgLoc
->
[
PackageProblem
]
configuredPackageProblems
platform
cinfo
(
ConfiguredPackage
pkg
specifiedFlags
stanzas
specifiedDeps'
)
=
[
DuplicateFlag
flag
|
((
flag
,
_
)
:
_
)
<-
duplicates
specifiedFlags
]
...
...
@@ -787,14 +788,14 @@ configuredPackageProblems platform cinfo
-- It simply means preferences for installed packages will be ignored.
--
resolveWithoutDependencies
::
DepResolverParams
->
Either
[
ResolveNoDepsError
]
[
SourcePackage
]
->
Either
[
ResolveNoDepsError
]
[
SourcePackage
UnresolvedPkgLoc
]
resolveWithoutDependencies
(
DepResolverParams
targets
constraints
prefs
defpref
installedPkgIndex
sourcePkgIndex
_reorderGoals
_indGoals
_avoidReinstalls
_shadowing
_strFlags
_maxBjumps
)
=
collectEithers
(
map
selectPackage
targets
)
where
selectPackage
::
PackageName
->
Either
ResolveNoDepsError
SourcePackage
selectPackage
::
PackageName
->
Either
ResolveNoDepsError
(
SourcePackage
UnresolvedPkgLoc
)
selectPackage
pkgname
|
null
choices
=
Left
$!
ResolveUnsatisfiable
pkgname
requiredVersions
|
otherwise
=
Right
$!
maximumBy
bestByPrefs
choices
...
...
cabal-install/Distribution/Client/Dependency/Modular.hs
View file @
76adc3b5
...
...
@@ -12,9 +12,7 @@ module Distribution.Client.Dependency.Modular
import
Data.Map
as
M
(
fromListWith
)
import
Distribution.Client.Dependency.Modular.Assignment
(
Assignment
,
toCPs
)
import
Distribution.Client.Dependency.Modular.Dependency
(
RevDepMap
)
(
toCPs
)
import
Distribution.Client.Dependency.Modular.ConfiguredConversion
(
convCP
)
import
Distribution.Client.Dependency.Modular.IndexConversion
...
...
@@ -26,14 +24,14 @@ import Distribution.Client.Dependency.Modular.Package
import
Distribution.Client.Dependency.Modular.Solver
(
SolverConfig
(
..
),
solve
)
import
Distribution.Client.Dependency.Types
(
DependencyResolver
,
ResolverPackage
(
DependencyResolver
,
PackageConstraint
(
..
),
unlabelPackageConstraint
)
import
Distribution.System
(
Platform
(
..
)
)
-- | Ties the two worlds together: classic cabal-install vs. the modular
-- solver. Performs the necessary translations before and after.
modularResolver
::
SolverConfig
->
DependencyResolver
modularResolver
::
SolverConfig
->
DependencyResolver
loc
modularResolver
sc
(
Platform
arch
os
)
cinfo
iidx
sidx
pkgConfigDB
pprefs
pcs
pns
=
fmap
(
uncurry
postprocess
)
$
-- convert install plan
logToProgress
(
maxBackjumps
sc
)
$
-- convert log format into progress format
...
...
@@ -47,7 +45,6 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns
pair
lpc
=
(
pcName
$
unlabelPackageConstraint
lpc
,
[
lpc
])
-- Results have to be converted into an install plan.
postprocess
::
Assignment
->
RevDepMap
->
[
ResolverPackage
]
postprocess
a
rdm
=
map
(
convCP
iidx
sidx
)
(
toCPs
a
rdm
)
-- Helper function to extract the PN from a constraint.
...
...
cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs
View file @
76adc3b5
...
...
@@ -21,8 +21,8 @@ import Distribution.Client.ComponentDeps (ComponentDeps)
-- a 'ResolverPackage', which can then be converted into
-- the install plan.
convCP
::
SI
.
InstalledPackageIndex
->
CI
.
PackageIndex
SourcePackage
->
CP
QPN
->
ResolverPackage
CI
.
PackageIndex
(
SourcePackage
loc
)
->
CP
QPN
->
ResolverPackage
loc
convCP
iidx
sidx
(
CP
qpi
fa
es
ds
)
=
case
convPI
qpi
of
Left
pi
->
PreExisting
...
...
cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs
View file @
76adc3b5
...
...
@@ -38,7 +38,7 @@ import Distribution.Client.Dependency.Modular.Version
-- fix the problem there, so for now, shadowing is only activated if
-- explicitly requested.
convPIs
::
OS
->
Arch
->
CompilerInfo
->
Bool
->
Bool
->
SI
.
InstalledPackageIndex
->
CI
.
PackageIndex
SourcePackage
->
Index
SI
.
InstalledPackageIndex
->
CI
.
PackageIndex
(
SourcePackage
loc
)
->
Index
convPIs
os
arch
comp
sip
strfl
iidx
sidx
=
mkIndex
(
convIPI'
sip
iidx
++
convSPI'
os
arch
comp
strfl
sidx
)
...
...
@@ -88,11 +88,11 @@ convIPId pn' idx ipid =
-- | Convert a cabal-install source package index to the simpler,
-- more uniform index format of the solver.
convSPI'
::
OS
->
Arch
->
CompilerInfo
->
Bool
->
CI
.
PackageIndex
SourcePackage
->
[(
PN
,
I
,
PInfo
)]
CI
.
PackageIndex
(
SourcePackage
loc
)
->
[(
PN
,
I
,
PInfo
)]
convSPI'
os
arch
cinfo
strfl
=
L
.
map
(
convSP
os
arch
cinfo
strfl
)
.
CI
.
allPackages
-- | Convert a single source package into the solver-specific format.
convSP
::
OS
->
Arch
->
CompilerInfo
->
Bool
->
SourcePackage
->
(
PN
,
I
,
PInfo
)
convSP
::
OS
->
Arch
->
CompilerInfo
->
Bool
->
SourcePackage
loc
->
(
PN
,
I
,
PInfo
)
convSP
os
arch
cinfo
strfl
(
SourcePackage
(
PackageIdentifier
pn
pv
)
gpd
_
_pl
)
=
let
i
=
I
pv
InRepo
in
(
pn
,
i
,
convGPD
os
arch
cinfo
strfl
(
PI
pn
i
)
gpd
)
...
...
cabal-install/Distribution/Client/Dependency/TopDown.hs
View file @
76adc3b5
...
...
@@ -21,6 +21,7 @@ import Distribution.Client.Dependency.TopDown.Constraints
(
Satisfiable
(
..
)
)
import
Distribution.Client.Types
(
SourcePackage
(
..
),
ConfiguredPackage
(
..
)
,
UnresolvedPkgLoc
,
enableStanzas
,
ConfiguredId
(
..
),
fakeUnitId
)
import
Distribution.Client.Dependency.Types
(
DependencyResolver
,
ResolverPackage
(
..
)
...
...
@@ -250,7 +251,7 @@ search configure pref constraints =
-- | The main exported resolver, with string logging and failure types to fit
-- the standard 'DependencyResolver' interface.
--
topDownResolver
::
DependencyResolver
topDownResolver
::
DependencyResolver
UnresolvedPkgLoc
topDownResolver
platform
cinfo
installedPkgIndex
sourcePkgIndex
_pkgConfigDB
preferences
constraints
targets
=
mapMessages
$
topDownResolver'
...
...
@@ -268,11 +269,11 @@ topDownResolver platform cinfo installedPkgIndex sourcePkgIndex _pkgConfigDB
--
topDownResolver'
::
Platform
->
CompilerInfo
->
PackageIndex
InstalledPackage
->
PackageIndex
SourcePackage
->
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
(
PackageName
->
PackagePreferences
)
->
[
PackageConstraint
]
->
[
PackageName
]
->
Progress
Log
Failure
[
ResolverPackage
]
->
Progress
Log
Failure
[
ResolverPackage
UnresolvedPkgLoc
]
topDownResolver'
platform
cinfo
installedPkgIndex
sourcePkgIndex
preferences
constraints
targets
=
fmap
(
uncurry
finalise
)
...
...
@@ -300,7 +301,7 @@ topDownResolver' platform cinfo installedPkgIndex sourcePkgIndex
.
PackageIndex
.
fromList
$
finaliseSelectedPackages
preferences
selected'
constraints'
toResolverPackage
::
FinalSelectedPackage
->
ResolverPackage
toResolverPackage
::
FinalSelectedPackage
->
ResolverPackage
UnresolvedPkgLoc
toResolverPackage
(
SelectedInstalled
(
InstalledPackage
pkg
_
))
=
PreExisting
pkg
toResolverPackage
(
SelectedSource
pkg
)
=
Configured
pkg
...
...
@@ -446,7 +447,7 @@ annotateInstalledPackages dfsNumber installed = PackageIndex.fromList
--
annotateSourcePackages
::
[
PackageConstraint
]
->
(
PackageName
->
TopologicalSortNumber
)
->
PackageIndex
SourcePackage
->
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
PackageIndex
UnconfiguredPackage
annotateSourcePackages
constraints
dfsNumber
sourcePkgIndex
=
PackageIndex
.
fromList
...
...
@@ -483,7 +484,7 @@ annotateSourcePackages constraints dfsNumber sourcePkgIndex =
-- heuristic.
--
topologicalSortNumbering
::
PackageIndex
InstalledPackage
->
PackageIndex
SourcePackage
->
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
(
PackageName
->
TopologicalSortNumber
)
topologicalSortNumbering
installedPkgIndex
sourcePkgIndex
=
\
pkgname
->
let
Just
vertex
=
toVertex
pkgname
...
...
@@ -510,17 +511,17 @@ topologicalSortNumbering installedPkgIndex sourcePkgIndex =
-- and looking at the names of all possible dependencies.
--
selectNeededSubset
::
PackageIndex
InstalledPackage
->
PackageIndex
SourcePackage
->
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
Set
PackageName
->
(
PackageIndex
InstalledPackage
,
PackageIndex
SourcePackage
)
,
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
)
selectNeededSubset
installedPkgIndex
sourcePkgIndex
=
select
mempty
mempty
where
select
::
PackageIndex
InstalledPackage
->
PackageIndex
SourcePackage
->
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
Set
PackageName
->
(
PackageIndex
InstalledPackage
,
PackageIndex
SourcePackage
)
,
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
)
select
installedPkgIndex'
sourcePkgIndex'
remaining
|
Set
.
null
remaining
=
(
installedPkgIndex'
,
sourcePkgIndex'
)
|
otherwise
=
select
installedPkgIndex''
sourcePkgIndex''
remaining''
...
...
cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
View file @
76adc3b5
...
...
@@ -15,6 +15,7 @@ module Distribution.Client.Dependency.TopDown.Types where
import
Distribution.Client.Types
(
SourcePackage
(
..
),
ConfiguredPackage
(
..
)
,
UnresolvedPkgLoc
,
OptionalStanza
,
ConfiguredId
(
..
)
)
import
Distribution.InstalledPackageInfo
(
InstalledPackageInfo
)
...
...
@@ -44,7 +45,7 @@ data InstalledOrSource installed source
data
FinalSelectedPackage
=
SelectedInstalled
InstalledPackage
|
SelectedSource
ConfiguredPackage
|
SelectedSource
(
ConfiguredPackage
UnresolvedPkgLoc
)
type
TopologicalSortNumber
=
Int
...
...
@@ -62,18 +63,18 @@ data InstalledPackageEx
data
UnconfiguredPackage
=
UnconfiguredPackage
SourcePackage
(
SourcePackage
UnresolvedPkgLoc
)
!
TopologicalSortNumber
FlagAssignment
[
OptionalStanza
]
data
SemiConfiguredPackage
=
SemiConfiguredPackage
SourcePackage
-- package info
FlagAssignment
-- total flag assignment for the package
[
OptionalStanza
]
-- enabled optional stanzas
[
Dependency
]
-- dependencies we end up with when we apply
-- the flag assignment
(
SourcePackage
UnresolvedPkgLoc
)
-- package info
FlagAssignment
-- total flag assignment for the package
[
OptionalStanza
]
-- enabled optional stanzas
[
Dependency
]
-- dependencies we end up with when we apply
-- the flag assignment
instance
Package
InstalledPackage
where
packageId
(
InstalledPackage
pkg
_
)
=
packageId
pkg
...
...
@@ -131,7 +132,7 @@ class Package a => PackageSourceDeps a where
instance
PackageSourceDeps
InstalledPackageEx
where
sourceDeps
(
InstalledPackageEx
_
_
deps
)
=
deps
instance
PackageSourceDeps
ConfiguredPackage
where
instance
PackageSourceDeps
(
ConfiguredPackage
loc
)
where
sourceDeps
(
ConfiguredPackage
_
_
_
deps
)
=
map
confSrcId
$
CD
.
nonSetupDeps
deps
instance
PackageSourceDeps
InstalledPackage
where
...
...
cabal-install/Distribution/Client/Dependency/Types.hs
View file @
76adc3b5
...
...
@@ -113,23 +113,23 @@ instance Text PreSolver where
-- solving the package dependency problem and we want to make it easy to swap
-- in alternatives.
--
type
DependencyResolver
=
Platform
->
CompilerInfo
->
InstalledPackageIndex
->
PackageIndex
.
PackageIndex
SourcePackage
->
PkgConfigDb
->
(
PackageName
->
PackagePreferences
)
->
[
LabeledPackageConstraint
]
->
[
PackageName
]
->
Progress
String
String
[
ResolverPackage
]
type
DependencyResolver
loc
=
Platform
->
CompilerInfo
->
InstalledPackageIndex
->
PackageIndex
.
PackageIndex
(
SourcePackage
loc
)
->
PkgConfigDb
->
(
PackageName
->
PackagePreferences
)
->
[
LabeledPackageConstraint
]
->
[
PackageName
]
->
Progress
String
String
[
ResolverPackage
loc
]
-- | The dependency resolver picks either pre-existing installed packages
-- or it picks source packages along with package configuration.
--
-- This is like the 'InstallPlan.PlanPackage' but with fewer cases.
--
data
ResolverPackage
=
PreExisting
InstalledPackageInfo
|
Configured
ConfiguredPackage
data
ResolverPackage
loc
=
PreExisting
InstalledPackageInfo
|
Configured
(
ConfiguredPackage
loc
)
-- | Per-package constraints. Package constraints must be respected by the
-- solver. Multiple constraints for each package can be given, though obviously
...
...
cabal-install/Distribution/Client/Fetch.hs
View file @
76adc3b5
...
...
@@ -120,8 +120,8 @@ planPackages :: Verbosity
->
InstalledPackageIndex
->
SourcePackageDb
->
PkgConfigDb
->
[
PackageSpecifier
SourcePackage
]
->
IO
[
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
IO
[
SourcePackage
UnresolvedPkgLoc
]
planPackages
verbosity
comp
platform
fetchFlags
installedPkgIndex
sourcePkgDb
pkgConfigDb
pkgSpecifiers
...
...
cabal-install/Distribution/Client/FetchUtils.hs
View file @
76adc3b5
...
...
@@ -63,7 +63,7 @@ import qualified Hackage.Security.Client as Sec
-- | Returns @True@ if the package has already been fetched
-- or does not need fetching.
--
isFetched
::
PackageLocation
(
Maybe
FilePath
)
->
IO
Bool
isFetched
::
UnresolvedPkgLoc
->
IO
Bool
isFetched
loc
=
case
loc
of
LocalUnpackedPackage
_dir
->
return
True
LocalTarballPackage
_file
->
return
True
...
...
@@ -71,7 +71,7 @@ isFetched loc = case loc of
RepoTarballPackage
repo
pkgid
_
->
doesFileExist
(
packageFile
repo
pkgid
)
checkFetched
::
PackageLocation
(
Maybe
FilePath
)
checkFetched
::
UnresolvedPkgLoc
->
IO
(
Maybe
(
PackageLocation
FilePath
))
checkFetched
loc
=
case
loc
of
LocalUnpackedPackage
dir
->
...
...
@@ -96,7 +96,7 @@ checkFetched loc = case loc of
--
fetchPackage
::
Verbosity
->
RepoContext
->
PackageLocation
(
Maybe
FilePath
)
->
UnresolvedPkgLoc
->
IO
(
PackageLocation
FilePath
)
fetchPackage
verbosity
repoCtxt
loc
=
case
loc
of
LocalUnpackedPackage
dir
->
...
...
cabal-install/Distribution/Client/Freeze.hs
View file @
76adc3b5
...
...
@@ -131,7 +131,7 @@ planPackages :: Verbosity
->
InstalledPackageIndex
->
SourcePackageDb
->
PkgConfigDb
->
[
PackageSpecifier
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
IO
[
PlanPackage
]
planPackages
verbosity
comp
platform
mSandboxPkgInfo
freezeFlags
installedPkgIndex
sourcePkgDb
pkgConfigDb
pkgSpecifiers
=
do
...
...
@@ -196,7 +196,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
-- freezing. This is useful for removing previously installed packages
-- which are no longer required from the install plan.
pruneInstallPlan
::
InstallPlan
->
[
PackageSpecifier
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
[
PlanPackage
]
pruneInstallPlan
installPlan
pkgSpecifiers
=
removeSelf
pkgIds
$
...
...
cabal-install/Distribution/Client/Get.hs
View file @
76adc3b5
...
...
@@ -113,13 +113,13 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
prefix
=
fromFlagOrDefault
""
(
getDestDir
getFlags
)
fork
::
[
SourcePackage
]
->
IO
()
fork
::
[
SourcePackage
UnresolvedPkgLoc
]
->
IO
()
fork
pkgs
=
do
let
kind
=
fromFlag
.
getSourceRepository
$
getFlags
branchers
<-
findUsableBranchers
mapM_
(
forkPackage
verbosity
branchers
prefix
kind
)
pkgs
unpack
::
[
SourcePackage
]
->
IO
()
unpack
::
[
SourcePackage
UnresolvedPkgLoc
]
->
IO
()
unpack
pkgs
=
do
forM_
pkgs
$
\
pkg
->
do
location
<-
fetchPackage
verbosity
repoCtxt
(
packageSource
pkg
)
...
...
@@ -226,7 +226,7 @@ forkPackage :: Verbosity
-- be created.
->
(
Maybe
PD
.
RepoKind
)
-- ^ Which repo to choose.
->
SourcePackage
->
SourcePackage
loc
-- ^ The package to fork.
->
IO
()
forkPackage
verbosity
branchers
prefix
kind
src
=
do
...
...
cabal-install/Distribution/Client/IndexUtils.hs
View file @
76adc3b5
...
...
@@ -154,7 +154,7 @@ readCacheStrict verbosity index mkPkg = do
-- This is a higher level wrapper used internally in cabal-install.
--
readRepoIndex
::
Verbosity
->
RepoContext
->
Repo
->
IO
(
PackageIndex
SourcePackage
,
[
Dependency
])
->
IO
(
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
,
[
Dependency
])
readRepoIndex
verbosity
repoCtxt
repo
=
handleNotFound
$
do
warnIfIndexIsOld
=<<
getIndexFileAge
repo
...
...
cabal-install/Distribution/Client/Install.hs
View file @
76adc3b5
...
...
@@ -237,7 +237,7 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
-- | Common context for makeInstallPlan and processInstallPlan.
type
InstallContext
=
(
InstalledPackageIndex
,
SourcePackageDb
,
PkgConfigDb
,
[
UserTarget
],
[
PackageSpecifier
SourcePackage
]
,
[
UserTarget
],
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
,
HttpTransport
)
-- TODO: Make InstallArgs a proper data type with documented fields or just get
...
...
@@ -342,7 +342,7 @@ planPackages :: Compiler
->
InstalledPackageIndex
->
SourcePackageDb
->
PkgConfigDb
->
[
PackageSpecifier
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
Progress
String
String
InstallPlan
planPackages
comp
platform
mSandboxPkgInfo
solver
configFlags
configExFlags
installFlags
...
...
@@ -467,7 +467,7 @@ checkPrintPlan :: Verbosity
->
InstallPlan
->
SourcePackageDb
->
InstallFlags
->
[
PackageSpecifier
SourcePackage
]
->
[
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
]
->
IO
()
checkPrintPlan
verbosity
installed
installPlan
sourcePkgDb
installFlags
pkgSpecifiers
=
do
...
...
@@ -680,14 +680,14 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
toFlagAssignment
::
[
Flag
]
->
FlagAssignment
toFlagAssignment
=
map
(
\
f
->
(
flagName
f
,
flagDefault
f
))
nonDefaultFlags
::
ConfiguredPackage
->
FlagAssignment
nonDefaultFlags
::
ConfiguredPackage
loc
->
FlagAssignment
nonDefaultFlags
(
ConfiguredPackage
spkg
fa
_
_
)
=
let
defaultAssignment
=
toFlagAssignment
(
genPackageFlags
(
Source
.
packageDescription
spkg
))
in
fa
\\
defaultAssignment
stanzas
::
ConfiguredPackage
->
[
OptionalStanza
]
stanzas
::
ConfiguredPackage
loc
->
[
OptionalStanza
]
stanzas
(
ConfiguredPackage
_
_
sts
_
)
=
sts
showStanzas
::
[
OptionalStanza
]
->
String
...
...
@@ -1247,7 +1247,7 @@ executeInstallPlan verbosity _comp jobCtl useLogFile plan0 installPkg =
installReadyPackage
::
Platform
->
CompilerInfo
->
ConfigFlags
->
ReadyPackage
->
(
ConfigFlags
->
PackageLocation
(
Maybe
FilePath
)
->
(
ConfigFlags
->
UnresolvedPkgLoc
->
PackageDescription
->
PackageDescriptionOverride
->
a
)
...
...
@@ -1284,7 +1284,7 @@ fetchSourcePackage
::
Verbosity
->
RepoContext
->
JobLimit
->
PackageLocation
(
Maybe
FilePath
)
->
UnresolvedPkgLoc
->
(
PackageLocation
FilePath
->
IO
BuildResult
)
->
IO
BuildResult
fetchSourcePackage
verbosity
repoCtxt
fetchLimit
src
installPkg
=
do
...
...
cabal-install/Distribution/Client/InstallPlan.hs
View file @
76adc3b5
...
...
@@ -56,6 +56,7 @@ import Distribution.Package
import
Distribution.Client.Types
(
BuildSuccess
,
BuildFailure
,
PackageFixedDeps
(
..
),
ConfiguredPackage
,
UnresolvedPkgLoc
,
GenericReadyPackage
(
..
),
fakeUnitId
)
import
Distribution.Version
(
Version
)
...
...
@@ -151,7 +152,7 @@ instance (Binary ipkg, Binary srcpkg, Binary iresult, Binary ifailure)
=>
Binary
(
GenericPlanPackage
ipkg
srcpkg
iresult
ifailure
)
type
PlanPackage
=
GenericPlanPackage
InstalledPackageInfo
ConfiguredPackage
InstalledPackageInfo
(
ConfiguredPackage
UnresolvedPkgLoc
)
BuildSuccess
BuildFailure
instance
(
Package
ipkg
,
Package
srcpkg
)
=>
...
...
@@ -213,7 +214,7 @@ planPkgOf plan v =
-- | 'GenericInstallPlan' specialised to most commonly used types.
type
InstallPlan
=
GenericInstallPlan
InstalledPackageInfo
ConfiguredPackage
InstalledPackageInfo
(
ConfiguredPackage
UnresolvedPkgLoc
)
BuildSuccess
BuildFailure
type
PlanIndex
ipkg
srcpkg
iresult
ifailure
=
...
...
cabal-install/Distribution/Client/List.hs
View file @
76adc3b5
...
...
@@ -43,7 +43,7 @@ import Distribution.Text
(
Text
(
disp
),
display
)
import
Distribution.Client.Types
(
SourcePackage
(
..
),
SourcePackageDb
(
..
)
)
(
SourcePackage
(
..
),
SourcePackageDb
(
..
)
,
UnresolvedPkgLoc
)
import
Distribution.Client.Dependency.Types
(
PackageConstraint
(
..
)
)
import
Distribution.Client.Targets
...
...
@@ -90,7 +90,7 @@ getPkgList verbosity packageDBs repoCtxt comp conf listFlags pats = do
(
Map
.
lookup
name
(
packagePreferences
sourcePkgDb
))
pkgsInfo
::
[(
PackageName
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
])]
[(
PackageName
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
UnresolvedPkgLoc
])]
pkgsInfo
-- gather info for all packages
|
null
pats
=
mergePackages
...
...
@@ -101,7 +101,7 @@ getPkgList verbosity packageDBs repoCtxt comp conf listFlags pats = do
|
otherwise
=
pkgsInfoMatching
pkgsInfoMatching
::
[(
PackageName
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
])]
[(
PackageName
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
UnresolvedPkgLoc
])]
pkgsInfoMatching
=
let
matchingInstalled
=
matchingPackages
InstalledPackageIndex
.
searchByNameSubstring
...
...
@@ -206,8 +206,8 @@ info verbosity packageDBs repoCtxt comp conf
where
gatherPkgInfo
::
(
PackageName
->
VersionRange
)
->
InstalledPackageIndex
->
PackageIndex
.
PackageIndex
SourcePackage
->
PackageSpecifier
SourcePackage
->
PackageIndex
.
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
PackageSpecifier
(
SourcePackage
UnresolvedPkgLoc
)
->
Either
String
PackageDisplayInfo
gatherPkgInfo
prefs
installedPkgIndex
sourcePkgIndex
(
NamedPackage
name
constraints
)
...
...
@@ -251,8 +251,8 @@ sourcePkgsInfo ::
(
PackageName
->
VersionRange
)
->
PackageName
->
InstalledPackageIndex
->
PackageIndex
.
PackageIndex
SourcePackage
->
(
VersionRange
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
])
->
PackageIndex
.
PackageIndex
(
SourcePackage
UnresolvedPkgLoc
)
->
(
VersionRange
,
[
Installed
.
InstalledPackageInfo
],
[
SourcePackage
UnresolvedPkgLoc
])
sourcePkgsInfo
prefs
name
installedPkgIndex
sourcePkgIndex
=
(
pref
,
installedPkgs
,
sourcePkgs
)
where
...
...
@@ -268,7 +268,7 @@ sourcePkgsInfo prefs name installedPkgIndex sourcePkgIndex =
data
PackageDisplayInfo
=
PackageDisplayInfo
{
pkgName
::
PackageName
,
selectedVersion
::
Maybe
Version
,
selectedSourcePkg
::
Maybe
SourcePackage
,
selectedSourcePkg
::
Maybe
(
SourcePackage
UnresolvedPkgLoc
)
,
installedVersions
::
[
Version
],
sourceVersions
::
[
Version
],