utils: 'find-files' takes an arbitrary predicate as its second argument.

* guix/build/utils.scm (file-name-predicate): New procedure.
  (find-files): Rename second parameter to 'pred'.  When 'pred' is not a
  procedure, call 'file-name-predicate'.  Use PRED instead of
  'regexp-exec' in the leaf procedure.
This commit is contained in:
Ludovic Courtès 2015-03-31 22:55:41 +02:00
parent f8503e2b25
commit 1968262a23

View file

@ -44,6 +44,7 @@ (define-module (guix build utils)
mkdir-p mkdir-p
copy-recursively copy-recursively
delete-file-recursively delete-file-recursively
file-name-predicate
find-files find-files
search-path-as-list search-path-as-list
@ -263,33 +264,42 @@ (define* (delete-file-recursively dir
;; Don't follow symlinks. ;; Don't follow symlinks.
lstat))) lstat)))
(define (find-files dir regexp) (define (file-name-predicate regexp)
"Return the lexicographically sorted list of files under DIR whose basename "Return a predicate that returns true when passed a file name whose base
matches REGEXP." name matches REGEXP."
(define file-rx (let ((file-rx (if (regexp? regexp)
(if (regexp? regexp) regexp
regexp (make-regexp regexp))))
(make-regexp regexp))) (lambda (file stat)
(regexp-exec file-rx (basename file)))))
;; Sort the result to get deterministic results. (define (find-files dir pred)
(sort (file-system-fold (const #t) "Return the lexicographically sorted list of files under DIR for which PRED
(lambda (file stat result) ; leaf returns true. PRED is passed two arguments: the absolute file name, and its
(if (regexp-exec file-rx (basename file)) stat buffer. PRED can also be a regular expression, in which case it is
(cons file result) equivalent to (file-name-predicate PRED)."
result)) (let ((pred (if (procedure? pred)
(lambda (dir stat result) ; down pred
result) (file-name-predicate pred))))
(lambda (dir stat result) ; up ;; Sort the result to get deterministic results.
result) (sort (file-system-fold (const #t)
(lambda (file stat result) ; skip (lambda (file stat result) ; leaf
result) (if (pred file stat)
(lambda (file stat errno result) (cons file result)
(format (current-error-port) "find-files: ~a: ~a~%" result))
file (strerror errno)) (lambda (dir stat result) ; down
result) result)
'() (lambda (dir stat result) ; up
dir) result)
string<?)) (lambda (file stat result) ; skip
result)
(lambda (file stat errno result)
(format (current-error-port) "find-files: ~a: ~a~%"
file (strerror errno))
result)
'()
dir)
string<?)))
;;; ;;;