Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
896d0f1a
Commit
896d0f1a
authored
May 30, 2013
by
ian@well-typed.com
Browse files
When verbose, give more information about cache status
parent
bc5bf1b3
Changes
1
Hide whitespace changes
Inline
Side-by-side
utils/ghc-pkg/Main.hs
View file @
896d0f1a
...
...
@@ -612,7 +612,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
pkgs
<-
parseMultiPackageConf
verbosity
path
mkPackageDB
pkgs
Right
fs
|
not
use_cache
->
ignore_cache
|
not
use_cache
->
ignore_cache
(
const
$
return
()
)
|
otherwise
->
do
let
cache
=
path
</>
cachefilename
tdir
<-
getModificationTime
path
...
...
@@ -621,24 +621,42 @@ readParseDatabase verbosity mb_user_conf use_cache path
Left
ex
->
do
when
(
verbosity
>
Normal
)
$
warn
(
"warning: cannot read cache file "
++
cache
++
": "
++
show
ex
)
ignore_cache
Right
tcache
|
tcache
>=
tdir
->
do
when
(
verbosity
>
Normal
)
$
infoLn
(
"using cache: "
++
cache
)
pkgs
<-
myReadBinPackageDB
cache
let
pkgs'
=
map
convertPackageInfoIn
pkgs
mkPackageDB
pkgs'
|
otherwise
->
do
when
(
verbosity
>=
Normal
)
$
do
warn
(
"WARNING: cache is out of date: "
++
cache
)
warn
" use 'ghc-pkg recache' to fix."
ignore_cache
ignore_cache
(
const
$
return
()
)
Right
tcache
->
do
let
compareTimestampToCache
file
=
when
(
verbosity
>=
Verbose
)
$
do
tFile
<-
getModificationTime
file
compareTimestampToCache'
file
tFile
compareTimestampToCache'
file
tFile
=
do
let
rel
=
case
tcache
`
compare
`
tFile
of
LT
->
" (NEWER than cache)"
GT
->
" (older than cache)"
EQ
->
" (same as cache)"
warn
(
"Timestamp "
++
show
tFile
++
" for "
++
file
++
rel
)
when
(
verbosity
>=
Verbose
)
$
do
warn
(
"Timestamp "
++
show
tcache
++
" for "
++
cache
)
compareTimestampToCache'
path
tdir
if
tcache
>=
tdir
then
do
when
(
verbosity
>
Normal
)
$
infoLn
(
"using cache: "
++
cache
)
pkgs
<-
myReadBinPackageDB
cache
let
pkgs'
=
map
convertPackageInfoIn
pkgs
mkPackageDB
pkgs'
else
do
when
(
verbosity
>=
Normal
)
$
do
warn
(
"WARNING: cache is out of date: "
++
cache
)
warn
"Use 'ghc-pkg recache' to fix."
ignore_cache
compareTimestampToCache
where
ignore_cache
=
do
ignore_cache
::
(
FilePath
->
IO
()
)
->
IO
PackageDB
ignore_cache
checkTime
=
do
let
confs
=
filter
(
".conf"
`
isSuffixOf
`)
fs
pkgs
<-
mapM
(
parseSingletonPackageConf
verbosity
)
$
map
(
path
</>
)
confs
doFile
f
=
do
checkTime
f
parseSingletonPackageConf
verbosity
f
pkgs
<-
mapM
doFile
$
map
(
path
</>
)
confs
mkPackageDB
pkgs
where
mkPackageDB
pkgs
=
do
...
...
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