ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-14 10:55:23 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
1 changed files with 36 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/build/utils.scm
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,18 +264,27 @@ (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)))))
(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 the result to get deterministic results.
(sort (file-system-fold (const #t) (sort (file-system-fold (const #t)
(lambda (file stat result) ; leaf (lambda (file stat result) ; leaf
(if (regexp-exec file-rx (basename file)) (if (pred file stat)
(cons file result) (cons file result)
result)) result))
(lambda (dir stat result) ; down (lambda (dir stat result) ; down
@ -289,7 +299,7 @@ (define file-rx
result) result)
'() '()
dir) dir)
string<?)) string<?)))
;;; ;;;