;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; 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 (test-home-services-fontutils)
  #:use-module (gnu services)
  #:use-module (gnu home services)
  #:use-module (gnu home services fontutils)
  #:use-module (guix tests)
  #:use-module (sxml simple)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64))

;; or (@@ (gnu home services fontutils) add-fontconfig-config-file)
(define add-fontconfig-config-file
  (let* ((extensions (service-type-extensions home-fontconfig-service-type))
         (extension (find (lambda (ext)
                            (eq? (service-extension-target ext)
                                 home-xdg-configuration-files-service-type))
                          extensions))
         (compute (service-extension-compute extension)))
    compute))

(define (assert-fontconfig-value value expected)
  (mock ((guix gexp) mixed-text-file
         (lambda* (name #:key guile #:rest text)
           (let ((text (string-join text "")))
             (unless (string= text expected)
               (error "assert failed. actual: %s" text)))))
        (add-fontconfig-config-file value)
        #t))

(test-begin "home-services-fontutils")

(test-assert "fontconfig (default value)"
  (assert-fontconfig-value '() "\
<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig><dir>~/.guix-home/profile/share/fonts</dir></fontconfig>
"))

(test-assert "fontconfig (a text)"
  (assert-fontconfig-value '("<foo>foo</foo>") "\
<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig><dir>~/.guix-home/profile/share/fonts</dir><foo>foo</foo></fontconfig>
"))

(test-assert "fontconfig (multiple texts)"
  (assert-fontconfig-value '("<foo>foo</foo>" "<bar><baz>baz</baz></bar>") "\
<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig><dir>~/.guix-home/profile/share/fonts</dir><foo>foo</foo><bar><baz>baz</baz></bar></fontconfig>
"))

(test-assert "fontconfig (a sxml)"
  (assert-fontconfig-value '((foo foo)) "\
<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig><dir>~/.guix-home/profile/share/fonts</dir><foo>foo</foo></fontconfig>
"))

(test-assert "fontconfig (multiple sxml)"
  (assert-fontconfig-value '((foo foo) (bar (baz baz))) "\
<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig><dir>~/.guix-home/profile/share/fonts</dir><foo>foo</foo><bar><baz>baz</baz></bar></fontconfig>
"))

(test-error "fontconfig (invalid value)"
  (add-fontconfig-config-file '(123)))

(test-end "home-services-fontutils")