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

Merge pull request #7062 from phadej/issue-7061-v2-update-file-noindex

Resolve #7061: v2-update updates file+noindex repository cache
parents 6fb9ad62 66a1dd40
{-# OPTIONS -Wno-deprecations #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Main where
import Criterion.Main (bench, bgroup, defaultMain, env, nf, whnf)
......
......@@ -74,11 +74,12 @@ storeAnonymous reports = sequence_
-> [(Repo, [BuildReport])]
separate = map (\rs@((_,repo,_):_) -> (repo, [ r | (r,_,_) <- rs ]))
. map (concatMap toList)
. L.groupBy (equating (repoName . head))
. sortBy (comparing (repoName . head))
. groupBy (equating repoName)
. L.groupBy (equating (repoName' . head))
. sortBy (comparing (repoName' . head))
. groupBy (equating repoName')
. onlyRemote
repoName (_,_,rrepo) = remoteRepoName rrepo
repoName' (_,_,rrepo) = remoteRepoName rrepo
onlyRemote :: [(BuildReport, Maybe Repo)]
-> [(BuildReport, Repo, RemoteRepo)]
......
......@@ -28,7 +28,7 @@ import Distribution.Client.ProjectConfig
import Distribution.Client.ProjectFlags
( ProjectFlags (..) )
import Distribution.Client.Types
( Repo(..), RepoName (..), unRepoName, RemoteRepo(..), isRepoRemote )
( Repo(..), RepoName (..), unRepoName, RemoteRepo(..), repoName )
import Distribution.Client.HttpUtils
( DownloadResult(..) )
import Distribution.Client.FetchUtils
......@@ -49,7 +49,7 @@ import Distribution.Client.IndexUtils.Timestamp
import Distribution.Client.IndexUtils.IndexState
import Distribution.Client.IndexUtils
( updateRepoIndexCache, Index(..), writeIndexTimestamp
, currentIndexTimestamp, indexBaseName )
, currentIndexTimestamp, indexBaseName, updatePackageIndexCacheFile )
import qualified Data.Maybe as Unsafe (fromJust)
import qualified Distribution.Compat.CharParsing as P
......@@ -126,13 +126,16 @@ updateAction flags@NixStyleFlags {..} extraArgs globalFlags = do
projectConfigWithSolverRepoContext verbosity
(projectConfigShared projectConfig) (projectConfigBuildOnly projectConfig)
$ \repoCtxt -> do
let repos = filter isRepoRemote $ repoContextRepos repoCtxt
repoName = remoteRepoName . repoRemote
let repos :: [Repo]
repos = repoContextRepos repoCtxt
parseArg :: String -> IO UpdateRequest
parseArg s = case simpleParsec s of
Just r -> return r
Nothing -> die' verbosity $
"'v2-update' unable to parse repo: \"" ++ s ++ "\""
updateRepoRequests <- traverse parseArg extraArgs
unless (null updateRepoRequests) $ do
......@@ -156,7 +159,8 @@ updateAction flags@NixStyleFlags {..} extraArgs globalFlags = do
| (UpdateRequest name state) <- updateRequests ]
case reposToUpdate of
[] -> return ()
[] ->
notice verbosity "No remote repositories configured"
[(remoteRepo, _)] ->
notice verbosity $ "Downloading the latest package list from "
++ unRepoName (repoName remoteRepo)
......@@ -164,10 +168,11 @@ updateAction flags@NixStyleFlags {..} extraArgs globalFlags = do
$ "Downloading the latest package lists from: "
: map (("- " ++) . unRepoName . repoName . fst) reposToUpdate
jobCtrl <- newParallelJobControl (length reposToUpdate)
traverse_ (spawnJob jobCtrl . updateRepo verbosity defaultUpdateFlags repoCtxt)
reposToUpdate
traverse_ (\_ -> collectJob jobCtrl) reposToUpdate
unless (null reposToUpdate) $ do
jobCtrl <- newParallelJobControl (length reposToUpdate)
traverse_ (spawnJob jobCtrl . updateRepo verbosity defaultUpdateFlags repoCtxt)
reposToUpdate
traverse_ (\_ -> collectJob jobCtrl) reposToUpdate
where
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
......@@ -179,7 +184,10 @@ updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, RepoIndexState)
updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do
transport <- repoContextGetTransport repoCtxt
case repo of
RepoLocalNoIndex{} -> return ()
RepoLocalNoIndex{} -> do
let index = RepoIndex repoCtxt repo
updatePackageIndexCacheFile verbosity index
RepoRemote{..} -> do
downloadResult <- downloadIndex transport verbosity
repoRemote repoLocalDir
......
......@@ -230,10 +230,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
pkgss <- for (repoContextRepos repoCtxt) $ \r -> do
let rname :: RepoName
rname = case r of
RepoRemote remote _ -> remoteRepoName remote
RepoSecure remote _ -> remoteRepoName remote
RepoLocalNoIndex local _ -> localRepoName local
rname = repoName r
info verbosity ("Reading available packages of " ++ unRepoName rname ++ "...")
......@@ -311,6 +308,8 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
totalIndexState = makeTotalIndexState IndexStateHead $ Map.fromList
[ (n, IndexStateTime ts)
| (RepoData n ts _idx _prefs, _strategy) <- pkgss'
-- e.g. file+noindex have nullTimestamp as their timestamp
, ts /= nullTimestamp
]
let addIndex
......
{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.JobControl
......@@ -38,6 +39,7 @@ import Control.Concurrent.STM (STM, atomically)
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TChan
import Control.Exception (bracket_, try)
import Distribution.Compat.Stack
import Distribution.Client.Compat.Semaphore
......@@ -99,7 +101,7 @@ newSerialJobControl = do
-- that have already been executed or are currently executing cannot be
-- cancelled.
--
newParallelJobControl :: Int -> IO (JobControl IO a)
newParallelJobControl :: WithCallStack (Int -> IO (JobControl IO a))
newParallelJobControl n | n < 1 || n > 1000 =
error $ "newParallelJobControl: not a sensible number of jobs: " ++ show n
newParallelJobControl maxJobLimit = do
......
......@@ -9,6 +9,7 @@ module Distribution.Client.Types.Repo (
localRepoCacheKey,
-- * Repository
Repo (..),
repoName,
isRepoRemote,
maybeRepoRemote,
) where
......@@ -182,3 +183,8 @@ maybeRepoRemote :: Repo -> Maybe RemoteRepo
maybeRepoRemote (RepoLocalNoIndex _ _localDir) = Nothing
maybeRepoRemote (RepoRemote r _localDir) = Just r
maybeRepoRemote (RepoSecure r _localDir) = Just r
repoName :: Repo -> RepoName
repoName (RepoLocalNoIndex r _) = localRepoName r
repoName (RepoRemote r _) = remoteRepoName r
repoName (RepoSecure r _) = remoteRepoName r
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment