[bug#56771] [PATCH 28/33] build: qt: Add qtbase argument and wrap Qt environment variables exactly.

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

* guix/build-system/qt.scm (default-qtbase): New variable.
(lower) <#:qtbase>: Add argument...
[build-inputs]: ... and propagate it here.
(qt-build): Add qtbase argument.
(qt-cross-build): Likewise.
* guix/build/qt-utils.scm (%default-qt-major-version): New variable.
(variables-for-wrapping): Add qt-major-version argument, and use it to format
the various path prefixes.  Wrap QT environment variables exactly.
(wrap-qt-program*): Add qt-major-version argument, and pass it to
variables-for-wrapping.
(wrap-qt-program): Add qt-major-version argument, and pass it to
wrap-qt-program*.
(wrap-all-qt-programs): Add qtbase argument, and extract the major version
from it, passing it to wrap-qt-program*.
---
 guix/build-system/qt.scm | 14 +++++++++++++
 guix/build/qt-utils.scm  | 44 ++++++++++++++++++++++++++++------------
 2 files changed, 45 insertions(+), 13 deletions(-)

diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index a0b968cef3..bd47ade3fc 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,11 +68,19 @@ (define (default-cmake)
   (let ((module (resolve-interface '(gnu packages cmake))))
     (module-ref module 'cmake-minimal)))
 
+(define (default-qtbase)
+  "Return the default qtbase package."
+
+  ;; Do not use `@' to avoid introducing circular dependencies.
+  (let ((module (resolve-interface '(gnu packages qt))))
+    (module-ref module 'qtbase-5)))
+
 ;; This barely is a copy from (guix build-system cmake), only adjusted to use
 ;; the variables defined here.
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (cmake (default-cmake))
+                (qtbase (default-qtbase))
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
@@ -87,6 +96,7 @@ (define private-keywords
                           `(("source" ,source))
                           '())
                     ,@`(("cmake" ,cmake))
+                    ,@`(("qtbase" ,qtbase))
                     ,@native-inputs
                     ,@(if target
                           ;; Use the standard cross inputs of
@@ -112,6 +122,7 @@ (define private-keywords
 
 (define* (qt-build name inputs
                    #:key
+                   qtbase
                    source (guile #f)
                    (outputs '("out")) (configure-flags ''())
                    (search-paths '())
@@ -150,6 +161,7 @@ (define builder
                     #:phases #$(if (pair? phases)
                                    (sexp->gexp phases)
                                    phases)
+                    #:qtbase #$qtbase
                     #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
                     #:qt-wrap-excluded-inputs #$qt-wrap-excluded-inputs
                     #:configure-flags #$configure-flags
@@ -181,6 +193,7 @@ (define* (qt-cross-build name
                          #:key
                          source target
                          build-inputs target-inputs host-inputs
+                         qtbase
                          (guile #f)
                          (outputs '("out"))
                          (configure-flags ''())
@@ -237,6 +250,7 @@ (define %outputs
                                               search-path-specification->sexp
                                               native-search-paths)
                     #:phases #$phases
+                    #:qtbase #$qtbase
                     #:configure-flags #$configure-flags
                     #:make-flags #$make-flags
                     #:out-of-source? #$out-of-source?
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index fa018a93ac..180b3aad77 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,10 +26,13 @@ (define-module (guix build qt-utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (wrap-qt-program
             wrap-all-qt-programs
             %qt-wrap-excluded-inputs))
 
+(define %default-qt-major-version "5")
+
 (define %qt-wrap-excluded-inputs
   '(list "cmake" "extra-cmake-modules" "qttools"))
 
@@ -37,7 +40,9 @@ (define %qt-wrap-excluded-inputs
 ;; 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* (variables-for-wrapping base-directories output-directory
+                                 #:key
+                                 (qt-major-version %default-qt-major-version))
 
   (define (collect-sub-dirs base-directories file-type subdirectory selectors)
     ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
@@ -82,17 +87,20 @@ (define exists? (match file-type
       "/applications" "/cursors" "/fonts" "/icons" "/glib-2.0/schemas"
       "/mime" "/sounds" "/themes" "/wallpapers")
     '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg")
-    ;; The following variables can be extended by the user, but not
-    ;; overridden, to ensure proper operation.
-    '("QT_PLUGIN_PATH" prefix directory "/lib/qt5/plugins")
-    '("QML2_IMPORT_PATH" prefix directory "/lib/qt5/qml")
+    ;; We wrap exactly to avoid potentially mixing Qt5/Qt6 components, which
+    ;; would cause warnings, perhaps problems.
+    `("QT_PLUGIN_PATH" = directory
+      ,(format #f "/lib/qt~a/plugins" qt-major-version))
+    `("QML2_IMPORT_PATH" = directory
+      ,(format #f "/lib/qt~a/qml" qt-major-version))
     ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the
     ;; most suitable environment variable type for it.
-    '("QTWEBENGINEPROCESS_PATH" = regular
-      "/lib/qt5/libexec/QtWebEngineProcess"))))
+    `("QTWEBENGINEPROCESS_PATH" = regular
+      ,(format #f "/lib/qt~a/libexec/QtWebEngineProcess" qt-major-version)))))
 
 (define* (wrap-qt-program* program #:key inputs output-dir
-                           qt-wrap-excluded-inputs)
+                           qt-wrap-excluded-inputs
+                           (qt-major-version %default-qt-major-version))
 
   (define input-directories
     (filter-map
@@ -104,12 +112,14 @@ (define input-directories
 
   (let ((vars-to-wrap (variables-for-wrapping
                        (cons output-dir input-directories)
-                       output-dir)))
+                       output-dir
+                       #:qt-major-version qt-major-version)))
     (when (not (null? vars-to-wrap))
       (apply wrap-program program vars-to-wrap))))
 
 (define* (wrap-qt-program program-name #:key inputs output
-                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs))
+                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
+                          (qt-major-version %default-qt-major-version))
   "Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
 directory) with suitably set environment variables.
 
@@ -117,9 +127,11 @@ (define* (wrap-qt-program program-name #:key inputs output
 is wrapped."
   (wrap-qt-program* (string-append output "/bin/" program-name)
                     #:output-dir output #:inputs inputs
-                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs))
+                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
+                    #:qt-major-version qt-major-version))
 
 (define* (wrap-all-qt-programs #:key inputs outputs
+                               qtbase
                                (qt-wrap-excluded-outputs '())
                                (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
                                #:allow-other-keys)
@@ -131,6 +143,11 @@ (define* (wrap-all-qt-programs #:key inputs outputs
 QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
 to contain any Qt binaries, and where wrapping would gratuitously
 add a dependency of that output on Qt."
+  (define qt-major-version
+    (let ((_ version (package-name->name+version
+                      (strip-store-file-name qtbase))))
+      (first (string-split version #\.))))
+
   (define (find-files-to-wrap output-dir)
     (append-map
      (lambda (dir)
@@ -149,7 +166,8 @@ (define handle-output
       (unless (member output qt-wrap-excluded-outputs)
         (for-each (cut wrap-qt-program* <>
                        #:output-dir output-dir #:inputs inputs
-                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs)
+                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
+                       #:qt-major-version qt-major-version)
                   (find-files-to-wrap output-dir))))))
 
   (for-each handle-output outputs))
-- 
2.36.1