nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 92 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
gnu/packages.scm
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)

41
guix/scripts/package.scm
View File

@ -736,29 +736,34 @@ processed, #f otherwise."
(('list-available regexp)
(let* ((regexp (and regexp (make-regexp* regexp)))
(available (fold-packages
(lambda (p r)
(let ((n (package-name p)))
(if (and (supported-package? p)
(not (package-superseded p)))
(available (fold-available-packages
(lambda* (name version result
#:key outputs location
supported? superseded?
#:allow-other-keys)
(if (and supported? (not superseded?))
(if regexp
(if (regexp-exec regexp n)
(cons p r)
r)
(cons p r))
r)))
(if (regexp-exec regexp name)
(cons `(,name ,version
,outputs ,location)
result)
result)
(cons `(,name ,version
,outputs ,location)
result))
result))
'())))
(leave-on-EPIPE
(for-each (lambda (p)
(for-each (match-lambda
((name version outputs location)
(format #t "~a\t~a\t~a\t~a~%"
(package-name p)
(package-version p)
(string-join (package-outputs p) ",")
(location->string (package-location p))))
name version
(string-join outputs ",")
(location->string location))))
(sort available
(lambda (p1 p2)
(string<? (package-name p1)
(package-name p2))))))
(match-lambda*
(((name1 . _) (name2 . _))
(string<? name1 name2))))))
#t))
(('search _)

22
tests/packages.scm
View File

@ -995,6 +995,28 @@
((one)
(eq? one guile-2.0))))
(test-assert "fold-available-packages with/without cache"
(let ()
(define no-cache
(fold-available-packages (lambda* (name version result #:rest rest)
(cons (cons* name version rest)
result))
'()))
(define from-cache
(call-with-temporary-directory
(lambda (cache)
(generate-package-cache cache)
(mock ((guix describe) current-profile (const cache))
(mock ((gnu packages) cache-is-authoritative? (const #t))
(fold-available-packages (lambda* (name version result
#:rest rest)
(cons (cons* name version rest)
result))
'()))))))
(lset= equal? no-cache from-cache)))
(test-assert "find-packages-by-name"
(match (find-packages-by-name "hello")
(((? (cut eq? hello <>))) #t)