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:
parent
46765f82db
commit
739380542d
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue