diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-01-13 15:36:49 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-15 20:24:09 +0100 |
commit | 0ea939fb796fdd4f0d46d3534b2ec6135e0f3dc7 (patch) | |
tree | 4e2117fbad1e173ba079800d3fb00d8d64702184 /gnu | |
parent | ee8099f5b688ce5f57790db4122f0b5b91a26216 (diff) | |
download | patches-0ea939fb796fdd4f0d46d3534b2ec6135e0f3dc7.tar patches-0ea939fb796fdd4f0d46d3534b2ec6135e0f3dc7.tar.gz |
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.
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/packages.scm | 45 |
1 files changed, 45 insertions, 0 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index cf655e7448..a1814205f9 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -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) |