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)
import Data.Word
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
import Control.Applicative
#endif
import qualified Data.Map as Map
import Control.DeepSeq
......@@ -447,8 +448,13 @@ updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
updatePackageIndexCacheFile verbosity index = do
info verbosity ("Updating index cache file " ++ cacheFile index)
withIndexEntries index $ \entries -> do
let cache = Cache { cacheEntries = entries }
let !maxTs = maximumTimestamp (map cacheEntryTimestamp entries)
cache = Cache { cacheHeadTs = maxTs
, cacheEntries = entries
}
writeIndexCache index cache
info verbosity ("Index cache updated to index-state "
++ display (cacheHeadTs cache))
-- | Read the index (for the purpose of building a cache)
--
......@@ -642,9 +648,14 @@ writeIndexCache index cache
| otherwise = writeFile (cacheFile index) (show00IndexCache cache)
-- | Cabal caches various information about the Hackage index
data Cache = Cache {
cacheEntries :: [IndexCacheEntry]
}
data Cache = Cache
{ 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
rnf = rnf . cacheEntries
......@@ -667,24 +678,30 @@ instance NFData IndexCacheEntry where
rnf (CachePreference dep _ _) = rnf dep
rnf (CacheBuildTreeRef _ _) = ()
cacheEntryTimestamp :: IndexCacheEntry -> Timestamp
cacheEntryTimestamp (CacheBuildTreeRef _ _) = nullTimestamp
cacheEntryTimestamp (CachePreference _ _ ts) = ts
cacheEntryTimestamp (CachePackageId _ _ ts) = ts
----------------------------------------------------------------------------
-- new binary 01-index.cache format
instance Binary Cache where
put (Cache ents) = do
put (Cache headTs ents) = do
-- magic / format version
--
-- NB: this currently encodes word-size implicitly; when we
-- switch to CBOR encoding, we will have a platform
-- independent binary encoding
put (0xcaba1001::Word)
put (0xcaba1002::Word)
put headTs
put ents
get = do
magic <- get
when (magic /= (0xcaba1001::Word)) $
when (magic /= (0xcaba1002::Word)) $
fail ("01-index.cache: unexpected magic marker encountered: " ++ show magic)
liftM Cache get
Cache <$> get <*> get
instance Binary IndexCacheEntry
......@@ -699,8 +716,9 @@ preferredVersionKey = "pref-ver:"
-- legacy 00-index.cache format
read00IndexCache :: BSS.ByteString -> Cache
read00IndexCache bs = Cache {
cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs
read00IndexCache bs = Cache
{ cacheHeadTs = nullTimestamp
, cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs
}
read00IndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
......
......@@ -15,6 +15,7 @@ module Distribution.Client.IndexUtils.Timestamp
, epochTimeToTimestamp
, timestampToUTCTime
, utcTimeToTimestamp
, maximumTimestamp
) where
import qualified Codec.Archive.Tar.Entry as Tar
......@@ -58,7 +59,16 @@ utcTimeToTimestamp utct
t :: Integer
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 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