summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-24 10:23:27 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-24 10:23:27 +0200
commit84836a5733e35de758d34d9ea40b9b4c8b70836f (patch)
tree5cebc9d627f8b4d492362aa4a6fd6cf8b8fbe17c /gnu
parentdf354a771d9838f62d9dc2d8a68388fff3363ec3 (diff)
packages: Generalize package module search.
* gnu/packages.scm (%distro-root-directory): New variable. (%distro-module-directory): Remove. (package-files): Rename to... (scheme-files): ... this. Return absolute file names, not stripped. (file-name->module-name): New procedure. (package-modules): Add 'directory' and 'sub-directory' parameters. Rewrite accordingly. (fold-packages): Adjust 'package-modules' call accordingly.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/packages.scm49
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,