02/09: inferior: Add 'inferior-available-packages'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 739380542da7e434c581ec620edeb4348d6ece89
Author: Ludovic Courtès <address@hidden>
Date:   Tue Feb 12 22:17:11 2019 +0100

    inferior: Add 'inferior-available-packages'.
    
    * guix/inferior.scm (inferior-available-packages): New procedure.
    * tests/inferior.scm ("inferior-available-packages"): New test.
---
 guix/inferior.scm  | 26 ++++++++++++++++++++++++++
 tests/inferior.scm | 22 +++++++++++++++++++++-
 2 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 6cfa146..027418a 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -61,6 +61,7 @@
             inferior-object?
 
             inferior-packages
+            inferior-available-packages
             lookup-inferior-packages
 
             inferior-package?
@@ -256,6 +257,31 @@ equivalent.  Return #f if the inferior could not be 
launched."
         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
diff --git a/tests/inferior.scm b/tests/inferior.scm
index d5a894c..71ebf8f 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018, 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -89,6 +89,26 @@
            (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)