03/03: build-system/gnu: Add support for non-directory search paths.

[Ludovic Courtès]

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

commit 6aa47e388390e98bec6caa90fef7f39a60e338a7
Author: Ludovic Courtès <address@hidden>
Date:   Sat Dec 27 12:16:18 2014 +0100

    build-system/gnu: Add support for non-directory search paths.
    
    Partly fixes <http://bugs.gnu.org/18033>.
    
    * guix/build/utils.scm (search-path-as-list): Rename 'sub-directories'
      parameter to 'files'.  Add #:type parameter and honor it.
      (set-path-environment-variable): Likewise.  Pass #:type to
      'search-path-as-list'.
    * guix/packages.scm (search-path-specification->sexp): Add 'directory as
      the last item of the tuple.
    * guix/build/gnu-build-system.scm (set-paths): Add 'type' to search-path
      pattern.  Pass #:type to 'set-path-environment-variable'.
---
 guix/build/gnu-build-system.scm |   14 ++++++++------
 guix/build/utils.scm            |   33 +++++++++++++++++++--------------
 guix/packages.scm               |    3 ++-
 3 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index d3de92b..4cc755f 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -73,19 +73,21 @@
                                              input-directories)))
 
   (for-each (match-lambda
-             ((env-var (directories ...) separator)
-              (set-path-environment-variable env-var directories
+             ((env-var (files ...) separator type)
+              (set-path-environment-variable env-var files
                                              input-directories
-                                             #:separator separator)))
+                                             #:separator separator
+                                             #:type type)))
             search-paths)
 
   (when native-search-paths
     ;; Search paths for native inputs, when cross building.
     (for-each (match-lambda
-               ((env-var (directories ...) separator)
-                (set-path-environment-variable env-var directories
+               ((env-var (files ...) separator type)
+                (set-path-environment-variable env-var files
                                                native-input-directories
-                                               #:separator separator)))
+                                               #:separator separator
+                                               #:type type)))
               native-search-paths))
 
   #t)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 9b1e098..f22b2c3 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -290,9 +290,10 @@ matches REGEXP."
 ;;; Search paths.
 ;;;
 
-(define (search-path-as-list sub-directories input-dirs)
-  "Return the list of directories among SUB-DIRECTORIES that exist in
-INPUT-DIRS.  Example:
+(define* (search-path-as-list files input-dirs
+                              #:key (type 'directory))
+  "Return the list of directories among FILES of the given TYPE (a symbol as
+returned by 'stat:type') that exist in INPUT-DIRS.  Example:
 
   (search-path-as-list '(\"share/emacs/site-lisp\" \"share/emacs/24.1\")
                        (list \"/package1\" \"/package2\" \"/package3\"))
@@ -301,12 +302,12 @@ INPUT-DIRS.  Example:
 
 "
   (append-map (lambda (input)
-                (filter-map (lambda (dir)
-                              (let ((dir (string-append input "/"
-                                                        dir)))
-                                (and (directory-exists? dir)
-                                     dir)))
-                            sub-directories))
+                (filter-map (lambda (file)
+                              (let* ((file (string-append input "/" file))
+                                     (stat (stat file #f)))
+                                (and stat (eq? type (stat:type stat))
+                                     file)))
+                            files))
               input-dirs))
 
 (define (list->search-path-as-string lst separator)
@@ -315,16 +316,20 @@ INPUT-DIRS.  Example:
 (define* (search-path-as-string->list path #:optional (separator #\:))
   (string-tokenize path (char-set-complement (char-set separator))))
 
-(define* (set-path-environment-variable env-var sub-directories input-dirs
-                                        #:key (separator ":"))
-  "Look for each of SUB-DIRECTORIES in INPUT-DIRS.  Set ENV-VAR to a
-SEPARATOR-separated path accordingly.  Example:
+(define* (set-path-environment-variable env-var files input-dirs
+                                        #:key
+                                        (separator ":")
+                                        (type 'directory))
+  "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:
 
   (set-path-environment-variable \"PKG_CONFIG\"
                                  '(\"lib/pkgconfig\")
                                  (list package1 package2))
 "
-  (let* ((path  (search-path-as-list sub-directories input-dirs))
+  (let* ((path  (search-path-as-list files input-dirs
+                                     #:type type))
          (value (list->search-path-as-string path separator)))
     (if (string-null? value)
         (begin
diff --git a/guix/packages.scm b/guix/packages.scm
index a25eab7..ed9a565 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -180,7 +180,8 @@ representation."
 corresponds to the arguments expected by `set-path-environment-variable'."
   (match spec
     (($ <search-path-specification> variable directories separator)
-     `(,variable ,directories ,separator))))
+     ;; TODO: Allow other values of TYPE.  See <http://bugs.gnu.org/18033>.
+     `(,variable ,directories ,separator directory))))
 
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we