diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index b205dfda348..693ae3cba9c 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -13,6 +14,7 @@ module Distribution.Client.CmdUpdate ( ) where import Prelude () +import Control.Exception import Distribution.Client.Compat.Prelude import Distribution.Client.NixStyleOptions @@ -42,7 +44,7 @@ import Distribution.Client.Setup import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Utils - ( die', notice, wrapText, writeFileAtomic, noticeNoWrap ) + ( die', notice, wrapText, writeFileAtomic, noticeNoWrap, warn ) import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Client.IndexUtils.Timestamp @@ -209,7 +211,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do case updated of Sec.NoUpdates -> do now <- getCurrentTime - setModificationTime (indexBaseName repo <.> "tar") now + setModificationTime (indexBaseName repo <.> "tar") now `catchIO` + (\e -> warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e) noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date at index-state " ++ prettyShow (IndexStateTime current_ts) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 02bcd081f6c..48277395870 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -247,7 +247,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do " as explicitly requested (via command line / project configuration)" return idxState Nothing -> do - mb_idxState' <- readIndexTimestamp (RepoIndex repoCtxt r) + mb_idxState' <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) case mb_idxState' of Nothing -> do info verbosity "Using most recent state (could not read timestamp file)" @@ -365,7 +365,9 @@ readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo - updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) + -- note that if this step fails due to a bad repocache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. + updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) `catchIO` + (\e -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) readPackageIndexCacheFile verbosity mkAvailablePackage (RepoIndex repoCtxt repo) idxState @@ -1054,7 +1056,7 @@ writeIndexTimestamp index st -- timestamp you would use to revert to this version currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp currentIndexTimestamp verbosity repoCtxt r = do - mb_is <- readIndexTimestamp (RepoIndex repoCtxt r) + mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) case mb_is of Just (IndexStateTime ts) -> return ts _ -> do @@ -1062,13 +1064,15 @@ currentIndexTimestamp verbosity repoCtxt r = do return (isiHeadTime isi) -- | Read the 'IndexState' from the filesystem -readIndexTimestamp :: Index -> IO (Maybe RepoIndexState) -readIndexTimestamp index +readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState) +readIndexTimestamp verbosity index = fmap simpleParsec (readFile (timestampFile index)) `catchIO` \e -> if isDoesNotExistError e then return Nothing - else ioError e + else do + warn verbosity $ "Warning: could not read current index timestamp: " ++ displayException e + return Nothing -- | Optimise sharing of equal values inside 'Cache' --