packages: Add '%package-module-search-path'.

* gnu/packages.scm (%package-module-path): New variable.
  (all-package-modules): New procedure.
  (fold-packages): Use it instead of 'package-modules'.
master
Ludovic Courtès 2014-09-24 13:53:02 +02:00
parent 84836a5733
commit c107b54108
1 changed files with 27 additions and 8 deletions

View File

@ -35,6 +35,7 @@
search-bootstrap-binary search-bootstrap-binary
%patch-directory %patch-directory
%bootstrap-binaries-path %bootstrap-binaries-path
%package-module-path
fold-packages fold-packages
@ -86,6 +87,12 @@
;; Absolute file name of the module hierarchy. ;; Absolute file name of the module hierarchy.
(dirname (search-path %load-path "guix.scm"))) (dirname (search-path %load-path "guix.scm")))
(define %package-module-path
;; Search path for package modules. Each item must be either a directory
;; name or a pair whose car is a directory and whose cdr is a sub-directory
;; to narrow the search.
(list (cons %distro-root-directory "gnu/packages")))
(define* (scheme-files directory) (define* (scheme-files directory)
"Return the list of Scheme files found under DIRECTORY." "Return the list of Scheme files found under DIRECTORY."
(file-system-fold (const #t) ; enter? (file-system-fold (const #t) ; enter?
@ -106,13 +113,12 @@
directory directory
stat)) stat))
(define (file-name->module-name file) (define file-name->module-name
"Return the module name (a list of symbols) corresponding to FILE." (let ((not-slash (char-set-complement (char-set #\/))))
(define not-slash (lambda (file)
(char-set-complement (char-set #\/))) "Return the module name (a list of symbols) corresponding to FILE."
(map string->symbol
(map string->symbol (string-tokenize (string-drop-right file 4) not-slash)))))
(string-tokenize (string-drop-right file 4) not-slash)))
(define* (package-modules directory #:optional sub-directory) (define* (package-modules directory #:optional sub-directory)
"Return the list of modules that provide packages for the distribution. "Return the list of modules that provide packages for the distribution.
@ -128,6 +134,19 @@ Optionally, narrow the search to SUB-DIRECTORY."
(string-append directory "/" sub-directory) (string-append directory "/" sub-directory)
directory)))) directory))))
(define* (all-package-modules #:optional (path (%package-module-path)))
"Return the list of package modules found in PATH, a list of directories to
search."
(fold-right (lambda (spec result)
(match spec
((? string? directory)
(append (package-modules directory) result))
((directory . sub-directory)
(append (package-modules directory sub-directory)
result))))
'()
path))
(define (fold-packages proc init) (define (fold-packages proc init)
"Call (PROC PACKAGE RESULT) for each available package, using INIT as "Call (PROC PACKAGE RESULT) for each available package, using INIT as
the initial value of RESULT. It is guaranteed to never traverse the the initial value of RESULT. It is guaranteed to never traverse the
@ -147,7 +166,7 @@ same package twice."
module))) module)))
init init
vlist-null vlist-null
(package-modules %distro-root-directory "gnu/packages")))) (all-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,