summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-19 22:37:50 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-19 23:04:38 +0100
commitba326ce41b5784f3acb99d4beae5ffc455d6a27e (patch)
treeafaf50cb0b948f6a49cc0e2c7430fdab915a2f2c
parent733b4130d75281a0bd634bc84600bcc2ea44a317 (diff)
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.
-rw-r--r--distro.scm35
-rw-r--r--tests/packages.scm8
2 files changed, 32 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))
+ '()))
diff --git a/tests/packages.scm b/tests/packages.scm
index 29ea691e9f..cb69e4be4e 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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: