Skip to content

Commit aa1b9f0

Browse files
andreabediniandreabedini
committed
wip
1 parent c8f78a2 commit aa1b9f0

File tree

8 files changed

+59
-50
lines changed

8 files changed

+59
-50
lines changed

‎cabal-install-solver/src/Distribution/Solver/Modular.hs‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -82,19 +82,15 @@ showCP (CP qpi fa es ds) =
8282
-- | Ties the two worlds together: classic cabal-install vs. the modular
8383
-- solver. Performs the necessary translations before and after.
8484
modularResolver :: SolverConfig -> DependencyResolver loc
85-
modularResolver sc toolchains' sidx pprefs pcs pns = do
86-
(assignment, revdepmap) <- solve' sc toolchains idx pprefs gcs pns
85+
modularResolver sc toolchains pkgConfigDbs iidx sidx pprefs pcs pns = do
86+
(assignment, revdepmap) <- solve' sc toolchains pkgConfigDbs idx pprefs gcs pns
8787
let cp = toCPs assignment revdepmap
8888
Step (show (vcat (map showCP cp))) $
8989
return $ postprocess assignment revdepmap
9090
where
9191
-- Indices have to be converted into solver-specific uniform index.
92-
idx = convPIs toolchains' gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
92+
idx = convPIs toolchains gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
9393

94-
-- idx = foldMap (\((Toolchain (Platform arch os) comp _progdb), iidx, _) ->
95-
-- convPIs os arch (compilerInfo comp) gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx
96-
-- ) toolchains'
97-
9894
-- Constraints have to be converted into a finite map indexed by PN.
9995
gcs = M.fromListWith (++) (map pair pcs)
10096
where

‎cabal-install-solver/src/Distribution/Solver/Modular/ConfiguredConversion.hs‎

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,29 +19,32 @@ import Distribution.Solver.Types.SolverId
1919
import Distribution.Solver.Types.SolverPackage
2020
import Distribution.Solver.Types.InstSolverPackage
2121
import Distribution.Solver.Types.SourcePackage
22+
import Distribution.Solver.Types.Stage (Staged (..))
2223

2324
-- | Converts from the solver specific result @CP QPN@ into
2425
-- a 'ResolverPackage', which can then be converted into
2526
-- the install plan.
26-
convCP :: SI.InstalledPackageIndex ->
27+
convCP :: Staged SI.InstalledPackageIndex ->
2728
CI.PackageIndex (SourcePackage loc) ->
2829
CP QPN -> ResolverPackage loc
2930
convCP iidx sidx (CP qpi fa es ds) =
3031
case qpi of
3132
-- Installed
32-
(PI qpn (I _ _ (Inst pi))) ->
33+
(PI qpn (I s _ (Inst pi))) ->
3334
PreExisting $
3435
InstSolverPackage {
36+
instSolverStage = s,
3537
instSolverQPN = qpn,
36-
instSolverPkgIPI = fromMaybe (error "convCP: lookupUnitId failed") $ SI.lookupUnitId iidx pi,
38+
instSolverPkgIPI = fromMaybe (error "convCP: lookupUnitId failed") $ SI.lookupUnitId (getStage iidx s) pi,
3739
instSolverPkgLibDeps = fmap fst ds',
3840
instSolverPkgExeDeps = fmap snd ds'
3941
}
4042
-- "In repo" i.e. a source package
41-
(PI qpn@(Q _path pn) (I _ v InRepo)) ->
43+
(PI qpn@(Q _path pn) (I s v InRepo)) ->
4244
let pi = PackageIdentifier pn v in
4345
Configured $
4446
SolverPackage {
47+
solverPkgStage = s,
4548
solverPkgQPN = qpn,
4649
solverPkgSource = fromMaybe (error "convCP: lookupPackageId failed") $ CI.lookupPackageId sidx pi,
4750
solverPkgFlags = fa,

‎cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@ solve :: SolverConfig -- ^ solver parameters
9797
-> M.Map PN [LabeledPackageConstraint] -- ^ global constraints
9898
-> S.Set PN -- ^ global goals
9999
-> RetryLog Message SolverFailure (Assignment, RevDepMap)
100-
solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
100+
solve sc cinfo pkgConfigDB idx userPrefs userConstraints userGoals =
101101
explorePhase .
102102
traceTree "cycles.json" id .
103103
detectCycles .
@@ -119,7 +119,9 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
119119
(fineGrainedConflicts sc)
120120
(countConflicts sc)
121121
idx
122+
122123
detectCycles = detectCyclesPhase
124+
123125
heuristicsPhase =
124126
let
125127
sortGoals = case goalOrder sc of
@@ -132,19 +134,24 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
132134
PruneAfterFirstSuccess prune = pruneAfterFirstSuccess sc
133135
in sortGoals .
134136
(if prune then P.pruneAfterFirstSuccess else id)
137+
135138
preferencesPhase = P.preferLinked .
136139
P.preferPackagePreferences userPrefs
140+
137141
validationPhase = P.enforcePackageConstraints userConstraints .
138142
P.enforceManualFlags userConstraints
143+
139144
validationCata = P.enforceSingleInstanceRestriction .
140145
validateLinking idx .
141-
validateTree cinfo idx pkgConfigDB
146+
validateTree cinfo pkgConfigDB idx
147+
142148
prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) .
143149
(case onlyConstrained sc of
144150
OnlyConstrainedAll ->
145151
P.onlyConstrained pkgIsExplicit
146152
OnlyConstrainedNone ->
147153
id)
154+
148155
buildPhase = buildTree idx (independentGoals sc) (S.toList userGoals)
149156

