2 files changed, 32 insertions(+), 11 deletions(-)

M distro.scm
M tests/packages.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))
+                 '()))

@@ 120,6 120,13 @@
            (and (build-derivations %store (list drv))
                 (file-exists? (string-append out "/bin/make")))))))
 
+(test-eq "fold-packages" hello
+  (fold-packages (lambda (p r)
+                   (if (string=? (package-name p) "hello")
+                       p
+                       r))
+                 #f))
+
 (test-assert "find-packages-by-name"
   (match (find-packages-by-name "hello")
     (((? (cut eq? hello <>))) #t)


@@ 136,6 143,7 @@
 (exit (= (test-runner-fail-count (test-runner-current)) 0))
 
 ;;; Local Variables:
+;;; eval: (put 'test-equal 'scheme-indent-function 2)
 ;;; eval: (put 'test-assert 'scheme-indent-function 1)
 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)
 ;;; End: