[bug#49421] [PATCH] profiles: Optimise 'fonts-dir-file'.

[Maxime Devos]

Hi guix,

These two patches should speed up profile generation
by optimising the 'fonts-dir-file' hook.  The first patch
is the most important; from the commit message:

‘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.’

The second patch doesn't bring much.

To test, you can test whether things like ...

$ ./pre-inst-env guix environment --ad-hoc --pure lagrange -- lagrange

still work (lagrange is a graphical application using fonts).
Not sure what a good ‘benchmark’ would be.

Unfortunately, this does not help with the "guix package -i" case,
as in that case, the code doesn't have access to all the package objects,
and will have to satisfy itself with the store paths, in which case the
profile code pessimistically assumes the store item has fonts ...

I suppose this restriction could be lifted if/when the gs-fonts package
is renamed to font-ghostscript or something like that ...

However, the optimisation should work in the "guix environment ... --ad-hoc 
...",
"guix system reconfigure ..." and (I'd presume) the guix home-manager cases,
though I only tested the first.

Greetings,
Maxime.

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

From a706b8be4f54530b1cd12c03a1bf3941be43be3c Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 5 Jul 2021 20:16:22 +0200
Subject: [PATCH 2/2] profiles: Avoid dependency on 'mkfontdir' and friend when
 unused.

Avoid depending on on "mkfontdir" and "mkfontscale" if
they won't actually be used, to avoid building the
aforementioned packages when they are updated.

* guix/profiles.scm
  (fonts-dir-file)[build]: Note why the '(null? fonts-dir)' check
  cannot be removed.
  (fonts-dir-file): When the 'relevant-inputs' list is empty,
  just build an empty directory.
---
 guix/profiles.scm | 25 ++++++++++++++++---------
 1 file changed, 16 insertions(+), 9 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0f9df68f42..6cf480ddf2 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1544,6 +1544,8 @@ files for the fonts of the @var{manifest} entries."
                                             "/share/fonts")
                                        '#$relevant-inputs))))
           (mkdir #$output)
+          ;; has-fonts? can have false positives,
+          ;; so this check is necessary.
           (if (null? fonts-dirs)
               (exit #t)
               (let* ((share-dir   (string-append #$output "/share"))
@@ -1585,15 +1587,20 @@ files for the fonts of the @var{manifest} entries."
                                   (delete-file fonts-dir-file))))
                             directories)))))))
 
-  (gexp->derivation "fonts-dir" build
-                    #:modules '((guix build utils)
-                                (guix build union)
-                                (srfi srfi-26))
-                    #:local-build? #t
-                    #:substitutable? #f
-                    #:properties
-                    `((type . profile-hook)
-                      (hook . fonts-dir))))
+  (if (null? relevant-inputs)
+      ;; Avoid depending on on "mkfontdir" and "mkfontscale" if
+      ;; they won't actually be used, to avoid building the aforementioned
+      ;; packages when they are updated.
+      (lower-object (file-union "fonts-dir" '()))
+      (gexp->derivation "fonts-dir" build
+                        #:modules '((guix build utils)
+                                    (guix build union)
+                                    (srfi srfi-26))
+                        #:local-build? #t
+                        #:substitutable? #f
+                        #:properties
+                        `((type . profile-hook)
+                          (hook . fonts-dir)))))
 
 (define (manual-database manifest)
   "Return a derivation that builds the manual page database (\"mandb\") for
-- 
2.32.0

signature.asc
Description: This is a digitally signed message part