1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-23 01:25:57 +02:00

guix package: '--list-available' can use data from the cache.

* gnu/packages.scm (fold-available-packages): New procedure.
* guix/scripts/package.scm (process-query): Use it instead of
'fold-packages'.
* tests/packages.scm ("fold-available-packages with/without cache"):
New test.
This commit is contained in:
Ludovic Courtès
2019-01-13 15:36:49 +01:00
parent ee8099f5b6
commit 0ea939fb79
3 changed files with 92 additions and 20 deletions
+45
View File
@@ -53,6 +53,7 @@
%default-package-module-path
fold-packages
fold-available-packages
find-packages-by-name
find-package-locations
@@ -182,6 +183,50 @@ flags."
directory))
%load-path)))
(define (fold-available-packages proc init)
"Fold PROC over the list of available packages. For each available package,
PROC is called along these lines:
(PROC NAME VERSION RESULT
#:outputs OUTPUTS
#:location LOCATION
…)
PROC can use #:allow-other-keys to ignore the bits it's not interested in.
When a package cache is available, this procedure does not actually load any
package module."
(define cache
(load-package-cache (current-profile)))
(if (and cache (cache-is-authoritative?))
(vhash-fold (lambda (name vector result)
(match vector
(#(name version module symbol outputs
supported? deprecated?
file line column)
(proc name version result
#:outputs outputs
#:location (and file
(location file line column))
#:supported? supported?
#:deprecated? deprecated?))))
init
cache)
(fold-packages (lambda (package result)
(proc (package-name package)
(package-version package)
result
#:outputs (package-outputs package)
#:location (package-location package)
#:supported?
(->bool
(member (%current-system)
(package-supported-systems package)))
#:deprecated?
(->bool
(package-superseded package))))
init)))
(define* (fold-packages proc init
#:optional
(modules (all-modules (%package-module-path)