02/04: build-system/qt: Wrappers only include relevant directories to XDG_DATA_DIRS.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit c5fd1b0bd362f8b8578a76a26a65ba5d00d48992
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Apr 8 22:17:03 2021 +0200

    build-system/qt: Wrappers only include relevant directories to 
XDG_DATA_DIRS.
    
    Fixes <https://bugs.gnu.org/47569>.
    
    Previously the wrapper's XDG_DATA_DIRS would contain any input that had
    a /share sub-directory, which is usually all build-time inputs.
    
    * guix/build/qt-build-system.scm (variables-for-wrapping)[collect-sub-dirs]:
    Add 'selectors' parameter and honor it.  Change caller to handle
    selectors.  Add selectors for /share.
---
 guix/build/qt-build-system.scm | 58 ++++++++++++++++++++++++++++--------------
 1 file changed, 39 insertions(+), 19 deletions(-)

diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index 005157b..0d5531c 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
@@ -49,25 +49,45 @@
 
 (define (variables-for-wrapping base-directories)
 
-  (define (collect-sub-dirs base-directories subdirectory)
-    (filter-map
-     (lambda (dir)
-       (let ((directory (string-append dir subdirectory)))
-         (if (directory-exists? directory) directory #f)))
-     base-directories))
+  (define (collect-sub-dirs base-directories subdirectory
+                            selectors)
+    ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
+    ;; that exists and has at least one of the SELECTORS sub-directories,
+    ;; unless SELECTORS is the empty list.
+    (filter-map (lambda (dir)
+                  (let ((directory (string-append dir subdirectory)))
+                    (and (directory-exists? directory)
+                         (or (null? selectors)
+                             (any (lambda (selector)
+                                    (directory-exists?
+                                     (string-append directory selector)))
+                                  selectors))
+                         directory)))
+                base-directories))
+
+  (filter-map
+   (match-lambda
+     ((variable directory selectors ...)
+      (match (collect-sub-dirs base-directories directory
+                               selectors)
+        (()
+         #f)
+        (directories
+         `(,variable = ,directories)))))
+
+   ;; These shall match the search-path-specification for Qt and KDE
+   ;; libraries.
+   (list '("XDG_DATA_DIRS" "/share"
 
-  (filter
-   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
-   (map
-    (lambda (var-spec)
-      `(,(first var-spec) = ,(collect-sub-dirs base-directories (last 
var-spec))))
-    (list
-     ;; these shall match the search-path-specification for Qt and KDE
-     ;; libraries
-     '("XDG_DATA_DIRS" "/share")
-     '("XDG_CONFIG_DIRS" "/etc/xdg")
-     '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
-     '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
+           ;; These are "selectors": consider /share if and only if at least
+           ;; one of these sub-directories exist.  This avoids adding
+           ;; irrelevant packages to XDG_DATA_DIRS just because they have a
+           ;; /share sub-directory.
+           "/glib-2.0/schemas" "/sounds" "/themes"
+           "/cursors" "/wallpapers" "/icons" "/mime")
+         '("XDG_CONFIG_DIRS" "/etc/xdg")
+         '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
+         '("QML2_IMPORT_PATH" "/lib/qt5/qml"))))
 
 (define* (wrap-all-programs #:key inputs outputs
                             (qt-wrap-excluded-outputs '())