diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs index 61a882cf3b199afd097cbde06593f65b0cd507a7..a20f8697259b0a9607af58466b2c930362ce7c7b 100644 --- a/cabal-install/Distribution/Client/BuildReports/Storage.hs +++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs @@ -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)] diff --git a/cabal-install/Distribution/Client/CmdUpdate.hs b/cabal-install/Distribution/Client/CmdUpdate.hs index b66468745327bc240278a405601fb503df0706ca..9c3d27389e2f4ad7f3ee95d13393a9ce328f1811 100644 --- a/cabal-install/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/Distribution/Client/CmdUpdate.hs @@ -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 diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index 8b76681f428c221fbc41a576576284acd8175b88..16dce8ffb743f41733d7138369e2eabd4b1271d2 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -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 diff --git a/cabal-install/Distribution/Client/JobControl.hs b/cabal-install/Distribution/Client/JobControl.hs index 2848051220909f2a71bcbed17246cbb1b49a6e15..c9c16647ac1af65d223aa741d78fb6bd8e20774a 100644 --- a/cabal-install/Distribution/Client/JobControl.hs +++ b/cabal-install/Distribution/Client/JobControl.hs @@ -1,3 +1,4 @@ +{-# 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 diff --git a/cabal-install/Distribution/Client/Types/Repo.hs b/cabal-install/Distribution/Client/Types/Repo.hs index 804a78e430e463f03e8520f8f4a89d994c208a06..2a03440e23e11a9076166cea05c41bee23371c23 100644 --- a/cabal-install/Distribution/Client/Types/Repo.hs +++ b/cabal-install/Distribution/Client/Types/Repo.hs @@ -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