diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/packages.scm | 49 |
1 files changed, 27 insertions, 22 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index 26d87c6b16..9df3b975d5 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; @@ -82,21 +82,16 @@ (search-path (%bootstrap-binaries-path) (string-append system "/" file-name))) -(define %distro-module-directory - ;; Absolute path of the (gnu packages ...) module root. - (string-append (dirname (search-path %load-path "gnu/packages.scm")) - "/packages")) - -(define (package-files) - "Return the list of files that implement distro modules." - (define prefix-len - (string-length - (dirname (dirname (search-path %load-path "gnu/packages.scm"))))) +(define %distro-root-directory + ;; Absolute file name of the module hierarchy. + (dirname (search-path %load-path "guix.scm"))) +(define* (scheme-files directory) + "Return the list of Scheme files found under DIRECTORY." (file-system-fold (const #t) ; enter? (lambda (path stat result) ; leaf (if (string-suffix? ".scm" path) - (cons (substring path prefix-len) result) + (cons path result) result)) (lambda (path stat result) ; down result) @@ -108,20 +103,30 @@ path (strerror errno)) result) '() - %distro-module-directory + directory stat)) -(define (package-modules) - "Return the list of modules that provide packages for the distribution." +(define (file-name->module-name file) + "Return the module name (a list of symbols) corresponding to FILE." (define not-slash (char-set-complement (char-set #\/))) - (filter-map (lambda (path) - (let ((name (map string->symbol - (string-tokenize (string-drop-right path 4) - not-slash)))) - (false-if-exception (resolve-interface name)))) - (package-files))) + (map string->symbol + (string-tokenize (string-drop-right file 4) not-slash))) + +(define* (package-modules directory #:optional sub-directory) + "Return the list of modules that provide packages for the distribution. +Optionally, narrow the search to SUB-DIRECTORY." + (define prefix-len + (string-length directory)) + + (filter-map (lambda (file) + (let ((file (substring file prefix-len))) + (false-if-exception + (resolve-interface (file-name->module-name file))))) + (scheme-files (if sub-directory + (string-append directory "/" sub-directory) + directory)))) (define (fold-packages proc init) "Call (PROC PACKAGE RESULT) for each available package, using INIT as @@ -142,7 +147,7 @@ same package twice." module))) init vlist-null - (package-modules)))) + (package-modules %distro-root-directory "gnu/packages")))) (define* (find-packages-by-name name #:optional version) "Return the list of packages with the given NAME. If VERSION is not #f, |