Skip to content

Commit e267103

Browse files
phadejphadej
committed
Resolve #6819. Wrote resolved active-repositories to freeze files
1 parent 265ce96 commit e267103

File tree

7 files changed

+43
-29
lines changed

7 files changed

+43
-29
lines changed

‎cabal-install/Distribution/Client/CmdFreeze.hs

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Distribution.Client.ProjectPlanning
1717
import Distribution.Client.ProjectConfig
1818
( ProjectConfig(..), ProjectConfigShared(..)
1919
, writeProjectLocalFreezeConfig )
20-
import Distribution.Client.IndexUtils (TotalIndexState)
20+
import Distribution.Client.IndexUtils (TotalIndexState, ActiveRepos)
2121
import Distribution.Client.Targets
2222
( UserQualifier(..), UserConstraintScope(..), UserConstraint(..) )
2323
import Distribution.Solver.Types.PackageConstraint
@@ -117,13 +117,13 @@ freezeAction flags@NixStyleFlags {..} extraArgs globalFlags = do
117117
localPackages
118118
} <- establishProjectBaseContext verbosity cliConfig OtherCommand
119119

120-
(_, elaboratedPlan, _, totalIndexState) <-
120+
(_, elaboratedPlan, _, totalIndexState, activeRepos) <-
121121
rebuildInstallPlan verbosity
122122
distDirLayout cabalDirLayout
123123
projectConfig
124124
localPackages
125125

126-
let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState
126+
let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState activeRepos
127127
writeProjectLocalFreezeConfig distDirLayout freezeConfig
128128
notice verbosity $
129129
"Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"
@@ -138,12 +138,17 @@ freezeAction flags@NixStyleFlags {..} extraArgs globalFlags = do
138138
-- | Given the install plan, produce a config value with constraints that
139139
-- freezes the versions of packages used in the plan.
140140
--
141-
projectFreezeConfig :: ElaboratedInstallPlan -> TotalIndexState -> ProjectConfig
142-
projectFreezeConfig elaboratedPlan totalIndexState = mempty
141+
projectFreezeConfig
142+
:: ElaboratedInstallPlan
143+
-> TotalIndexState
144+
-> ActiveRepos
145+
-> ProjectConfig
146+
projectFreezeConfig elaboratedPlan totalIndexState activeRepos = mempty
143147
{ projectConfigShared = mempty
144148
{ projectConfigConstraints =
145149
concat (Map.elems (projectFreezeConstraints elaboratedPlan))
146-
, projectConfigIndexState = Flag totalIndexState
150+
, projectConfigIndexState = Flag totalIndexState
151+
, projectConfigActiveRepos = Flag activeRepos
147152
}
148153
}
149154

‎cabal-install/Distribution/Client/Get.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,7 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
8181
activeRepos :: Maybe ActiveRepos
8282
activeRepos = flagToMaybe $ getActiveRepos getFlags
8383

84-
(sourcePkgDb, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState activeRepos
84+
(sourcePkgDb, _, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState activeRepos
8585

8686
pkgSpecifiers <- resolveUserTargets verbosity repoCtxt
8787
(fromFlag $ globalWorldFile globalFlags)

‎cabal-install/Distribution/Client/IndexUtils.hs

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,7 @@ import System.IO
107107
import System.IO.Unsafe (unsafeInterleaveIO)
108108
import System.IO.Error (isDoesNotExistError)
109109
import Distribution.Compat.Directory (listDirectory)
110+
import Distribution.Utils.Generic (fstOf3)
110111

111112
import qualified Codec.Compression.GZip as GZip
112113

@@ -194,7 +195,7 @@ filterCache (IndexStateTime ts0) cache0 = (cache, IndexStateInfo{..})
194195
-- This is a higher level wrapper used internally in cabal-install.
195196
getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
196197
getSourcePackages verbosity repoCtxt =
197-
fst <$> getSourcePackagesAtIndexState verbosity repoCtxt Nothing Nothing
198+
fstOf3 <$> getSourcePackagesAtIndexState verbosity repoCtxt Nothing Nothing
198199

199200
-- | Variant of 'getSourcePackages' which allows getting the source
200201
-- packages at a particular 'IndexState'.
@@ -210,7 +211,7 @@ getSourcePackagesAtIndexState
210211
-> RepoContext
211212
-> Maybe TotalIndexState
212213
-> Maybe ActiveRepos
213-
-> IO (SourcePackageDb, TotalIndexState)
214+
-> IO (SourcePackageDb, TotalIndexState, ActiveRepos)
214215
getSourcePackagesAtIndexState verbosity repoCtxt _ _
215216
| null (repoContextRepos repoCtxt) = do
216217
-- In the test suite, we routinely don't have any remote package
@@ -221,7 +222,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt _ _
221222
return (SourcePackageDb {
222223
packageIndex = mempty,
223224
packagePreferences = mempty
224-
}, headTotalIndexState)
225+
}, headTotalIndexState, ActiveRepos [])
225226
getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
226227
let describeState IndexStateHead = "most recent state"
227228
describeState (IndexStateTime time) = "historical state as of " ++ prettyShow time
@@ -299,6 +300,12 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
299300
Right x -> return x
300301
Left err -> warn verbosity err >> return (map (\x -> (x, CombineStrategyMerge)) pkgss)
301302

