From 4fe1e30e33c01be9fd17cf240732b3351c7b0fa4 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 5 Jul 2021 18:55:31 +0200
Subject: [PATCH 1/2] profiles: Optimise 'fonts-dir-file'.

Only let the build G-exp refer to inputs that might actually
have fonts.  That way, if the list of fonts in the manifest
didn't change and the new manifest is built, the font files
will not be rebuilt.

* guix/profiles.scm
  (fonts-dir-file)[has-fonts?]: New predicate.
  (fonts-dir-file)[relevant-inputs]: New variable.
  (fonts-dir-file)[build]: Use 'relevant-inputs' instead of
  'manifest-inputs'.
* doc/contributing.texi (Fonts): Note the 'fonts-' naming
  convention is technically important now.
* gnu/packages/ghostscript.scm (gs-fonts): Work-around the
  package name contravening the convention.
---
 doc/contributing.texi        |  8 ++++++++
 gnu/packages/ghostscript.scm | 10 +++++++++-
 guix/profiles.scm            | 22 +++++++++++++++++++++-
 3 files changed, 38 insertions(+), 2 deletions(-)

diff --git a/doc/contributing.texi b/doc/contributing.texi
index 1f0160a707..903cfd390b 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -886,6 +886,14 @@ is added to the package name.  We use @code{-ttf} for TrueType fonts,
 @code{-otf} for OpenType fonts and @code{-type1} for PostScript Type 1
 fonts.
 
+There are important technical reasons for this naming convention as well:
+for efficiency reasons, the profile generation code needs to know if a
+package has fonts and looks at the package name to determine this.
+
+@c ^ There is an escape hatch (the 'has-fonts?' package property),
+@c but let's keep it undocumented until it turns out to be actually
+@c needed somewhere else than in the incorrectly-named 'gs-fonts'
+@c package ...
 
 @node Coding Style
 @section Coding Style
diff --git a/gnu/packages/ghostscript.scm b/gnu/packages/ghostscript.scm
index 03a516dc52..a9f1c52c66 100644
--- a/gnu/packages/ghostscript.scm
+++ b/gnu/packages/ghostscript.scm
@@ -384,7 +384,15 @@ architecture.")
     "Ghostscript fonts provides fonts and font metrics customarily distributed with
 Ghostscript.  It currently includes the 35 standard PostScript fonts.")
    (license license:gpl2)
-   (home-page "https://sourceforge.net/projects/gs-fonts/")))
+   (home-page "https://sourceforge.net/projects/gs-fonts/")
+   (properties
+    ;; TODO: explicitely tell 'fonts-dir-file' that this is a font package,
+    ;; as this package violates the convention that font package names are
+    ;; prefixed with 'font-'.
+    ;;
+    ;; TODO(core-updates): Rename package to 'fonts-ghostscript' or something
+    ;; like that.
+    `((has-fonts? . #t)))))
 
 (define-public libspectre
   (package
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8c02149c6f..0f9df68f42 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -33,6 +34,8 @@
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
                 #:select (package-name->name+version mkdir-p))
+  #:use-module ((guix build-system)
+                #:select (build-system-name))
   #:use-module ((guix diagnostics) #:select (&fix-hint))
   #:use-module (guix i18n)
   #:use-module (guix records)
@@ -1514,6 +1517,23 @@ files for the fonts of the @var{manifest} entries."
   (define mkfontdir
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir))
 
+  (define (has-fonts? input)
+    (define thing (gexp-input-thing input))
+    (if (package? thing)
+        (or (string-prefix? "font-" (package-name thing))
+            ;; In the upstream 'guix' channel, font packages should
+            ;; be named font-SOMETHING.  But if another channel
+            ;; names its fonts differently but uses font-build-system,
+            ;; accepting that seems friendly.
+            (eq? 'font (build-system-name (package-build-system thing)))
+            ;; FIXME(core-updates) escape hatch for the incorrectly-named
+            ;; 'gs-fonts' package
+            (assq-ref (package-properties thing) 'has-fonts?))
+        ;; Pessimistically assume the input might have fonts.
+        #t))
+
+  (define relevant-inputs (filter has-fonts? (manifest-inputs manifest)))
+
   (define build
     #~(begin
         (use-modules (srfi srfi-26)
@@ -1522,7 +1542,7 @@ files for the fonts of the @var{manifest} entries."
         (let ((fonts-dirs (filter file-exists?
                                   (map (cut string-append <>
                                             "/share/fonts")
-                                       '#$(manifest-inputs manifest)))))
+                                       '#$relevant-inputs))))
           (mkdir #$output)
           (if (null? fonts-dirs)
               (exit #t)
-- 
2.32.0