inferior: Add 'inferior-available-packages'.

* guix/inferior.scm (inferior-available-packages): New procedure.
* tests/inferior.scm ("inferior-available-packages"): New test.
This commit is contained in:
Ludovic Courtès 2019-02-12 22:17:11 +01:00
parent 46765f82db
commit 739380542d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 47 additions and 1 deletions

View File

@ -61,6 +61,7 @@
inferior-object? inferior-object?
inferior-packages inferior-packages
inferior-available-packages
lookup-inferior-packages lookup-inferior-packages
inferior-package? inferior-package?
@ -256,6 +257,31 @@ equivalent. Return #f if the inferior could not be launched."
vlist-null vlist-null
(inferior-packages inferior))) (inferior-packages inferior)))
(define (inferior-available-packages inferior)
"Return the list of name/version pairs corresponding to the set of packages
available in INFERIOR.
This is faster and requires less resource-intensive than calling
'inferior-packages'."
(if (inferior-eval '(defined? 'fold-available-packages)
inferior)
(inferior-eval '(fold-available-packages
(lambda* (name version result
#:key supported? deprecated?
#:allow-other-keys)
(if (and supported? (not deprecated?))
(acons name version result)
result))
'())
inferior)
;; As a last resort, if INFERIOR is old and lacks
;; 'fold-available-packages', fall back to 'inferior-packages'.
(map (lambda (package)
(cons (inferior-package-name package)
(inferior-package-version package)))
(inferior-packages inferior))))
(define* (lookup-inferior-packages inferior name #:optional version) (define* (lookup-inferior-packages inferior name #:optional version)
"Return the sorted list of inferior packages matching NAME in INFERIOR, with "Return the sorted list of inferior packages matching NAME in INFERIOR, with
highest version numbers first. If VERSION is true, return only packages with highest version numbers first. If VERSION is true, return only packages with

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -89,6 +89,26 @@
(close-inferior inferior) (close-inferior inferior)
result)))) result))))
(test-equal "inferior-available-packages"
(take (sort (fold-available-packages
(lambda* (name version result
#:key supported? deprecated?
#:allow-other-keys)
(if (and supported? (not deprecated?))
(alist-cons name version result)
result))
'())
(lambda (x y)
(string<? (car x) (car y))))
10)
(let* ((inferior (open-inferior %top-builddir
#:command "scripts/guix"))
(packages (inferior-available-packages inferior)))
(close-inferior inferior)
(take (sort packages (lambda (x y)
(string<? (car x) (car y))))
10)))
(test-equal "lookup-inferior-packages" (test-equal "lookup-inferior-packages"
(let ((->list (lambda (package) (let ((->list (lambda (package)
(list (package-name package) (list (package-name package)