303+
let activeRepos' :: ActiveRepos
304+
activeRepos' = ActiveRepos
305+
[ ActiveRepo (rdRepoName rd) strategy
306+
| (rd, strategy) <- pkgss'
307+
]
308+
302309
let totalIndexState :: TotalIndexState
303310
totalIndexState = makeTotalIndexState IndexStateHead $ Map.fromList
304311
[ (n, IndexStateTime ts)
@@ -329,7 +336,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
329336
return (SourcePackageDb {
330337
packageIndex = pkgs,
331338
packagePreferences = prefs
332-
}, totalIndexState)
339+
}, totalIndexState, activeRepos')
333340

334341
-- auxiliary data used in getSourcePackagesAtIndexState
335342
data RepoData = RepoData

‎cabal-install/Distribution/Client/Install.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -261,9 +261,9 @@ makeInstallContext verbosity
261261

262262
let idxState = flagToMaybe (installIndexState installFlags)
263263

264-
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
265-
(sourcePkgDb, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState Nothing
266-
pkgConfigDb <- readPkgConfigDb verbosity progdb
264+
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
265+
(sourcePkgDb, _, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState Nothing
266+
pkgConfigDb <- readPkgConfigDb verbosity progdb
267267

268268
checkConfigExFlags verbosity installedPkgIndex
269269
(packageIndex sourcePkgDb) configExFlags

‎cabal-install/Distribution/Client/ProjectOrchestration.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -300,7 +300,7 @@ withInstallPlan
300300
-- everything in the project. This is independent of any specific targets
301301
-- the user has asked for.
302302
--
303-
(elaboratedPlan, _, elaboratedShared, _) <-
303+
(elaboratedPlan, _, elaboratedShared, _, _) <-
304304
rebuildInstallPlan verbosity
305305
distDirLayout cabalDirLayout
306306
projectConfig
@@ -325,7 +325,7 @@ runProjectPreBuildPhase
325325
-- everything in the project. This is independent of any specific targets
326326
-- the user has asked for.
327327
--
328-
(elaboratedPlan, _, elaboratedShared, _) <-
328+
(elaboratedPlan, _, elaboratedShared, _, _) <-
329329
rebuildInstallPlan verbosity
330330
distDirLayout cabalDirLayout
331331
projectConfig

‎cabal-install/Distribution/Client/ProjectPlanning.hs

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -392,8 +392,10 @@ rebuildInstallPlan :: Verbosity
392392
-> IO ( ElaboratedInstallPlan -- with store packages
393393
, ElaboratedInstallPlan -- with source packages
394394
, ElaboratedSharedConfig
395-
, IndexUtils.TotalIndexState )
396-
-- ^ @(improvedPlan, elaboratedPlan, _, _)@
395+
, IndexUtils.TotalIndexState
396+
, IndexUtils.ActiveRepos
397+
)
398+
-- ^ @(improvedPlan, elaboratedPlan, _, _, _)@
397399
rebuildInstallPlan verbosity
398400
distDirLayout@DistDirLayout {
399401
distProjectRootDirectory,
@@ -413,14 +415,14 @@ rebuildInstallPlan verbosity
413415
(projectConfigMonitored, localPackages, progsearchpath) $ do
414416

415417
-- And so is the elaborated plan that the improved plan based on
416-
(elaboratedPlan, elaboratedShared, totalIndexState) <-
418+
(elaboratedPlan, elaboratedShared, totalIndexState, activeRepos) <-
417419
rerunIfChanged verbosity fileMonitorElaboratedPlan
418420
(projectConfigMonitored, localPackages,
419421
progsearchpath) $ do
420422

421423
compilerEtc <- phaseConfigureCompiler projectConfig
422424
_ <- phaseConfigurePrograms projectConfig compilerEtc
423-
(solverPlan, pkgConfigDB, totalIndexState)
425+
(solverPlan, pkgConfigDB, totalIndexState, activeRepos)
424426
<- phaseRunSolver projectConfig
425427
compilerEtc
426428
localPackages
@@ -431,14 +433,14 @@ rebuildInstallPlan verbosity
431433
localPackages
432434

433435
phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
434-
return (elaboratedPlan, elaboratedShared, totalIndexState)
436+
return (elaboratedPlan, elaboratedShared, totalIndexState, activeRepos)
435437

436438
-- The improved plan changes each time we install something, whereas
437439
-- the underlying elaborated plan only changes when input config
438440
-- changes, so it's worth caching them separately.
439441
improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
440442

441-
return (improvedPlan, elaboratedPlan, elaboratedShared, totalIndexState)
443+
return (improvedPlan, elaboratedPlan, elaboratedShared, totalIndexState, activeRepos)
442444

443445
where
444446
fileMonitorCompiler = newFileMonitorInCacheDir "compiler"
@@ -543,7 +545,7 @@ rebuildInstallPlan verbosity
543545
:: ProjectConfig
544546
-> (Compiler, Platform, ProgramDb)
545547
-> [PackageSpecifier UnresolvedSourcePackage]
546-
-> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState)
548+
-> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
547549
phaseRunSolver projectConfig@ProjectConfig {
548550
projectConfigShared,
549551
projectConfigBuildOnly
@@ -558,9 +560,9 @@ rebuildInstallPlan verbosity
558560
installedPkgIndex <- getInstalledPackages verbosity
559561
compiler progdb platform
560562
corePackageDbs
561-
(sourcePkgDb, tis)<- getSourcePackages verbosity withRepoCtx
562-
(solverSettingIndexState solverSettings)
563-
(solverSettingActiveRepos solverSettings)
563+
(sourcePkgDb, tis, ar) <- getSourcePackages verbosity withRepoCtx
564+
(solverSettingIndexState solverSettings)
565+
(solverSettingActiveRepos solverSettings)
564566
pkgConfigDB <- getPkgConfigDb verbosity progdb
565567

566568
--TODO: [code cleanup] it'd be better if the Compiler contained the
@@ -578,7 +580,7 @@ rebuildInstallPlan verbosity
578580
planPackages verbosity compiler platform solver solverSettings
579581
installedPkgIndex sourcePkgDb pkgConfigDB
580582
localPackages localPackagesEnabledStanzas
581-
return (plan, pkgConfigDB, tis)
583+
return (plan, pkgConfigDB, tis, ar)
582584
where
583585
corePackageDbs = [GlobalPackageDB]
584586
withRepoCtx = projectConfigWithSolverRepoContext verbosity
@@ -760,7 +762,7 @@ getSourcePackages
760762
-> (forall a. (RepoContext -> IO a) -> IO a)
761763
-> Maybe IndexUtils.TotalIndexState
762764
-> Maybe IndexUtils.ActiveRepos
763-
-> Rebuild (SourcePackageDb, IndexUtils.TotalIndexState)
765+
-> Rebuild (SourcePackageDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos)
764766
getSourcePackages verbosity withRepoCtx idxState activeRepos = do
765767
(sourcePkgDbWithTIS, repos) <-
766768
liftIO $

‎cabal-install/tests/IntegrationTests2.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1505,7 +1505,7 @@ planProject testdir cliConfig = do
15051505
localPackages,
15061506
_buildSettings) <- configureProject testdir cliConfig
15071507

1508-
(elaboratedPlan, _, elaboratedShared, _) <-
1508+
(elaboratedPlan, _, elaboratedShared, _, _) <-
15091509
rebuildInstallPlan verbosity
15101510
distDirLayout cabalDirLayout
15111511
projectConfig

0 commit comments

Comments
 (0)