Skip to content
Snippets Groups Projects
Unverified Commit 73938054 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

inferior: Add 'inferior-available-packages'.

* guix/inferior.scm (inferior-available-packages): New procedure.
* tests/inferior.scm ("inferior-available-packages"): New test.
parent 46765f82
No related branches found
No related tags found
No related merge requests found
......@@ -61,6 +61,7 @@ (define-module (guix inferior)
inferior-object?
inferior-packages
inferior-available-packages
lookup-inferior-packages
inferior-package?
......@@ -256,6 +257,31 @@ (define (%inferior-package-table inferior)
vlist-null
(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)
"Return the sorted list of inferior packages matching NAME in INFERIOR, with
highest version numbers first. If VERSION is true, return only packages with
......
;;; 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.
;;;
......@@ -89,6 +89,26 @@ (define result
(close-inferior inferior)
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"
(let ((->list (lambda (package)
(list (package-name package)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment