summaryrefslogtreecommitdiff
path: root/guix/discovery.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/discovery.scm')
-rw-r--r--guix/discovery.scm61
1 files changed, 39 insertions, 22 deletions
diff --git a/guix/discovery.scm b/guix/discovery.scm
index 319ba7c872..292df2bd9c 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -19,6 +19,7 @@
(define-module (guix discovery)
#:use-module (guix ui)
#:use-module (guix combinators)
+ #:use-module (guix build syscalls)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@@ -37,29 +38,45 @@
(define* (scheme-files directory)
"Return the list of Scheme files found under DIRECTORY, recursively. The
-returned list is sorted in alphabetical order."
+returned list is sorted in alphabetical order. Return the empty list if
+DIRECTORY is not accessible."
+ (define (entry-type name properties)
+ (match (assoc-ref properties 'type)
+ ('unknown
+ (stat:type (lstat name)))
+ ((? symbol? type)
+ type)))
- ;; Sort entries so that 'fold-packages' works in a deterministic fashion
- ;; regardless of details of the underlying file system.
- (sort (file-system-fold (const #t) ;enter?
- (lambda (path stat result) ;leaf
- (if (string-suffix? ".scm" path)
- (cons path result)
- result))
- (lambda (path stat result) ;down
- result)
- (lambda (path stat result) ;up
- result)
- (const #f) ;skip
- (lambda (path stat errno result)
- (unless (= ENOENT errno)
- (warning (G_ "cannot access `~a': ~a~%")
- path (strerror errno)))
- result)
- '()
- directory
- stat)
- string<?))
+ ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
+ ;; opposed to Guile's 'scandir' or 'file-system-fold'.
+ (fold-right (lambda (entry result)
+ (match entry
+ (("." . _)
+ result)
+ ((".." . _)
+ result)
+ ((name . properties)
+ (let ((absolute (string-append directory "/" name)))
+ (case (entry-type absolute properties)
+ ((directory)
+ (append (scheme-files absolute) result))
+ ((regular symlink)
+ ;; XXX: We don't recurse if we find a symlink.
+ (if (string-suffix? ".scm" name)
+ (cons absolute result)
+ result))
+ (else
+ result))))))
+ '()
+ (catch 'system-error
+ (lambda ()
+ (scandir* directory))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (unless (= errno ENOENT)
+ (warning (G_ "cannot access `~a': ~a~%")
+ directory (strerror errno)))
+ '())))))
(define file-name->module-name
(let ((not-slash (char-set-complement (char-set #\/))))