;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; 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 (gnu home services fontutils)
  #:use-module (gnu home services)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu services configuration)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:use-module (sxml simple)
  #:use-module (ice-9 match)

  #:export (home-fontconfig-service-type
            home-fontconfig-configuration
            default-font))

;;; Commentary:
;;;
;;; Services related to fonts.  home-fontconfig service provides
;;; fontconfig configuration, which allows fc-* utilities to find
;;; fonts in Guix Home's profile and regenerates font cache on
;;; activation.
;;;
;;; Code:

(define (default-font-sanitizer type)
  (lambda (value)
    (if (null? value)
        value
        `(alias
          (family ,type)
          (prefer
           (family ,value))))))

(define-record-type* <default-font> default-font
  make-default-font
  default-font?
  (serif default-font-serif
         (default '())
         (sanitize (default-font-sanitizer 'serif)))
  (sans-serif defalut-font-sans-serif
              (default '())
              (sanitize (default-font-sanitizer 'sans-serif)))
  (monospace default-font-monospace
             (default '())
             (sanitize (default-font-sanitizer 'monospace))))

(define (sxml->xmlstring sxml)
  (if (null? sxml)
      ""
      (call-with-output-string
        (lambda (port)
          (sxml->xml sxml port)))))

(define font-directories? list?)

(define (serialize-font-directories field-name value)
  (sxml->xmlstring
   (append
       '((dir "~/.guix-home/profile/share/fonts"))
       (map
        (lambda (path)
          `(dir ,path))
        value))))

(define extra-config-list? list?)

(define (serialize-extra-config-list field-name value)
  (sxml->xmlstring
   (map (match-lambda
          ((? pair? sxml) sxml)
          ((? string? xml) (xml->sxml xml))
          (_ (error "extra-config value must be xml string or sxml list.")))
        value)))

(define (serialize-default-font field-name value)
  (match value
    (($ <default-font> serif sans-serif monospace)
     (sxml->xmlstring (list serif sans-serif monospace)))))

(define-configuration home-fontconfig-configuration
  (font-directories
   (font-directories '())
   "The directory list that provides fonts.")
  (preferred-default-font
   (default-font (default-font))
   "The preffered default fonts for serif, sans-serif, and monospace.")
  (extra-config
   (extra-config-list '())
   "Extra configuration values to append to the fonts.conf."))

(define (add-fontconfig-config-file user-config)
  `(("fontconfig/fonts.conf"
     ,(mixed-text-file
       "fonts.conf"
       "<?xml version='1.0'?>
<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>
<fontconfig>"
       (serialize-configuration user-config home-fontconfig-configuration-fields)
       "</fontconfig>\n"))))

(define (regenerate-font-cache-gexp _)
  `(("profile/share/fonts"
     ,#~(system* #$(file-append fontconfig "/bin/fc-cache") "-fv"))))

(define home-fontconfig-service-type
  (service-type (name 'home-fontconfig)
                (extensions
                 (list (service-extension
                        home-xdg-configuration-files-service-type
                        add-fontconfig-config-file)
                       (service-extension
                        home-run-on-change-service-type
                        regenerate-font-cache-gexp)
                       (service-extension
                        home-profile-service-type
                        (const (list fontconfig)))))
                (default-value (home-fontconfig-configuration))
                (description
                 "Provides configuration file for fontconfig and make
fc-* utilities aware of font packages installed in Guix Home's profile.")))