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.
This commit is contained in:
parent
733b4130d7
commit
ba326ce41b
33
distro.scm
33
distro.scm
|
@ -26,6 +26,7 @@
|
||||||
#:export (search-patch
|
#:export (search-patch
|
||||||
search-bootstrap-binary
|
search-bootstrap-binary
|
||||||
%patch-directory
|
%patch-directory
|
||||||
|
fold-packages
|
||||||
find-packages-by-name))
|
find-packages-by-name))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -105,22 +106,34 @@
|
||||||
(false-if-exception (resolve-interface name))))
|
(false-if-exception (resolve-interface name))))
|
||||||
(package-files)))
|
(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)
|
(define* (find-packages-by-name name #:optional version)
|
||||||
"Return the list of packages with the given NAME. If VERSION is not #f,
|
"Return the list of packages with the given NAME. If VERSION is not #f,
|
||||||
then only return packages whose version is equal to VERSION."
|
then only return packages whose version is equal to VERSION."
|
||||||
(define right-package?
|
(define right-package?
|
||||||
(if version
|
(if version
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(and (package? p)
|
(and (string=? (package-name p) name)
|
||||||
(string=? (package-name p) name)
|
|
||||||
(string=? (package-version p) version)))
|
(string=? (package-version p) version)))
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(and (package? p)
|
(string=? (package-name p) name))))
|
||||||
(string=? (package-name p) name)))))
|
|
||||||
|
|
||||||
(append-map (lambda (module)
|
(fold-packages (lambda (package result)
|
||||||
(filter right-package?
|
(if (right-package? package)
|
||||||
(module-map (lambda (sym var)
|
(cons package result)
|
||||||
(variable-ref var))
|
result))
|
||||||
module)))
|
'()))
|
||||||
(package-modules)))
|
|
||||||
|
|
|
@ -120,6 +120,13 @@
|
||||||
(and (build-derivations %store (list drv))
|
(and (build-derivations %store (list drv))
|
||||||
(file-exists? (string-append out "/bin/make")))))))
|
(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"
|
(test-assert "find-packages-by-name"
|
||||||
(match (find-packages-by-name "hello")
|
(match (find-packages-by-name "hello")
|
||||||
(((? (cut eq? hello <>))) #t)
|
(((? (cut eq? hello <>))) #t)
|
||||||
|
@ -136,6 +143,7 @@
|
||||||
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
;;; eval: (put 'test-equal 'scheme-indent-function 2)
|
||||||
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
||||||
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
|
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Reference in New Issue