;;; 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")