gnu: Merge xorg configurations when extending.

Configuration for xorg is embedded in the various display-manager
configuration records, and extension support is factored out into the
`handle-xorg-configuration' macro.  However, the extension mechanism replaces
the existing xorg-configuration with the supplied one, making it impossible to
compose configuration from multiple sources.  This patch adds a procedure to
merge two xorg-configuration records, and calls it within
handle-xorg-configuration, allowing the config to be built piecemeal.

* gnu/services/xorg.scm (merge-xorg-configurations): New variable.
(handle-xorg-configuration): Merge xorg configs.

Change-Id: I20e9db911eef5d4efe98fdf382f3084e4defc1ba
Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>

1 files changed, 232 insertions, 0 deletions

diff --git a/tests/services/xorg.scm b/tests/services/xorg.scm
new file mode 100644
index 00000000000..0bb4a3e14cf
--- /dev/null
+++ b/tests/services/xorg.scm
@@ -0,0 +1,232 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Ian Eure <ian@retrospec.tv>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests services xorg)
+  #:use-module (guix diagnostics)
+  #:use-module (guix packages)
+  #:use-module (gnu packages xorg)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu services)
+  #:use-module (gnu services base)
+  #:use-module (gnu services xorg)
+  #:use-module (gnu system)
+  #:use-module (gnu system keyboard)
+  #:use-module (gnu system file-systems)
+  #:use-module ((srfi srfi-1) #:select (find))
+  #:use-module (srfi srfi-64))
+
+;;; Tests for the (gnu services xorg) module.
+
+(define %config-empty (xorg-configuration))
+
+(define %default-server (xorg-configuration-server %config-empty))
+
+
+
+(test-begin "merge-xorg-configurations")
+
+(define merge-xorg-configurations
+  (@@ (gnu services xorg) merge-xorg-configurations))
+
+(define gdm-configuration-xorg
+  (@@ (gnu services xorg) gdm-configuration-xorg))
+
+;; keyboard-layout tests.
+
+(define %config-xorg-keyboard-layout-1
+  (xorg-configuration
+    (keyboard-layout (keyboard-layout "us" #:options '("ctrl:nocaps")))))
+
+(define %config-xorg-keyboard-layout-2
+  (xorg-configuration
+    (keyboard-layout (keyboard-layout "us" #:options '("ctrl:esc")))))
+
+;; Later keyboard layouts replace earlier defaults
+(test-equal
+    (keyboard-layout "us" #:options '("ctrl:nocaps"))
+  (xorg-configuration-keyboard-layout
+   (merge-xorg-configurations
+    (list %config-empty %config-xorg-keyboard-layout-1))))
+
+;; Later keyboard layouts replace earlier customizations.
+(test-equal
+    (keyboard-layout "us" #:options '("ctrl:esc"))
+  (xorg-configuration-keyboard-layout
+   (merge-xorg-configurations (list %config-empty
+                                    %config-xorg-keyboard-layout-1
+                                    %config-xorg-keyboard-layout-2))))
+
+;; server, server-arguments tests.
+
+(define %custom-server-1
+  (package
+    (inherit xorg-server)
+    (name "fake-xorg-server")))
+
+(define %custom-server-2
+  (package
+    (inherit xorg-server)
+    (name "another-fake-xorg-server")))
+
+(define %custom-server-1-arguments
+  (cons "-nosilk" %default-xorg-server-arguments))
+
+(define %custom-server-2-arguments
+  (cons* "-logverbose" "9" %default-xorg-server-arguments))
+
+(define %config-custom-server-1
+  (xorg-configuration
+    (server %custom-server-1)))
+
+(define %config-custom-server-2
+  (xorg-configuration
+    (server %custom-server-2)))
+
+(define %config-custom-server-1-and-arguments
+  (xorg-configuration
+    (inherit %config-custom-server-1)
+    (server-arguments %custom-server-1-arguments)))
+
+(define %config-custom-server-2-and-arguments
+  (xorg-configuration
+    (inherit %config-custom-server-2)
+    (server-arguments %custom-server-2-arguments)))
+
+;; Custom server is prioritized over earlier default.
+(test-equal
+    %custom-server-1
+  (xorg-configuration-server
+   (merge-xorg-configurations (list %config-empty
+                                    %config-custom-server-1))))
+
+;; Custom server preserves arguments.
+(test-equal
+    (list %custom-server-1 %custom-server-1-arguments)
+  (let ((cfg (merge-xorg-configurations
+              (list
+               %config-empty
+               %config-custom-server-1-and-arguments))))
+    (list (xorg-configuration-server cfg)
+          (xorg-configuration-server-arguments cfg))))
+
+;; Later custom arguments replace earlier.
+(test-equal
+    (list %custom-server-2 %custom-server-2-arguments)
+  (let ((cfg (merge-xorg-configurations
+              (list
+               %config-empty
+               %config-custom-server-1-and-arguments
+               %config-custom-server-2-and-arguments))))
+    (list (xorg-configuration-server cfg)
+          (xorg-configuration-server-arguments cfg))))
+
+;; Custom server is prioritized over later default.
+(test-equal
+    %custom-server-1
+  (xorg-configuration-server
+   (merge-xorg-configurations (list %config-custom-server-1
+                                    %config-empty))))
+
+;; Custom arguments are prioritized over earlier custom server.
+(test-equal
+    %custom-server-2-arguments
+  (xorg-configuration-server-arguments
+   (merge-xorg-configurations
+    (list
+     (xorg-configuration (server %custom-server-1))
+     (xorg-configuration (server-arguments %custom-server-2-arguments))))))
+
+;; Later custom servers are prioritized over earlier.
+(test-equal
+    %custom-server-2
+  (xorg-configuration-server
+   (merge-xorg-configurations (list %config-custom-server-1
+                                    %config-empty
+                                    %config-custom-server-2))))
+
+(test-equal
+    %custom-server-2
+  (xorg-configuration-server
+   (merge-xorg-configurations (list %config-empty
+                                    %config-custom-server-1
+                                    %config-custom-server-2))))
+
+(test-equal
+    %custom-server-1
+  (xorg-configuration-server
+   (merge-xorg-configurations (list %config-empty
+                                    %config-custom-server-1))))
+
+;; Make sure it works in the context of an operating-system.
+(test-equal
+    %custom-server-2
+  (let ((os (operating-system
+              (host-name "test")
+              (bootloader
+                (bootloader-configuration
+                  (bootloader grub-bootloader)
+                  (targets '("/dev/sdX"))))
+              (file-systems
+               (cons
+                (file-system
+                  (device (file-system-label "my-root"))
+                  (mount-point "/")
+                  (type "ext4"))
+                %base-file-systems))
+              (services
+               (cons*
+                (simple-service 'server-2 gdm-service-type
+                                %config-custom-server-2)
+                (simple-service 'server-1 gdm-service-type
+                                %config-custom-server-1)
+                (service gdm-service-type)
+                %base-services)))))
+    (xorg-configuration-server
+     (gdm-configuration-xorg
+      (service-value
+       (fold-services
+        (operating-system-services os)
+        #:target-type gdm-service-type))))))
+
+;; extra-config tests.
+
+;; Extra configurations append.
+(let ((snippet-one "# First")
+      (snippet-two "# Second"))
+  (test-equal
+      (list snippet-one snippet-two)
+    (xorg-configuration-extra-config
+     (merge-xorg-configurations
+      (list (xorg-configuration (extra-config (list snippet-one)))
+            (xorg-configuration (extra-config (list snippet-two))))))))
+
+;; drivers tests.
+
+(define %drivers-custom-1 '("done"))
+(define %drivers-custom-2 '("dtwo"))
+
+(test-equal
+    (append %drivers-custom-1 %drivers-custom-2)
+  (xorg-configuration-drivers
+   (merge-xorg-configurations
+    (list
+     (xorg-configuration (drivers %drivers-custom-1))
+     (xorg-configuration (drivers %drivers-custom-2))))))
+
+(test-end "merge-xorg-configurations")