distro: Add `fold-packages'.

* distro.scm (fold-packages): New procedure.
  (find-packages-by-name): Use it instead of hand-written traversal;
  remove `package?' checks from `right-package?'.
* tests/packages.scm ("fold-packages"): New test.

1 files changed, 24 insertions, 11 deletions

diff --git a/distro.scm b/distro.scm
index bbfe51c943..2d441f450b 100644
--- a/distro.scm
+++ b/distro.scm
@@ -26,6 +26,7 @@
   #:export (search-patch
             search-bootstrap-binary
             %patch-directory
+            fold-packages
             find-packages-by-name))
 
 ;;; Commentary:
@@ -105,22 +106,34 @@
                   (false-if-exception (resolve-interface name))))
               (package-files)))
 
+(define (fold-packages proc init)
+  "Call (PROC PACKAGE RESULT) for each available package, using INIT as
+the initial value of RESULT."
+  (fold (lambda (module result)
+          (fold (lambda (var result)
+                  (if (package? var)
+                      (proc var result)
+                      result))
+                result
+                (module-map (lambda (sym var)
+                              (false-if-exception (variable-ref var)))
+                            module)))
+        init
+        (package-modules)))
+
 (define* (find-packages-by-name name #:optional version)
   "Return the list of packages with the given NAME.  If VERSION is not #f,
 then only return packages whose version is equal to VERSION."
   (define right-package?
     (if version
         (lambda (p)
-          (and (package? p)
-               (string=? (package-name p) name)
+          (and (string=? (package-name p) name)
                (string=? (package-version p) version)))
         (lambda (p)
-          (and (package? p)
-               (string=? (package-name p) name)))))
-
-  (append-map (lambda (module)
-                (filter right-package?
-                        (module-map (lambda (sym var)
-                                      (variable-ref var))
-                                    module)))
-              (package-modules)))
+          (string=? (package-name p) name))))
+
+  (fold-packages (lambda (package result)
+                   (if (right-package? package)
+                       (cons package result)
+                       result))
+                 '()))