Commit 4227f3e9 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Store HEAD timestamp in 01-index.cache

parent 060b9061
...@@ -82,6 +82,7 @@ import Data.List (isPrefixOf) ...@@ -82,6 +82,7 @@ import Data.List (isPrefixOf)
import Data.Word import Data.Word
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..)) import Data.Monoid (Monoid(..))
import Control.Applicative
#endif #endif
import qualified Data.Map as Map import qualified Data.Map as Map
import Control.DeepSeq import Control.DeepSeq
...@@ -447,8 +448,13 @@ updatePackageIndexCacheFile :: Verbosity -> Index -> IO () ...@@ -447,8 +448,13 @@ updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile verbosity index = do updatePackageIndexCacheFile verbosity index = do
info verbosity ("Updating index cache file " ++ cacheFile index) info verbosity ("Updating index cache file " ++ cacheFile index)
withIndexEntries index $ \entries -> do withIndexEntries index $ \entries -> do
let cache = Cache { cacheEntries = entries } let !maxTs = maximumTimestamp (map cacheEntryTimestamp entries)
cache = Cache { cacheHeadTs = maxTs
, cacheEntries = entries
}
writeIndexCache index cache writeIndexCache index cache
info verbosity ("Index cache updated to index-state "
++ display (cacheHeadTs cache))
-- | Read the index (for the purpose of building a cache) -- | Read the index (for the purpose of building a cache)
-- --
...@@ -642,9 +648,14 @@ writeIndexCache index cache ...@@ -642,9 +648,14 @@ writeIndexCache index cache
| otherwise = writeFile (cacheFile index) (show00IndexCache cache) | otherwise = writeFile (cacheFile index) (show00IndexCache cache)
-- | Cabal caches various information about the Hackage index -- | Cabal caches various information about the Hackage index
data Cache = Cache { data Cache = Cache
cacheEntries :: [IndexCacheEntry] { cacheHeadTs :: Timestamp
} -- ^ maximum/latest 'Timestamp' among 'cacheEntries'; unless the
-- invariant of 'cacheEntries' being in chronological order is
-- violated, this corresponds to the last (seen) 'Timestamp' in
-- 'cacheEntries'
, cacheEntries :: [IndexCacheEntry]
}
instance NFData Cache where instance NFData Cache where
rnf = rnf . cacheEntries rnf = rnf . cacheEntries
...@@ -667,24 +678,30 @@ instance NFData IndexCacheEntry where ...@@ -667,24 +678,30 @@ instance NFData IndexCacheEntry where
rnf (CachePreference dep _ _) = rnf dep rnf (CachePreference dep _ _) = rnf dep
rnf (CacheBuildTreeRef _ _) = () rnf (CacheBuildTreeRef _ _) = ()
cacheEntryTimestamp :: IndexCacheEntry -> Timestamp
cacheEntryTimestamp (CacheBuildTreeRef _ _) = nullTimestamp
cacheEntryTimestamp (CachePreference _ _ ts) = ts
cacheEntryTimestamp (CachePackageId _ _ ts) = ts
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
-- new binary 01-index.cache format -- new binary 01-index.cache format
instance Binary Cache where instance Binary Cache where
put (Cache ents) = do put (Cache headTs ents) = do
-- magic / format version -- magic / format version
-- --
-- NB: this currently encodes word-size implicitly; when we -- NB: this currently encodes word-size implicitly; when we
-- switch to CBOR encoding, we will have a platform -- switch to CBOR encoding, we will have a platform
-- independent binary encoding -- independent binary encoding
put (0xcaba1001::Word) put (0xcaba1002::Word)
put headTs
put ents put ents
get = do get = do
magic <- get magic <- get
when (magic /= (0xcaba1001::Word)) $ when (magic /= (0xcaba1002::Word)) $
fail ("01-index.cache: unexpected magic marker encountered: " ++ show magic) fail ("01-index.cache: unexpected magic marker encountered: " ++ show magic)
liftM Cache get Cache <$> get <*> get
instance Binary IndexCacheEntry instance Binary IndexCacheEntry
...@@ -699,8 +716,9 @@ preferredVersionKey = "pref-ver:" ...@@ -699,8 +716,9 @@ preferredVersionKey = "pref-ver:"
-- legacy 00-index.cache format -- legacy 00-index.cache format
read00IndexCache :: BSS.ByteString -> Cache read00IndexCache :: BSS.ByteString -> Cache
read00IndexCache bs = Cache { read00IndexCache bs = Cache
cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs { cacheHeadTs = nullTimestamp
, cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs
} }
read00IndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry read00IndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
......
...@@ -15,6 +15,7 @@ module Distribution.Client.IndexUtils.Timestamp ...@@ -15,6 +15,7 @@ module Distribution.Client.IndexUtils.Timestamp
, epochTimeToTimestamp , epochTimeToTimestamp
, timestampToUTCTime , timestampToUTCTime
, utcTimeToTimestamp , utcTimeToTimestamp
, maximumTimestamp
) where ) where
import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Archive.Tar.Entry as Tar
...@@ -58,7 +59,16 @@ utcTimeToTimestamp utct ...@@ -58,7 +59,16 @@ utcTimeToTimestamp utct
t :: Integer t :: Integer
t = round . utcTimeToPOSIXSeconds $ utct t = round . utcTimeToPOSIXSeconds $ utct
-- | Compute the maximum 'Timestamp' value
--
-- Returns 'nullTimestamp' for the empty list. Also note that
-- 'nullTimestamp' compares as smaller to all non-'nullTimestamp'
-- values.
maximumTimestamp :: [Timestamp] -> Timestamp
maximumTimestamp [] = nullTimestamp
maximumTimestamp xs@(_:_) = maximum xs
-- returns 'Nothing' if not representable as 'Timestamp'
posixSecondsToTimestamp :: Integer -> Maybe Timestamp posixSecondsToTimestamp :: Integer -> Maybe Timestamp
posixSecondsToTimestamp pt posixSecondsToTimestamp pt
| minTs <= pt, pt <= maxTs = Just (TS (fromInteger pt)) | minTs <= pt, pt <= maxTs = Just (TS (fromInteger pt))
......
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