summary refs log tree commit diff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-13 15:36:49 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-15 20:24:09 +0100
commit0ea939fb796fdd4f0d46d3534b2ec6135e0f3dc7 (patch)
tree4e2117fbad1e173ba079800d3fb00d8d64702184 /gnu
parentee8099f5b688ce5f57790db4122f0b5b91a26216 (diff)
downloadguix-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.scm45
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)