bug#47569: ‘qt-build-system’ retains too many references via wrappers

[Ludovic Courtès]

Hi again!

The attached patch fixes this problem AFAICS by filtering out of
XDG_DATA_DIRS directories that are unlikely to be of any use.  It
follows the same strategy as ‘glib-or-gtk-build-system’, which is to
only include share/ sub-directories that also contain one of the given
“selectors”: /glib-2.0/schemas, /sounds, /themes, etc.

It gives me a working ktouch, with a wrapper sets a much shorter
XDG_DATA_DIR:

--8<---------------cut here---------------start------------->8---
$ head -2 $(./pre-inst-env guix build --no-grafts ktouch)/bin/ktouch
#!/gnu/store/pwcp239kjf7lnj5i4lkdzcfcxwcfyk72-bash-minimal-5.0.16/bin/bash
export 
XDG_DATA_DIRS="/gnu/store/mgzijzw7yn03pbk54zy0f81gyph9jh3k-ktouch-20.12.1/share:/gnu/store/5g95qdh0p46qszv199rmdd2lx4mninm7-kcoreaddons-5.70.0/share"
$ head -2 $(guix build --no-grafts ktouch)/bin/ktouch
#!/gnu/store/pwcp239kjf7lnj5i4lkdzcfcxwcfyk72-bash-minimal-5.0.16/bin/bash
export 
XDG_DATA_DIRS="/gnu/store/f821syw55jd0l04xkmnbvp562flrw6fm-ktouch-20.12.1/share:/gnu/store/3dsl2jalrcyldkrsqab1hc6sv8pyag9z-cmake-minimal-3.16.5/share:/gnu/store/3x63j4ndhbzkjwr6mhnp4h86r550gs7q-extra-cmake-modules-5.70.0/share:/gnu/store/w08sglxbfpmcvz25pfgnq7v27m1rlkf9-kdoctools-5.70.0/share:/gnu/store/krpyb0zi700dcrg9cc8932w4v0qivdg9-pkg-config-0.29.2/share:/gnu/store/v6f44zccwh9z5zk3pjlywjybbi8n2hjh-tar-1.32/share:/gnu/store/ncydgq2znms5n1d2k5yqshhf58nsixwv-gzip-1.10/share:/gnu/store/i8h2pcxqdq07ijm3ibkka8f4smn1w48v-bzip2-1.0.8/share:/gnu/store/9860f1abqj8wjjnwl8a9v54pdcc3bhgf-xz-5.2.4/share:/gnu/store/60g7r3l01fd7c58yjbm6krgcwj1jkpwg-file-5.38/share:/gnu/store/n4n560pfvvw50a9369axw5vj5rrqfj1n-diffutils-3.7/share:/gnu/store/cd5qf3kcnlq35p9k392pjdpdzpsnds70-patch-2.7.6/share:/gnu/store/hic7snhayfl7m6cpfqqr73nmm19bpqkg-findutils-4.7.0/share:/gnu/store/swqdvwri9dbv6zssg6v0by7l05hd6wxp-gawk-5.0.1/share:/gnu/store/ishk7fswcs4gkwcp8mh788z4mvvl9bxh-sed-4.8/share:/gnu/store/bhs4rj58v8j1narb2454raan2ps38xd8-grep-3.4/share:/gnu/store/57xj5gcy1jbl9ai2lnrqnpr0dald9i65-coreutils-8.32/share:/gnu/store/hm40bxnv8jxmbc1lpb7zfimii4xm9m81-make-4.3/share:/gnu/store/pwcp239kjf7lnj5i4lkdzcfcxwcfyk72-bash-minimal-5.0.16/share:/gnu/store/m1z7cdbqsqyp9xnjw5cvlb4a7gkcg3m4-binutils-2.34/share:/gnu/store/rn75fm7adgx3pw5j8pg3bczfqq1y17lk-gcc-7.5.0/share:/gnu/store/fa6wj5bxkj5ll1d7292a70knmyl7a0cr-glibc-2.31/share:/gnu/store/s3dcqzwqaakv1yx37by9chksdbkgih17-glibc-2.31-static/share:/gnu/store/5rj71g09qc9g20mv0lh5a28jhwa5d6dl-kcmutils-5.70.0/share:/gnu/store/3vdmy5gjn1a23ky6l907byc3917xfh2a-kcompletion-5.70.0/share:/gnu/store/ba8nl7wflsf1s95x72kpaj0rzval908b-kconfig-5.70.0/share:/gnu/store/r4120j3v7cnv5qlmp2kqb6xbc63gplpa-kconfigwidgets-5.70.0/share:/gnu/store/5g95qdh0p46qszv199rmdd2lx4mninm7-kcoreaddons-5.70.0/share:/gnu/store/lbq73h2snwpn4wf9wkp8j0rxw0lyhyp4-kdeclarative-5.70.0/share:/gnu/store/k4k0mrgv31clkpl38zjnpb3l0nin2nnl-ki18n-5.70.0/share:/gnu/store/agmzjiqcv1lb77jmr7xwx0br4sy12i6d-kiconthemes-5.70.0/share:/gnu/store/0mbm58p5mybimbvv8ainkzz7mdpynd25-kitemviews-5.70.0/share:/gnu/store/yqpk8haa1z5plgb134f95vryjxghlyjv-kqtquickcharts-20.04.1/share:/gnu/store/5mfz0faj9lc9m1ppijgqkxz03j89dyil-ktextwidgets-5.70.0/share:/gnu/store/fwmp85k5hqy7fw0rnq5560pg4amiblz4-kwidgetsaddons-5.70.0/share:/gnu/store/xslnsy6sxjp66l99mvj67v1x30bh55xi-kwindowsystem-5.70.0/share:/gnu/store/n79ns6y3cc7ny4mkp5qidf57j1cxbg6p-kxmlgui-5.70.0/share:/gnu/store/3x6y8kpbwjmzpndjfhdbn654g7dm85cp-libxcb-1.14/share:/gnu/store/zc9bpa1v46cnqc05xk8njm08bwk8a70m-libxkbfile-1.1.0/share:/gnu/store/j7110r2rhs9pdypx2x0h8nx4r082fbdk-qtbase-5.15.2/share:/gnu/store/8r5y5bnblc4s6w8j5sfxv06ra6lz12j8-qtdeclarative-5.15.2/share:/gnu/store/c020rcd650ikq7gqfnkga46kzis3v2hi-qtgraphicaleffects-5.15.2/share:/gnu/store/2iwman5hbgg15r99rshl6lsxz35dq2b2-qtquickcontrols2-5.15.2/share:/gnu/store/n7dbg5cgcpslrym4zmsimps1ch1p0q8w-qtx11extras-5.15.2/share:/gnu/store/7yjd1h08li3dr2188pfwfnwlq0p3av9p-qtxmlpatterns-5.15.2/share:/gnu/store/gfapkk5c6hvl1d94m4sqnhn7f9l5gqyh-linux-libre-headers-5.4.20/share:/gnu/store/kvdrfyi50zsmy0ykmc9p8qzjlahqfa4p-kservice-5.70.0/share:/gnu/store/yk425lbm0wnjpqm1z964l9l6li5x0wbn-kcodecs-5.70.0/share:/gnu/store/2z5nfmzxhqaalcrswp8nn3yk5ys8q261-kauth-5.70.0/share:/gnu/store/vhmyxywsdy92bgqxy6fnmcpr81xsfcys-kpackage-5.70.0/share:/gnu/store/rz42ba0my9vrgbkjpkzr2drmnjk5ah50-python-3.8.2/share:/gnu/store/n9wx4dp68bfsw9bb1bwmklzl34ggrmgm-gettext-minimal-0.20.1/share:/gnu/store/yqs5mkp20m58sr744cs2pn8sqb5m59sq-sonnet-5.70.0/share:/gnu/store/6cdl970wcv4jhvpgbh8sdj54a5gwhmwj-libxdmcp-1.1.3/share:/gnu/store/h7sy4hr7arjknbyy1aq0xwv6fksnzw9n-libxau-1.0.9/share:/gnu/store/klk98l8czl05lvanrr7xl7a9hksac4ak-libpthread-stubs-0.4/share:/gnu/store/k30a2pgmc6b3ifmq3rn0dr5ng9gr8w81-which-2.21/share:/gnu/store/7disnxqw8i3n4zhw5s0xj9kkdckkmr1p-mesa-20.2.4/share:/gnu/store/wxl57nkbqgamfp73b7v62kk3f1hiv0cz-xorgproto-2019.2/share:/gnu/store/c3zbbynb590yxrpwcxrkll80mn66h3kf-libxxf86vm-1.1.4/share:/gnu/store/jwga98k68l0h5c45jx7z4jdjzhfc34vm-libxshmfence-1.3/share:/gnu/store/9z9gd76la5bww3sqgg2ax0h00msl28k6-libxfixes-5.0.3/share:/gnu/store/2wysr1lr7b5mc444m39qz107n92xm5xq-libxdamage-1.1.5/share:/gnu/store/fx3979c88s9yxdbchyf36qryawgzpwb5-libx11-1.6.10/share:/gnu/store/kx58xc3hxa9b0mp1hl7pzz43bl7gh18h-libdrm-2.4.103/share:/gnu/store/lc8irxnwazq340ygkbqh0ask446jzy9k-util-macros-1.19.2/share:/gnu/store/qrs0p8j3wq6q5a4dm0ndjdavk9gyal5q-libxext-1.3.4/share"
--8<---------------cut here---------------end--------------->8---

The closure is still awfully big but smaller:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix size ktouch | tail -1
total: 1298.0 MiB
$ guix size ktouch | tail -1
total: 1752.4 MiB
--8<---------------cut here---------------end--------------->8---

Thoughts?

Ludo’.

diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index 005157b0a4..bb17c362d1 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,44 @@
 
 (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
-   (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")))))
+  (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"
+
+           ;; These are "selectors": consider /share if and only if 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 '())