Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8f5bc37d0c33ec794a62de4e95b9fb99aeca6afb >--------------------------------------------------------------- commit 8f5bc37d0c33ec794a62de4e95b9fb99aeca6afb Author: Duncan Coutts <[email protected]> Date: Wed Jan 14 12:48:27 2009 +0000 Warn if a package index from a remote repo is 15 days or older For example it will print: Warning: The package list for 'hackage.haskell.org' is 16 days old. Run 'cabal update' to get the latest list of available packages. >--------------------------------------------------------------- cabal-install/Distribution/Client/IndexUtils.hs | 19 ++++++++++++++++++- 1 files changed, 18 insertions(+), 1 deletions(-) diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index ce75820..9ec714f 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -48,7 +48,7 @@ import Data.Maybe (catMaybes, fromMaybe) import Data.List (isPrefixOf) import Data.Monoid (Monoid(..)) import qualified Data.Map as Map -import Control.Monad (MonadPlus(mplus)) +import Control.Monad (MonadPlus(mplus), when) import Control.Exception (evaluate) import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -58,6 +58,10 @@ import System.FilePath ((</>), takeExtension, splitDirectories, normalise) import System.FilePath.Posix as FilePath.Posix ( takeFileName ) import System.IO.Error (isDoesNotExistError) +import System.Directory + ( getModificationTime ) +import System.Time + ( getClockTime, diffClockTimes, normalizeTimeDiff, TimeDiff(tdDay) ) -- | Read a repository index from disk, from the local files specified by -- a list of 'Repo's. @@ -104,6 +108,7 @@ readRepoIndex verbosity repo = handleNotFound $ do } | (pkgid, pkg) <- pkgs] + warnIfIndexIsOld indexFile return (pkgIndex, prefs) where @@ -130,6 +135,18 @@ readRepoIndex verbosity repo = handleNotFound $ do return mempty else ioError e + isOldThreshold = 15 --days + warnIfIndexIsOld indexFile = do + indexTime <- getModificationTime indexFile + currentTime <- getClockTime + let diff = normalizeTimeDiff (diffClockTimes currentTime indexTime) + when (tdDay diff >= isOldThreshold) $ case repoKind repo of + Left remoteRepo -> warn verbosity $ + "The package list for '" ++ remoteRepoName remoteRepo + ++ "' is " ++ show (tdDay diff) ++ " days old.\nRun " + ++ "'cabal update' to get the latest list of available packages." + Right _localRepo -> return () + parsePreferredVersions :: String -> [Dependency] parsePreferredVersions = catMaybes . map simpleParse _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
