Unverified Commit eba38fc8 authored by Oleg Grenrus's avatar Oleg Grenrus Committed by GitHub
Browse files

Merge pull request #6597 from phadej/totalindexstate

Allow specify index-state per repository
parents c52fdf78 a256df6d
......@@ -12,6 +12,7 @@ import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectConfig
( ProjectConfig(..), ProjectConfigShared(..)
, writeProjectLocalFreezeConfig )
import Distribution.Client.IndexUtils (TotalIndexState)
import Distribution.Client.Targets
( UserQualifier(..), UserConstraintScope(..), UserConstraint(..) )
import Distribution.Solver.Types.PackageConstraint
......@@ -34,12 +35,12 @@ import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import Distribution.Simple.Setup
( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault )
import Distribution.Simple.Flag (Flag (..))
import Distribution.Simple.Utils
( die', notice, wrapText )
import Distribution.Verbosity
( normal )
import Data.Monoid as Monoid
import qualified Data.Map as Map
import Data.Map (Map)
import Control.Monad (unless)
......@@ -119,13 +120,13 @@ freezeAction ( configFlags, configExFlags, installFlags
localPackages
} <- establishProjectBaseContext verbosity cliConfig OtherCommand
(_, elaboratedPlan, _) <-
(_, elaboratedPlan, _, totalIndexState) <-
rebuildInstallPlan verbosity
distDirLayout cabalDirLayout
projectConfig
localPackages
let freezeConfig = projectFreezeConfig elaboratedPlan
let freezeConfig = projectFreezeConfig elaboratedPlan totalIndexState
writeProjectLocalFreezeConfig distDirLayout freezeConfig
notice verbosity $
"Wrote freeze file: " ++ distProjectFile distDirLayout "freeze"
......@@ -143,13 +144,13 @@ freezeAction ( configFlags, configExFlags, installFlags
-- | Given the install plan, produce a config value with constraints that
-- freezes the versions of packages used in the plan.
--
projectFreezeConfig :: ElaboratedInstallPlan -> ProjectConfig
projectFreezeConfig elaboratedPlan =
Monoid.mempty {
projectConfigShared = Monoid.mempty {
projectConfigConstraints =
projectFreezeConfig :: ElaboratedInstallPlan -> TotalIndexState -> ProjectConfig
projectFreezeConfig elaboratedPlan totalIndexState = mempty
{ projectConfigShared = mempty
{ projectConfigConstraints =
concat (Map.elems (projectFreezeConstraints elaboratedPlan))
}
, projectConfigIndexState = Flag totalIndexState
}
}
-- | Given the install plan, produce solver constraints that will ensure the
......
......@@ -102,7 +102,7 @@ updateCommand = Client.installCommand {
data UpdateRequest = UpdateRequest
{ _updateRequestRepoName :: RepoName
, _updateRequestRepoState :: IndexState
, _updateRequestRepoState :: RepoIndexState
} deriving (Show)
instance Pretty UpdateRequest where
......@@ -146,7 +146,7 @@ updateAction ( configFlags, configExFlags, installFlags
++ "\" can not be found in known remote repo(s): "
++ intercalate ", " (map unRepoName remoteRepoNames)
let reposToUpdate :: [(Repo, IndexState)]
let reposToUpdate :: [(Repo, RepoIndexState)]
reposToUpdate = case updateRepoRequests of
-- If we are not given any specific repository, update all
-- repositories to HEAD.
......@@ -179,7 +179,7 @@ updateAction ( configFlags, configExFlags, installFlags
haddockFlags testFlags benchmarkFlags
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, IndexState)
updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, RepoIndexState)
-> IO ()
updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do
transport <- repoContextGetTransport repoCtxt
......
......@@ -52,7 +52,7 @@ import Distribution.Client.VCS
import Distribution.Client.FetchUtils
import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackagesAtIndexState )
( getSourcePackagesAtIndexState, TotalIndexState )
import Distribution.Solver.Types.SourcePackage
import Control.Exception
......@@ -86,9 +86,10 @@ get verbosity repoCtxt globalFlags getFlags userTargets = do
unless useSourceRepo $
mapM_ (checkTarget verbosity) userTargets
let idxState = flagToMaybe $ getIndexState getFlags
let idxState :: Maybe TotalIndexState
idxState = flagToMaybe $ getIndexState getFlags
sourcePkgDb <- getSourcePackagesAtIndexState verbosity repoCtxt idxState
(sourcePkgDb, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState
pkgSpecifiers <- resolveUserTargets verbosity repoCtxt
(fromFlag $ globalWorldFile globalFlags)
......
......@@ -26,10 +26,11 @@ module Distribution.Client.IndexUtils (
getSourcePackages,
getSourcePackagesMonitorFiles,
IndexState(..),
TotalIndexState,
getSourcePackagesAtIndexState,
Index(..),
RepoIndexState (..),
PackageEntry(..),
parsePackageIndex,
updateRepoIndexCache,
......@@ -177,7 +178,7 @@ emptyStateInfo = IndexStateInfo nullTimestamp nullTimestamp
-- resulting index cache.
--
-- Note: 'filterCache' is idempotent in the 'Cache' value
filterCache :: IndexState -> Cache -> (Cache, IndexStateInfo)
filterCache :: RepoIndexState -> Cache -> (Cache, IndexStateInfo)
filterCache IndexStateHead cache = (cache, IndexStateInfo{..})
where
isiMaxTime = cacheHeadTs cache
......@@ -198,7 +199,7 @@ filterCache (IndexStateTime ts0) cache0 = (cache, IndexStateInfo{..})
-- This is a higher level wrapper used internally in cabal-install.
getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
getSourcePackages verbosity repoCtxt =
getSourcePackagesAtIndexState verbosity repoCtxt Nothing
fst <$> getSourcePackagesAtIndexState verbosity repoCtxt Nothing
-- | Variant of 'getSourcePackages' which allows getting the source
-- packages at a particular 'IndexState'.
......@@ -206,11 +207,14 @@ getSourcePackages verbosity repoCtxt =
-- Current choices are either the latest (aka HEAD), or the index as
-- it was at a particular time.
--
-- TODO: Enhance to allow specifying per-repo 'IndexState's and also
-- report back per-repo 'IndexStateInfo's (in order for @v2-freeze@
-- to access it)
getSourcePackagesAtIndexState :: Verbosity -> RepoContext -> Maybe IndexState
-> IO SourcePackageDb
-- Returns also the total index where repositories'
-- RepoIndexState's are not HEAD. This is used in v2-freeze.
--
getSourcePackagesAtIndexState
:: Verbosity
-> RepoContext
-> Maybe TotalIndexState
-> IO (SourcePackageDb, TotalIndexState)
getSourcePackagesAtIndexState verbosity repoCtxt _
| null (repoContextRepos repoCtxt) = do
-- In the test suite, we routinely don't have any remote package
......@@ -218,25 +222,29 @@ getSourcePackagesAtIndexState verbosity repoCtxt _
warn (verboseUnmarkOutput verbosity) $
"No remote package servers have been specified. Usually " ++
"you would have one specified in the config file."
return SourcePackageDb {
return (SourcePackageDb {
packageIndex = mempty,
packagePreferences = mempty
}
}, headTotalIndexState)
getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState = do
let describeState IndexStateHead = "most recent state"
describeState (IndexStateTime time) = "historical state as of " ++ prettyShow time
pkgss <- forM (repoContextRepos repoCtxt) $ \r -> do
let rname = case r of
RepoRemote remote _ -> unRepoName $ remoteRepoName remote
RepoSecure remote _ -> unRepoName $ remoteRepoName remote
RepoLocalNoIndex local _ -> unRepoName $ localRepoName local
RepoLocal _ -> ""
let mrname :: Maybe RepoName
mrname = case r of
RepoRemote remote _ -> Just $ remoteRepoName remote
RepoSecure remote _ -> Just $ remoteRepoName remote
RepoLocalNoIndex local _ -> Just $ localRepoName local
RepoLocal _ -> Nothing
info verbosity ("Reading available packages of " ++ rname ++ "...")
let rname = fromMaybe (RepoName "__local-repository") mrname
info verbosity ("Reading available packages of " ++ unRepoName rname ++ "...")
idxState <- case mb_idxState of
Just idxState -> do
Just totalIdxState -> do
let idxState = lookupIndexState rname totalIdxState
info verbosity $ "Using " ++ describeState idxState ++
" as explicitly requested (via command line / project configuration)"
return idxState
......@@ -255,7 +263,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState = do
case r of
RepoLocal path -> warn verbosity ("index-state ignored for old-format repositories (local repository '" ++ path ++ "')")
RepoLocalNoIndex {} -> warn verbosity "index-state ignored for file+noindex repositories"
RepoRemote {} -> warn verbosity ("index-state ignored for old-format (remote repository '" ++ rname ++ "')")
RepoRemote {} -> warn verbosity ("index-state ignored for old-format (remote repository '" ++ unRepoName rname ++ "')")
RepoSecure {} -> pure ()
let idxState' = case r of
......@@ -266,36 +274,59 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState = do
case idxState' of
IndexStateHead -> do
info verbosity ("index-state("++rname++") = " ++ prettyShow (isiHeadTime isi))
info verbosity ("index-state("++ unRepoName rname ++") = " ++ prettyShow (isiHeadTime isi))
return ()
IndexStateTime ts0 -> do
when (isiMaxTime isi /= ts0) $
if ts0 > isiMaxTime isi
then warn verbosity $
"Requested index-state " ++ prettyShow ts0
++ " is newer than '" ++ rname ++ "'!"
++ " is newer than '" ++ unRepoName rname ++ "'!"
++ " Falling back to older state ("
++ prettyShow (isiMaxTime isi) ++ ")."
else info verbosity $
"Requested index-state " ++ prettyShow ts0
++ " does not exist in '"++rname++"'!"
++ " does not exist in '"++ unRepoName rname ++"'!"
++ " Falling back to older state ("
++ prettyShow (isiMaxTime isi) ++ ")."
info verbosity ("index-state("++rname++") = " ++
info verbosity ("index-state("++ unRepoName rname ++") = " ++
prettyShow (isiMaxTime isi) ++ " (HEAD = " ++
prettyShow (isiHeadTime isi) ++ ")")
pure (pis,deps)
pure RepoData
{ rdIndexStates = maybe [] (\n -> [(n, isiMaxTime isi)]) mrname
, rdIndex = pis
, rdPreferences = deps
}
let (pkgs, prefs) = mconcat pkgss
let RepoData indexStates pkgs prefs = mconcat pkgss
prefs' = Map.fromListWith intersectVersionRanges
[ (name, range) | Dependency name range _ <- prefs ]
totalIndexState = foldl'
(\acc (rn, ts) -> insertIndexState rn (IndexStateTime ts) acc)
headTotalIndexState
indexStates
_ <- evaluate pkgs
_ <- evaluate prefs'
return SourcePackageDb {
_ <- evaluate totalIndexState
return (SourcePackageDb {
packageIndex = pkgs,
packagePreferences = prefs'
}
}, totalIndexState)
-- auxiliary data used in getSourcePackagesAtIndexState
data RepoData = RepoData
{ rdIndexStates :: [(RepoName, Timestamp)]
, rdIndex :: PackageIndex UnresolvedSourcePackage
, rdPreferences :: [Dependency]
}
instance Semigroup RepoData where
RepoData x y z <> RepoData u v w = RepoData (x <> u) (y <> v) (z <> w)
instance Monoid RepoData where
mempty = RepoData mempty mempty mempty
mappend = (<>)
readCacheStrict :: NFData pkg => Verbosity -> Index -> (PackageEntry -> pkg) -> IO ([pkg], [Dependency])
readCacheStrict verbosity index mkPkg = do
......@@ -311,7 +342,7 @@ readCacheStrict verbosity index mkPkg = do
--
-- This is a higher level wrapper used internally in cabal-install.
--
readRepoIndex :: Verbosity -> RepoContext -> Repo -> IndexState
readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState
-> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo)
readRepoIndex verbosity repoCtxt repo idxState =
handleNotFound $ do
......@@ -729,7 +760,7 @@ readPackageIndexCacheFile :: Package pkg
=> Verbosity
-> (PackageEntry -> pkg)
-> Index
-> IndexState
-> RepoIndexState
-> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
readPackageIndexCacheFile verbosity mkPkg index idxState
| localNoIndex index = do
......@@ -922,7 +953,7 @@ writeNoIndexCache verbosity index cache = do
structuredEncodeFile path cache
-- | Write the 'IndexState' to the filesystem
writeIndexTimestamp :: Index -> IndexState -> IO ()
writeIndexTimestamp :: Index -> RepoIndexState -> IO ()
writeIndexTimestamp index st
= writeFile (timestampFile index) (prettyShow st)
......@@ -938,7 +969,7 @@ currentIndexTimestamp verbosity repoCtxt r = do
return (isiHeadTime isi)
-- | Read the 'IndexState' from the filesystem
readIndexTimestamp :: Index -> IO (Maybe IndexState)
readIndexTimestamp :: Index -> IO (Maybe RepoIndexState)
readIndexTimestamp index
= fmap simpleParsec (readFile (timestampFile index))
`catchIO` \e ->
......
......@@ -6,41 +6,137 @@
-- Copyright : (c) 2016 Herbert Valerio Riedel
-- License : BSD3
--
-- Timestamp type used in package indexes
-- Package repositories index state.
--
module Distribution.Client.IndexUtils.IndexState (
IndexState(..),
RepoIndexState(..),
TotalIndexState,
headTotalIndexState,
makeTotalIndexState,
lookupIndexState,
insertIndexState,
) where
import Distribution.Client.Compat.Prelude
import Distribution.Client.IndexUtils.Timestamp (Timestamp)
import Distribution.Client.Types (RepoName (..))
import Distribution.FieldGrammar.Described
import Distribution.Parsec (Parsec (..))
import Distribution.Pretty (Pretty (..))
import qualified Distribution.Compat.CharParsing as P
import qualified Data.Map.Strict as Map
import qualified Text.PrettyPrint as Disp
-------------------------------------------------------------------------------
-- Total index state
-------------------------------------------------------------------------------
-- | Index state of multiple repositories
data TotalIndexState = TIS RepoIndexState (Map RepoName RepoIndexState)
deriving (Eq, Show, Generic)
instance Binary TotalIndexState
instance Structured TotalIndexState
instance NFData TotalIndexState
instance Pretty TotalIndexState where
pretty (TIS IndexStateHead m)
| not (Map.null m)
= Disp.hsep
[ pretty rn <<>> Disp.colon <<>> pretty idx
| (rn, idx) <- Map.toList m
]
pretty (TIS def m) = foldl' go (pretty def) (Map.toList m) where
go doc (rn, idx) = doc Disp.<+> pretty rn <<>> Disp.colon <<>> pretty idx
instance Parsec TotalIndexState where
parsec = normalise . foldl' add headTotalIndexState <$> some (single0 <* P.spaces) where
-- hard to do without try
-- 2020-03-21T11:22:33Z looks like it begins with
-- repository name 2020-03-21T11
--
-- To make this easy, we could forbid repository names starting with digit
--
single0 = P.try single1 <|> TokTimestamp <$> parsec
single1 = do
token <- P.munch1 (\c -> isAlphaNum c || c == '_' || c == '-' || c == '.')
single2 token <|> single3 token
single2 token = do
_ <- P.char ':'
idx <- parsec
return (TokRepo (RepoName token) idx)
single3 "HEAD" = return TokHead
single3 token = P.unexpected ("Repository " ++ token ++ " without index state (after comma)")
add :: TotalIndexState -> Tok -> TotalIndexState
add _ TokHead = headTotalIndexState
add _ (TokTimestamp ts) = TIS (IndexStateTime ts) Map.empty
add (TIS def m) (TokRepo rn idx) = TIS def (Map.insert rn idx m)
instance Described TotalIndexState where
describe _ = REMunch1 RESpaces1 $ REUnion
[ describe (Proxy :: Proxy RepoName) <> reChar ':' <> ris
, ris
]
where
ris = describe (Proxy :: Proxy RepoIndexState)
-- used in Parsec TotalIndexState implementation
data Tok
= TokRepo RepoName RepoIndexState
| TokTimestamp Timestamp
| TokHead
-- | Remove non-default values from 'TotalIndexState'.
normalise :: TotalIndexState -> TotalIndexState
normalise (TIS def m) = TIS def (Map.filter (/= def) m)
-- | 'TotalIndexState' where all repositories are at @HEAD@ index state.
headTotalIndexState :: TotalIndexState
headTotalIndexState = TIS IndexStateHead Map.empty
-- | Create 'TotalIndexState'.
makeTotalIndexState :: RepoIndexState -> Map RepoName RepoIndexState -> TotalIndexState
makeTotalIndexState def m = normalise (TIS def m)
-- | Lookup a 'RepoIndexState' for an individual repository from 'TotalIndexState'.
lookupIndexState :: RepoName -> TotalIndexState -> RepoIndexState
lookupIndexState rn (TIS def m) = Map.findWithDefault def rn m
-- | Insert a 'RepoIndexState' to 'TotalIndexState'.
insertIndexState :: RepoName -> RepoIndexState -> TotalIndexState -> TotalIndexState
insertIndexState rn idx (TIS def m)
| idx == def = TIS def (Map.delete rn m)
| otherwise = TIS def (Map.insert rn idx m)
-------------------------------------------------------------------------------
-- Repository index state
-------------------------------------------------------------------------------
-- | Specification of the state of a specific repo package index
data IndexState = IndexStateHead -- ^ Use all available entries
| IndexStateTime !Timestamp -- ^ Use all entries that existed at
-- the specified time
deriving (Eq,Generic,Show)
data RepoIndexState
= IndexStateHead -- ^ Use all available entries
| IndexStateTime !Timestamp -- ^ Use all entries that existed at the specified time
deriving (Eq,Generic,Show)
instance Binary IndexState
instance Structured IndexState
instance NFData IndexState
instance Binary RepoIndexState
instance Structured RepoIndexState
instance NFData RepoIndexState
instance Pretty IndexState where
instance Pretty RepoIndexState where
pretty IndexStateHead = Disp.text "HEAD"
pretty (IndexStateTime ts) = pretty ts
instance Parsec IndexState where
instance Parsec RepoIndexState where
parsec = parseHead <|> parseTime where
parseHead = IndexStateHead <$ P.string "HEAD"
parseTime = IndexStateTime <$> parsec
instance Described IndexState where
instance Described RepoIndexState where
describe _ = REUnion
[ "HEAD"
, RENamed "timestamp" (describe (Proxy :: Proxy Timestamp))
......
......@@ -289,7 +289,7 @@ makeInstallContext verbosity
let idxState = flagToMaybe (installIndexState installFlags)
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
sourcePkgDb <- getSourcePackagesAtIndexState verbosity repoCtxt idxState
(sourcePkgDb, _) <- getSourcePackagesAtIndexState verbosity repoCtxt idxState
pkgConfigDb <- readPkgConfigDb verbosity progdb
checkConfigExFlags verbosity installedPkgIndex
......
......@@ -35,7 +35,7 @@ import Distribution.Client.BuildReports.Types
import Distribution.Client.SourceRepo (SourceRepoList)
import Distribution.Client.IndexUtils.IndexState
( IndexState )
( TotalIndexState )
import Distribution.Client.CmdInstall.ClientInstallFlags
( ClientInstallFlags(..) )
......@@ -180,7 +180,7 @@ data ProjectConfigShared
projectConfigRemoteRepos :: NubList RemoteRepo, -- ^ Available Hackage servers.
projectConfigLocalRepos :: NubList FilePath,
projectConfigLocalNoIndexRepos :: NubList LocalRepo,
projectConfigIndexState :: Flag IndexState,
projectConfigIndexState :: Flag TotalIndexState,
projectConfigStoreDir :: Flag FilePath,
-- solver configuration
......@@ -406,7 +406,7 @@ data SolverSettings
solverSettingStrongFlags :: StrongFlags,
solverSettingAllowBootLibInstalls :: AllowBootLibInstalls,
solverSettingOnlyConstrained :: OnlyConstrained,
solverSettingIndexState :: Maybe IndexState,
solverSettingIndexState :: Maybe TotalIndexState,
solverSettingIndependentGoals :: IndependentGoals
-- Things that only make sense for manual mode, not --local mode
-- too much control!
......
......@@ -292,7 +292,7 @@ withInstallPlan
-- everything in the project. This is independent of any specific targets
-- the user has asked for.
--
(elaboratedPlan, _, elaboratedShared) <-
(elaboratedPlan, _, elaboratedShared, _) <-
rebuildInstallPlan verbosity
distDirLayout cabalDirLayout
projectConfig
......@@ -317,7 +317,7 @@ runProjectPreBuildPhase
-- everything in the project. This is independent of any specific targets
-- the user has asked for.
--
(elaboratedPlan, _, elaboratedShared) <-
(elaboratedPlan, _, elaboratedShared, _) <-
rebuildInstallPlan verbosity
distDirLayout cabalDirLayout
projectConfig
......
......@@ -396,7 +396,8 @@ rebuildInstallPlan :: Verbosity
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO ( ElaboratedInstallPlan -- with store packages
, ElaboratedInstallPlan -- with source packages
, ElaboratedSharedConfig )
, ElaboratedSharedConfig
, IndexUtils.TotalIndexState )
-- ^ @(improvedPlan, elaboratedPlan, _, _)@
rebuildInstallPlan verbosity
distDirLayout@DistDirLayout {
......@@ -417,14 +418,14 @@ rebuildInstallPlan verbosity
(projectConfigMonitored, localPackages, progsearchpath) $ do
-- And so is the elaborated plan that the improved plan based on
(elaboratedPlan, elaboratedShared) <-
(elaboratedPlan, elaboratedShared, totalIndexState) <-
rerunIfChanged verbosity fileMonitorElaboratedPlan
(projectConfigMonitored, localPackages,
progsearchpath) $ do
compilerEtc <- phaseConfigureCompiler projectConfig
_ <- phaseConfigurePrograms projectConfig compilerEtc
(solverPlan, pkgConfigDB)
(solverPlan, pkgConfigDB, totalIndexState)
<- phaseRunSolver projectConfig
compilerEtc
localPackages
......@@ -435,14 +436,14 @@ rebuildInstallPlan verbosity
localPackages
phaseMaintainPlanOutputs elaboratedPlan elaboratedShared
return (elaboratedPlan, elaboratedShared)
return (elaboratedPlan, elaboratedShared, totalIndexState)
-- The improved plan changes each time we install something, whereas
-- the underlying elaborated plan only changes when input config
-- changes, so it's worth caching them separately.
improvedPlan <- phaseImprovePlan elaboratedPlan elaboratedShared
return (improvedPlan, elaboratedPlan, elaboratedShared)
return (improvedPlan, elaboratedPlan, elaboratedShared, totalIndexState)
where
fileMonitorCompiler = newFileMonitorInCacheDir "compiler"
......@@ -543,10 +544,11 @@ rebuildInstallPlan verbosity
-- Run the solver to get the initial install plan.
-- This is expensive so we cache it independently.
--
phaseRunSolver :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> Rebuild (SolverInstallPlan, PkgConfigDb)
phaseRunSolver
:: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [PackageSpecifier UnresolvedSourcePackage]
-> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState)
phaseRunSolver projectConfig@ProjectConfig {
projectConfigShared,
projectConfigBuildOnly
......@@ -561,7 +563,7 @@ rebuildInstallPlan verbosity
installedPkgIndex <- getInstalledPackages verbosity
compiler progdb platform
corePackageDbs
sourcePkgDb <- getSourcePackages verbosity withRepoCtx
(sourcePkgDb, tis)<- getSourcePackages verbosity withRepoCtx
(solverSettingIndexState solverSettings)
pkgConfigDB <- getPkgConfigDb verbosity progdb
......@@ -580,7 +582,7 @@ rebuildInstallPlan verbosity
planPackages verbosity compiler platform solver solverSettings
installedPkgIndex sourcePkgDb pkgConfigDB
localPackages localPackagesEnabledStanzas
return (plan, pkgConfigDB)
return (plan, pkgConfigDB, tis)
where
corePackageDbs = [GlobalPackageDB]
withRepoCtx = projectConfigWithSolverRepoContext verbosity
......@@ -757,20 +759,23 @@ getPackageDBContents verbosity compiler progdb platform packagedb = do
packagedb progdb
-}
getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a)
-> Maybe IndexUtils.IndexState -> Rebuild SourcePackageDb
getSourcePackages
:: Verbosity
-> (forall a. (RepoContext -> IO a) -> IO a)
-> Maybe IndexUtils.TotalIndexState
-> Rebuild (SourcePackageDb, IndexUtils.TotalIndexState)