diff options
| -rw-r--r-- | distro.scm | 35 | ||||
| -rw-r--r-- | tests/packages.scm | 8 |
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: |