Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
abd2fa6a
Commit
abd2fa6a
authored
Sep 24, 2016
by
Herbert Valerio Riedel
🕺
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Hook up `--index-state` to `install` flags in CLI
parent
e0b393e5
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
62 additions
and
15 deletions
+62
-15
cabal-install/Distribution/Client/Config.hs
cabal-install/Distribution/Client/Config.hs
+1
-0
cabal-install/Distribution/Client/Install.hs
cabal-install/Distribution/Client/Install.hs
+6
-3
cabal-install/Distribution/Client/ProjectConfig.hs
cabal-install/Distribution/Client/ProjectConfig.hs
+3
-0
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
+3
-0
cabal-install/Distribution/Client/ProjectConfig/Types.hs
cabal-install/Distribution/Client/ProjectConfig/Types.hs
+6
-1
cabal-install/Distribution/Client/ProjectPlanning.hs
cabal-install/Distribution/Client/ProjectPlanning.hs
+7
-5
cabal-install/Distribution/Client/Setup.hs
cabal-install/Distribution/Client/Setup.hs
+18
-0
cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs
...tests/UnitTests/Distribution/Client/ArbitraryInstances.hs
+9
-0
cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
...tall/tests/UnitTests/Distribution/Client/ProjectConfig.hs
+9
-6
No files found.
cabal-install/Distribution/Client/Config.hs
View file @
abd2fa6a
...
...
@@ -249,6 +249,7 @@ instance Semigroup SavedConfig where
installUpgradeDeps
=
combine
installUpgradeDeps
,
installOnly
=
combine
installOnly
,
installOnlyDeps
=
combine
installOnlyDeps
,
installIndexState
=
combine
installIndexState
,
installRootCmd
=
combine
installRootCmd
,
installSummaryFile
=
lastNonEmptyNL
installSummaryFile
,
installLogFile
=
combine
installLogFile
,
...
...
cabal-install/Distribution/Client/Install.hs
View file @
abd2fa6a
...
...
@@ -80,7 +80,7 @@ import Distribution.Client.HttpUtils
import
Distribution.Solver.Types.PackageFixedDeps
import
qualified
Distribution.Client.Haddock
as
Haddock
(
regenerateHaddockIndex
)
import
Distribution.Client.IndexUtils
as
IndexUtils
(
getSourcePackages
,
getInstalledPackages
)
(
getSourcePackages
AtIndexState
,
IndexState
(
..
)
,
getInstalledPackages
)
import
qualified
Distribution.Client.InstallPlan
as
InstallPlan
import
qualified
Distribution.Client.SolverInstallPlan
as
SolverInstallPlan
import
Distribution.Client.InstallPlan
(
InstallPlan
)
...
...
@@ -277,10 +277,13 @@ makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget]
->
IO
InstallContext
makeInstallContext
verbosity
(
packageDBs
,
repoCtxt
,
comp
,
_
,
progdb
,
_
,
_
,
globalFlags
,
_
,
configExFlags
,
_
,
_
)
mUserTargets
=
do
globalFlags
,
_
,
configExFlags
,
installFlags
,
_
)
mUserTargets
=
do
let
idxState
=
fromFlagOrDefault
IndexStateHead
$
installIndexState
installFlags
installedPkgIndex
<-
getInstalledPackages
verbosity
comp
packageDBs
progdb
sourcePkgDb
<-
getSourcePackages
verbosity
repoCtxt
sourcePkgDb
<-
getSourcePackages
AtIndexState
verbosity
repoCtxt
idxState
pkgConfigDb
<-
readPkgConfigDb
verbosity
progdb
checkConfigExFlags
verbosity
installedPkgIndex
...
...
cabal-install/Distribution/Client/ProjectConfig.hs
View file @
abd2fa6a
...
...
@@ -58,6 +58,8 @@ import Distribution.Client.BuildReports.Types
(
ReportLevel
(
..
)
)
import
Distribution.Client.Config
(
loadConfig
,
defaultConfigFile
)
import
Distribution.Client.IndexUtils.Timestamp
(
IndexState
(
..
)
)
import
Distribution.Solver.Types.SourcePackage
import
Distribution.Solver.Types.Settings
...
...
@@ -202,6 +204,7 @@ resolveSolverSettings ProjectConfig{
solverSettingReorderGoals
=
fromFlag
projectConfigReorderGoals
solverSettingCountConflicts
=
fromFlag
projectConfigCountConflicts
solverSettingStrongFlags
=
fromFlag
projectConfigStrongFlags
solverSettingIndexState
=
fromFlagOrDefault
IndexStateHead
projectConfigIndexState
--solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals
--solverSettingShadowPkgs = fromFlag projectConfigShadowPkgs
--solverSettingReinstall = fromFlag projectConfigReinstall
...
...
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
View file @
abd2fa6a
...
...
@@ -302,6 +302,7 @@ convertLegacyAllPackageFlags globalFlags configFlags
--installReinstall = projectConfigReinstall,
--installAvoidReinstalls = projectConfigAvoidReinstalls,
--installOverrideReinstall = projectConfigOverrideReinstall,
installIndexState
=
projectConfigIndexState
,
installMaxBackjumps
=
projectConfigMaxBackjumps
,
--installUpgradeDeps = projectConfigUpgradeDeps,
installReorderGoals
=
projectConfigReorderGoals
,
...
...
@@ -505,6 +506,7 @@ convertToLegacySharedConfig
installStrongFlags
=
projectConfigStrongFlags
,
installOnly
=
mempty
,
installOnlyDeps
=
projectConfigOnlyDeps
,
installIndexState
=
projectConfigIndexState
,
installRootCmd
=
mempty
,
--no longer supported
installSummaryFile
=
projectConfigSummaryFile
,
installLogFile
=
projectConfigLogFile
,
...
...
@@ -848,6 +850,7 @@ legacySharedConfigFieldDescrs =
,
"one-shot"
,
"jobs"
,
"keep-going"
,
"offline"
-- solver flags:
,
"max-backjumps"
,
"reorder-goals"
,
"count-conflicts"
,
"strong-flags"
,
"index-state"
]
.
commandOptionsToFields
)
(
installOptions
ParseArgs
)
...
...
cabal-install/Distribution/Client/ProjectConfig/Types.hs
View file @
abd2fa6a
...
...
@@ -29,6 +29,9 @@ import Distribution.Client.Targets
import
Distribution.Client.BuildReports.Types
(
ReportLevel
(
..
)
)
import
Distribution.Client.IndexUtils.Timestamp
(
IndexState
)
import
Distribution.Solver.Types.Settings
import
Distribution.Solver.Types.ConstraintSource
...
...
@@ -164,6 +167,7 @@ data ProjectConfigShared
-- configuration used both by the solver and other phases
projectConfigRemoteRepos
::
NubList
RemoteRepo
,
-- ^ Available Hackage servers.
projectConfigLocalRepos
::
NubList
FilePath
,
projectConfigIndexState
::
Flag
IndexState
,
-- solver configuration
projectConfigConstraints
::
[(
UserConstraint
,
ConstraintSource
)],
...
...
@@ -347,7 +351,8 @@ data SolverSettings
solverSettingMaxBackjumps
::
Maybe
Int
,
solverSettingReorderGoals
::
ReorderGoals
,
solverSettingCountConflicts
::
CountConflicts
,
solverSettingStrongFlags
::
StrongFlags
solverSettingStrongFlags
::
StrongFlags
,
solverSettingIndexState
::
IndexState
-- Things that only make sense for manual mode, not --local mode
-- too much control!
--solverSettingIndependentGoals :: Bool,
...
...
cabal-install/Distribution/Client/ProjectPlanning.hs
View file @
abd2fa6a
...
...
@@ -480,8 +480,9 @@ rebuildInstallPlan verbosity
installedPkgIndex
<-
getInstalledPackages
verbosity
compiler
progdb
platform
corePackageDbs
sourcePkgDb
<-
getSourcePackages
verbosity
withRepoCtx
pkgConfigDB
<-
getPkgConfigDb
verbosity
progdb
sourcePkgDb
<-
getSourcePackages
verbosity
withRepoCtx
(
solverSettingIndexState
solverSettings
)
pkgConfigDB
<-
getPkgConfigDb
verbosity
progdb
--TODO: [code cleanup] it'd be better if the Compiler contained the
-- ConfiguredPrograms that it needs, rather than relying on the progdb
...
...
@@ -688,12 +689,13 @@ getExecutableDBContents storeDirectory = do
valid
_
=
True
getSourcePackages
::
Verbosity
->
(
forall
a
.
(
RepoContext
->
IO
a
)
->
IO
a
)
->
Rebuild
SourcePackageDb
getSourcePackages
verbosity
withRepoCtx
=
do
->
IndexUtils
.
IndexState
->
Rebuild
SourcePackageDb
getSourcePackages
verbosity
withRepoCtx
idxState
=
do
(
sourcePkgDb
,
repos
)
<-
liftIO
$
withRepoCtx
$
\
repoctx
->
do
sourcePkgDb
<-
IndexUtils
.
getSourcePackages
verbosity
repoctx
sourcePkgDb
<-
IndexUtils
.
getSourcePackagesAtIndexState
verbosity
repoctx
idxState
return
(
sourcePkgDb
,
repoContextRepos
repoctx
)
monitorFiles
.
map
monitorFile
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
abd2fa6a
...
...
@@ -61,6 +61,10 @@ import Distribution.Client.BuildReports.Types
(
ReportLevel
(
..
)
)
import
Distribution.Client.Dependency.Types
(
PreSolver
(
..
)
)
import
Distribution.Client.IndexUtils.Timestamp
(
IndexState
)
import
qualified
Distribution.Client.Init.Types
as
IT
(
InitFlags
(
..
),
PackageType
(
..
)
)
import
Distribution.Client.Targets
...
...
@@ -1219,6 +1223,7 @@ data InstallFlags = InstallFlags {
installUpgradeDeps
::
Flag
Bool
,
installOnly
::
Flag
Bool
,
installOnlyDeps
::
Flag
Bool
,
installIndexState
::
Flag
IndexState
,
installRootCmd
::
Flag
String
,
installSummaryFile
::
NubList
PathTemplate
,
installLogFile
::
Flag
PathTemplate
,
...
...
@@ -1252,6 +1257,7 @@ defaultInstallFlags = InstallFlags {
installUpgradeDeps
=
Flag
False
,
installOnly
=
Flag
False
,
installOnlyDeps
=
Flag
False
,
installIndexState
=
mempty
,
installRootCmd
=
mempty
,
installSummaryFile
=
mempty
,
installLogFile
=
mempty
,
...
...
@@ -1424,6 +1430,18 @@ installOptions showOrParseArgs =
installOnlyDeps
(
\
v
flags
->
flags
{
installOnlyDeps
=
v
})
(
yesNoOpt
showOrParseArgs
)
,
option
[]
[
"index-state"
]
(
"Use source package index state as it existed at a previous time. "
++
"Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps "
++
"(e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD')."
)
installIndexState
(
\
v
flags
->
flags
{
installIndexState
=
v
})
(
reqArg
"STATE"
(
readP_to_E
(
const
$
"index-state must be a "
++
"unix-timestamps (e.g. '@1474732068'), "
++
"a ISO8601 UTC timestamp "
++
"(e.g. '2016-09-24T17:47:48Z'), or 'HEAD'"
)
(
toFlag
`
fmap
`
parse
))
(
flagToList
.
fmap
display
))
,
option
[]
[
"root-cmd"
]
"(No longer supported, do not use.)"
installRootCmd
(
\
v
flags
->
flags
{
installRootCmd
=
v
})
...
...
cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs
View file @
abd2fa6a
...
...
@@ -30,6 +30,8 @@ import Distribution.Simple.InstallDirs
import
Distribution.Utils.NubList
import
Distribution.Client.IndexUtils.Timestamp
import
Test.QuickCheck
...
...
@@ -172,3 +174,10 @@ instance Arbitrary a => Arbitrary (NoShrink a) where
arbitrary
=
NoShrink
<$>
arbitrary
shrink
_
=
[]
instance
Arbitrary
Timestamp
where
arbitrary
=
(
maybe
(
toEnum
0
)
id
.
epochTimeToTimestamp
)
<$>
arbitrary
instance
Arbitrary
IndexState
where
arbitrary
=
frequency
[
(
1
,
pure
IndexStateHead
)
,
(
50
,
IndexStateTime
<$>
arbitrary
)
]
cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
View file @
abd2fa6a
...
...
@@ -344,6 +344,7 @@ instance Arbitrary ProjectConfigShared where
<*>
arbitrary
<*>
arbitrary
<*>
(
toNubList
<$>
listOf
arbitraryShortToken
)
<*>
arbitrary
<*>
arbitraryConstraints
<*>
shortListOf
2
arbitrary
<*>
arbitrary
<*>
arbitrary
...
...
@@ -358,19 +359,21 @@ instance Arbitrary ProjectConfigShared where
shrink
(
ProjectConfigShared
x00
x01
x02
x03
x04
x05
x06
x07
x08
x09
x10
x11
x12
x13
x14
x15
)
=
x10
x11
x12
x13
x14
x15
x16
)
=
[
ProjectConfigShared
x00'
(
fmap
getNonEmpty
x01'
)
(
fmap
getNonEmpty
x02'
)
x03'
x04'
x05'
(
postShrink_Constraints
x0
6
'
)
x07'
x08'
x09'
x10'
x11'
x12'
x13'
x14'
x15'
x05'
x06'
(
postShrink_Constraints
x0
7
'
)
x08'
x09'
x10'
x11'
x12'
x13'
x14'
x15'
x16'
|
((
x00'
,
x01'
,
x02'
,
x03'
,
x04'
),
(
x05'
,
x06'
,
x07'
,
x08'
,
x09'
),
(
x10'
,
x11'
,
x12'
,
x13'
,
x14'
),
x1
5
'
)
(
x15'
,
x1
6
'
)
)
<-
shrink
((
x00
,
fmap
NonEmpty
x01
,
fmap
NonEmpty
x02
,
x03
,
x04
),
(
x05
,
preShrink_Constraints
x06
,
x07
,
x08
,
x09
),
(
x10
,
x11
,
x12
,
x13
,
x14
),
x15
)
(
x05
,
x06
,
preShrink_Constraints
x07
,
x08
,
x09
),
(
x10
,
x11
,
x12
,
x13
,
x14
),
(
x15
,
x16
))
]
where
preShrink_Constraints
=
map
fst
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment