03/07: build-support/gnu: Add support for file patterns in search paths.

[Ludovic Courtès]

civodul pushed a commit to branch core-updates
in repository guix.

commit 7ec02d374d1fa8a8f4034a996485872fd2aa7b73
Author: Ludovic Courtès <address@hidden>
Date:   Sat Dec 27 22:55:34 2014 +0100

    build-support/gnu: Add support for file patterns in search paths.
    
    * guix/build/utils.scm (search-path-as-list): Add #:pattern parameter
      and honor it.
      (set-path-environment-variable): Likewise, and pass it to
      'search-path-as-list'.
    * guix/packages.scm (search-path-specification->sexp): Add PATTERN slot.
    * guix/build/gnu-build-system.scm (set-paths): Adjust accordingly.
---
 guix/build/gnu-build-system.scm |   10 +++++---
 guix/build/utils.scm            |   40 +++++++++++++++++++++++++++++++-------
 guix/packages.scm               |    3 +-
 3 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index d661736..11b43c5 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -73,21 +73,23 @@
                                              input-directories)))
 
   (for-each (match-lambda
-             ((env-var (files ...) separator type)
+             ((env-var (files ...) separator type pattern)
               (set-path-environment-variable env-var files
                                              input-directories
                                              #:separator separator
-                                             #:type type)))
+                                             #:type type
+                                             #:pattern pattern)))
             search-paths)
 
   (when native-search-paths
     ;; Search paths for native inputs, when cross building.
     (for-each (match-lambda
-               ((env-var (files ...) separator type)
+               ((env-var (files ...) separator type pattern)
                 (set-path-environment-variable env-var files
                                                native-input-directories
                                                #:separator separator
-                                               #:type type)))
+                                               #:type type
+                                               #:pattern pattern)))
               native-search-paths))
 
   #t)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index f22b2c3..47bcb3e 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -291,7 +291,7 @@ matches REGEXP."
 ;;;
 
 (define* (search-path-as-list files input-dirs
-                              #:key (type 'directory))
+                              #:key (type 'directory) pattern)
   "Return the list of directories among FILES of the given TYPE (a symbol as
 returned by 'stat:type') that exist in INPUT-DIRS.  Example:
 
@@ -300,13 +300,26 @@ returned by 'stat:type') that exist in INPUT-DIRS.  
Example:
   => (\"/package1/share/emacs/site-lisp\"
       \"/package3/share/emacs/site-lisp\")
 
+When PATTERN is true, it is a regular expression denoting file names to look
+for under the directories designated by FILES.  For example:
+
+  (search-path-as-list '(\"xml\") (list docbook-xml docbook-xsl)
+                       #:type 'regular
+                       #:pattern \"^catalog\\\\.xml$\")
+  => (\"/…/xml/dtd/docbook/catalog.xml\"
+      \"/…/xml/xsl/docbook-xsl-1.78.1/catalog.xml\")
 "
   (append-map (lambda (input)
-                (filter-map (lambda (file)
-                              (let* ((file (string-append input "/" file))
-                                     (stat (stat file #f)))
-                                (and stat (eq? type (stat:type stat))
-                                     file)))
+                (append-map (lambda (file)
+                              (let ((file (string-append input "/" file)))
+                                ;; XXX: By using 'find-files', we implicitly
+                                ;; assume #:type 'regular.
+                                (if pattern
+                                    (find-files file pattern)
+                                    (let ((stat (stat file #f)))
+                                      (if (and stat (eq? type (stat:type 
stat)))
+                                          (list file)
+                                          '())))))
                             files))
               input-dirs))
 
@@ -319,7 +332,8 @@ returned by 'stat:type') that exist in INPUT-DIRS.  Example:
 (define* (set-path-environment-variable env-var files input-dirs
                                         #:key
                                         (separator ":")
-                                        (type 'directory))
+                                        (type 'directory)
+                                        pattern)
   "Look for each of FILES of the given TYPE (a symbol as returned by
 'stat:type') in INPUT-DIRS.  Set ENV-VAR to a SEPARATOR-separated path
 accordingly.  Example:
@@ -327,9 +341,19 @@ accordingly.  Example:
   (set-path-environment-variable \"PKG_CONFIG\"
                                  '(\"lib/pkgconfig\")
                                  (list package1 package2))
+
+When PATTERN is not #f, it must be a regular expression (really a string)
+denoting file names to look for under the directories designated by FILES:
+
+  (set-path-environment-variable \"XML_CATALOG_FILES\"
+                                 '(\"xml\")
+                                 (list docbook-xml docbook-xsl)
+                                 #:type 'regular
+                                 #:pattern \"^catalog\\\\.xml$\")
 "
   (let* ((path  (search-path-as-list files input-dirs
-                                     #:type type))
+                                     #:type type
+                                     #:pattern pattern))
          (value (list->search-path-as-string path separator)))
     (if (string-null? value)
         (begin
diff --git a/guix/packages.scm b/guix/packages.scm
index b375895..e299962 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -181,7 +181,8 @@ representation."
 corresponds to the arguments expected by `set-path-environment-variable'."
   (match spec
     (($ <search-path-specification> variable files separator type)
-     `(,variable ,files ,separator ,type))))
+     ;; TODO: Add support for PATTERN.
+     `(,variable ,files ,separator ,type #f))))
 
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we