Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
4227f3e9
Commit
4227f3e9
authored
Sep 24, 2016
by
Herbert Valerio Riedel
🕺
Browse files
Store HEAD timestamp in 01-index.cache
parent
060b9061
Changes
2
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/IndexUtils.hs
View file @
4227f3e9
...
...
@@ -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
/=
(
0xcaba100
1
::
Word
))
$
when
(
magic
/=
(
0xcaba100
2
::
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
...
...
cabal-install/Distribution/Client/IndexUtils/Timestamp.hs
View file @
4227f3e9
...
...
@@ -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
))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment