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