summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-31 22:55:41 +0200
committerLudovic Courtès <ludo@gnu.org>2015-03-31 22:55:41 +0200
commit1968262a237e398f12a25eb2cbda4c944a2ce1bf (patch)
treeca19000b362d3a15b0c19b2508b7a30f444bdf24
parentf8503e2b2588391c4c0f8d8dd11ef3e9449a2884 (diff)
downloadguix-1968262a237e398f12a25eb2cbda4c944a2ce1bf.tar.gz
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.
-rw-r--r--guix/build/utils.scm64
1 files changed, 37 insertions, 27 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 5d5566d1e3..74165c717f 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -44,6 +44,7 @@
             mkdir-p
             copy-recursively
             delete-file-recursively
+            file-name-predicate
             find-files
 
             search-path-as-list
@@ -263,33 +264,42 @@ errors."
                       ;; 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)))
-
-  ;; 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 (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)))))
+
+(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<?)))
 
 
 ;;;