mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* gnu/packages.scm (%package-module-path): New variable.
  (all-package-modules): New procedure.
  (fold-packages): Use it instead of 'package-modules'.
This commit is contained in:
Ludovic Courtès 2014-09-24 13:53:02 +02:00
parent 84836a5733
commit c107b54108
1 changed files with 27 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
gnu/packages.scm
View file

@ -35,6 +35,7 @@ (define-module (gnu packages)
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 @@ (define %distro-root-directory
;; 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 @@ (define* (scheme-files directory)
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 @@ (define prefix-len
(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 @@ (define (fold-packages proc init)
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,