150157
allExplicit = M.keysSet userConstraints `S.union` userGoals

‎cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -560,8 +560,8 @@ extendRequiredComponents eqpn available = foldM extendSingle
560560

561561

562562
-- | Interface.
563-
validateTree :: CompilerInfo -> Index -> Maybe PkgConfigDb -> Tree d c -> Tree d c
564-
validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS {
563+
validateTree :: CompilerInfo -> Maybe PkgConfigDb -> Index -> Tree d c -> Tree d c
564+
validateTree cinfo pkgConfigDb idx t = runValidate (validate t) VS {
565565
supportedExt = maybe (const True) -- if compiler has no list of extensions, we assume everything is supported
566566
(\ es -> let s = S.fromList es in \ x -> S.member x s)
567567
(compilerInfoExtensions cinfo)

‎cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,9 @@ import Distribution.Solver.Types.Toolchain (Toolchain)
2626
-- solving the package dependency problem and we want to make it easy to swap
2727
-- in alternatives.
2828
--
29-
type DependencyResolver loc = Staged (Toolchain, InstalledPackageIndex, Maybe PkgConfigDb)
29+
type DependencyResolver loc = Staged Toolchain
30+
-> Staged (Maybe PkgConfigDb)
31+
-> Staged InstalledPackageIndex
3032
-> PackageIndex (SourcePackage loc)
3133
-> (PackageName -> PackagePreferences)
3234
-> [LabeledPackageConstraint]

‎cabal-install-solver/src/Distribution/Solver/Types/InstSolverPackage.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..)
1010
import Distribution.Solver.Types.ComponentDeps ( ComponentDeps )
1111
import Distribution.Solver.Types.PackagePath (QPN)
1212
import Distribution.Solver.Types.SolverId
13+
import Distribution.Solver.Types.Stage (Stage)
1314
import Distribution.Types.MungedPackageId
1415
import Distribution.Types.PackageId
1516
import Distribution.Types.MungedPackageName
@@ -18,6 +19,7 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo)
1819
-- | An 'InstSolverPackage' is a pre-existing installed package
1920
-- specified by the dependency solver.
2021
data InstSolverPackage = InstSolverPackage {
22+
instSolverStage :: Stage,
2123
instSolverQPN :: QPN,
2224
instSolverPkgIPI :: InstalledPackageInfo,
2325
instSolverPkgLibDeps :: ComponentDeps [SolverId],

‎cabal-install-solver/src/Distribution/Solver/Types/SolverPackage.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ import Distribution.Solver.Types.OptionalStanza
1313
import Distribution.Solver.Types.PackagePath (QPN)
1414
import Distribution.Solver.Types.SolverId
1515
import Distribution.Solver.Types.SourcePackage
16+
import Distribution.Solver.Types.Stage (Stage)
1617

1718
-- | A 'SolverPackage' is a package specified by the dependency solver.
1819
-- It will get elaborated into a 'ConfiguredPackage' or even an
@@ -22,6 +23,7 @@ import Distribution.Solver.Types.SourcePackage
2223
-- but for symmetry we have the parameter. (Maybe it can be removed.)
2324
--
2425
data SolverPackage loc = SolverPackage {
26+
solverPkgStage :: Stage,
2527
solverPkgQPN :: QPN,
2628
solverPkgSource :: SourcePackage loc,
2729
solverPkgFlags :: FlagAssignment,

‎cabal-install/src/Distribution/Client/Dependency.hs‎

Lines changed: 31 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -176,7 +176,7 @@ import qualified Data.Set as Set
176176
-- implemented in terms of adjustments to the parameters.
177177
data DepResolverParams = DepResolverParams
178178
{ depResolverToolchains :: Staged Toolchain
179-
, depResolverPkgConfigDb :: Staged (Maybe PkgConfigDb)
179+
, depResolverPkgConfigDbs :: Staged (Maybe PkgConfigDb)
180180
, depResolverInstalledPkgIndex :: Staged InstalledPackageIndex
181181
, depResolverTargets :: Set PackageName
182182
, depResolverConstraints :: [LabeledPackageConstraint]
@@ -284,7 +284,7 @@ basicDepResolverParams
284284
basicDepResolverParams toolchains installedPkgIndex sourcePkgIndex =
285285
DepResolverParams
286286
{ depResolverToolchains = toolchains
287-
, depResolverPkgConfigDb = Staged (const Nothing)
287+
, depResolverPkgConfigDbs = Staged (const Nothing)
288288
, depResolverInstalledPkgIndex = installedPkgIndex
289289
, depResolverTargets = Set.empty
290290
, depResolverConstraints = []
@@ -805,38 +805,35 @@ resolveDependencies
805805
-> DepResolverParams
806806
-> Progress String String SolverInstallPlan
807807
resolveDependencies toolchains pkgConfigDBs params =
808-
let platform = error "TODO"
809-
comp = error "TODO"
810-
in
811-
812-
Step (showDepResolverParams finalparams) $
813-
fmap (validateSolverResult platform comp indGoals) $
814-
runSolver
815-
( SolverConfig
816-
reordGoals
817-
cntConflicts
818-
fineGrained
819-
minimize
820-
indGoals
821-
noReinstalls
822-
shadowing
823-
strFlags
824-
onlyConstrained_
825-
maxBkjumps
826-
enableBj
827-
solveExes
828-
order
829-
verbosity
830-
(PruneAfterFirstSuccess False)
831-
)
832-
toolchains
833-
installedPkgIndex
834-
pkgConfigDBs
835-
sourcePkgIndex
836-
preferences
837-
constraints
838-
targets
808+
Step (showDepResolverParams finalparams) $
809+
fmap (validateSolverResult (error "TODO") (error "TODO") indGoals) $
810+
runSolver
811+
sc
812+
toolchains
813+
pkgConfigDBs
814+
installedPkgIndex
815+
sourcePkgIndex
816+
preferences
817+
constraints
818+
targets
839819
where
820+
sc =
821+
SolverConfig
822+
reordGoals
823+
cntConflicts
824+
fineGrained
825+
minimize
826+
indGoals
827+
noReinstalls
828+
shadowing
829+
strFlags
830+
onlyConstrained_
831+
maxBkjumps
832+
enableBj
833+
solveExes
834+
order
835+
verbosity
836+
(PruneAfterFirstSuccess False)
840837
finalparams@( DepResolverParams
841838
{ depResolverTargets = targets
842839
, depResolverConstraints = constraints
@@ -1053,7 +1050,7 @@ configuredPackageProblems
10531050
configuredPackageProblems
10541051
platform
10551052
cinfo
1056-
(SolverPackage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
1053+
(SolverPackage _stage _qpn pkg specifiedFlags stanzas specifiedDeps0 _specifiedExeDeps') =
10571054
[ DuplicateFlag flag
10581055
| flag <- PD.findDuplicateFlagAssignments specifiedFlags
10591056
]

0 commit comments

Comments
 (0)