Subject: [bug#42547] [PATCH] build-system/qt: Don't include useless inputs in wrapped variables.

From: Jakub Kądziołka <[email-masked]>
Date: Sun, 26 Jul 2020 14:22:34 +0200

* guix/build-system/qt.scm (qt-build)[qt-wrap-excluded-inputs]: New argument.
* guix/build/qt-build-system.scm (variables-for-wrapping): Take the
  output directory as an argument for special handling. Check for
  subdirectories of /share used by Qt before including inputs in
  XDG_DATA_DIRS.
  (wrap-all-programs): Pass the output directory to variables-for-wrapping.
  (wrap-all-programs)[qt-wrap-excluded-inputs]: New argument.
---
 guix/build-system/qt.scm       |  3 +++
 guix/build/qt-build-system.scm | 45 ++++++++++++++++++++++++----------
 2 files changed, 35 insertions(+), 13 deletions(-)

diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index 118022ec45..3da73e2b58 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2013 Cyril Roelandt <[email-masked]>
 ;;; Copyright © 2017 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2019 Hartmut Goebel <[email-masked]>
+;;; Copyright © 2020 Jakub Kądziołka <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -123,6 +124,7 @@
                                          "bin" "sbin"))
                    (phases '(@ (guix build qt-build-system)
                                %standard-phases))
+                   (qt-wrap-excluded-inputs ''("qttools"))
                    (qt-wrap-excluded-outputs ''())
                    (system (%current-system))
                    (imported-modules %qt-build-system-modules)
@@ -146,6 +148,7 @@ provides a 'CMakeLists.txt' file as its build system."
                  #:search-paths ',(map search-path-specification->sexp
                                        search-paths)
                  #:phases ,phases
+                 #:qt-wrap-excluded-inputs ,qt-wrap-excluded-inputs
                  #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs
                  #:configure-flags ,configure-flags
                  #:make-flags ,make-flags
diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index 005157b0a4..1239c9f5fb 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2014, 2015 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2018 Mark H Weaver <[email-masked]>
 ;;; Copyright © 2019, 2020 Hartmut Goebel <[email-masked]>
+;;; Copyright © 2020 Jakub Kądziołka <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -47,29 +48,44 @@
   (setenv "CTEST_OUTPUT_ON_FAILURE" "1")
   #t)
 
-(define (variables-for-wrapping base-directories)
+;; NOTE: Apart from standard subdirectories of /share, Qt also provides facilities
+;; for per-application data directories, such as /share/quassel. Thus, we include
+;; the output directory even if it doesn't contain any of the standard subdirectories.
+(define (variables-for-wrapping base-directories output-directory)
 
-  (define (collect-sub-dirs base-directories subdirectory)
+  (define (collect-sub-dirs base-directories subdir-spec)
     (filter-map
      (lambda (dir)
-       (let ((directory (string-append dir subdirectory)))
-         (if (directory-exists? directory) directory #f)))
+       (and
+         (match subdir-spec
+           ((subdir) (directory-exists? (string-append dir subdir)))
+           ((subdir children)
+            (or
+              (or-map
+                (lambda (child)
+                  (directory-exists? (string-append dir subdir child)))
+                children)
+              (and (eq? dir output-directory)
+                   (directory-exists? (string-append dir subdir))))))
+         (string-append dir (car subdir-spec))))
      base-directories))
 
   (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))))
+    (match-lambda
+      ((var . subdir-spec)
+       `(,var = ,(collect-sub-dirs base-directories subdir-spec))))
     (list
      ;; these shall match the search-path-specification for Qt and KDE
      ;; libraries
-     '("XDG_DATA_DIRS" "/share")
+     '("XDG_DATA_DIRS" "/share" ("/applications" "/fonts" "/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-inputs '("qttools"))
                             (qt-wrap-excluded-outputs '())
                             #:allow-other-keys)
   "Implement phase \"qt-wrap\": look for GSettings schemas and
@@ -90,10 +106,13 @@ add a dependency of that output on Qt."
            (string-append directory "/lib/libexec"))))
 
   (define input-directories
-    ;; FIXME: Filter out unwanted inputs, e.g. cmake
-    (match inputs
-           (((_ . dir) ...)
-            dir)))
+    (filter-map
+      (match-lambda
+        ((name . dir)
+         (if (member name qt-wrap-excluded-inputs)
+           #f
+           dir)))
+      inputs))
 
   (define handle-output
     (match-lambda
@@ -101,8 +120,8 @@ add a dependency of that output on Qt."
       (unless (member output qt-wrap-excluded-outputs)
         (let ((bin-list     (find-files-to-wrap directory))
               (vars-to-wrap (variables-for-wrapping
-                             (append (list directory)
-                                     input-directories))))
+                             (cons directory input-directories)
+                             directory)))
           (when (not (null? vars-to-wrap))
             (for-each (cut apply wrap-program <> vars-to-wrap)
                       bin-list)))))))
-- 
2.27.0