02/03: self: Restructure accessing packages.

[guix-commits]

cbaines pushed a commit to branch master
in repository guix.

commit e5c33837cbee98d460d9ae09b463501de6f15d97
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Tue Feb 28 15:47:02 2023 +0000

    self: Restructure accessing packages.
    
    Both for consistency (always use specification->package as defined in this
    module) and so that all the packages that are used can be accessed (which
    comes in useful when applying grafts).
    
    * guix/self.scm (%packages): New variable.
    (specification->package): Use %packages.
    (locale-data, translate-texi-manuals, info-manual, guix-command,
    compiled-guix): Use specification->package.
    
    Signed-off-by: Christopher Baines <mail@cbaines.net>
---
 guix/self.scm | 97 +++++++++++++++++++++++++++++------------------------------
 1 file changed, 48 insertions(+), 49 deletions(-)

diff --git a/guix/self.scm b/guix/self.scm
index d1dcde34ac..74c953bd50 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -43,34 +43,42 @@
 ;;; Dependency handling.
 ;;;
 
-(define specification->package
+(define %packages
+  (let ((ref (lambda (module variable)
+               (delay
+                 (module-ref (resolve-interface
+                              `(gnu packages ,module))
+                             variable)))))
+    `(("guile"              . ,(ref 'guile 'guile-3.0-latest))
+      ("guile-avahi"        . ,(ref 'guile-xyz 'guile-avahi))
+      ("guile-json"         . ,(ref 'guile 'guile-json-4))
+      ("guile-ssh"          . ,(ref 'ssh   'guile-ssh))
+      ("guile-git"          . ,(ref 'guile 'guile-git))
+      ("guile-semver"       . ,(ref 'guile-xyz 'guile-semver))
+      ("guile-lib"          . ,(ref 'guile-xyz 'guile-lib))
+      ("guile-sqlite3"      . ,(ref 'guile 'guile-sqlite3))
+      ("guile-zlib"         . ,(ref 'guile 'guile-zlib))
+      ("guile-lzlib"        . ,(ref 'guile 'guile-lzlib))
+      ("guile-zstd"         . ,(ref 'guile 'guile-zstd))
+      ("guile-gcrypt"       . ,(ref 'gnupg 'guile-gcrypt))
+      ("guile-gnutls"       . ,(ref 'tls 'guile-gnutls))
+      ("guix-daemon"        . ,(ref 'package-management 'guix-daemon))
+      ("disarchive"         . ,(ref 'backup 'disarchive))
+      ("guile-lzma"         . ,(ref 'guile 'guile-lzma))
+      ("gzip"               . ,(ref 'compression 'gzip))
+      ("bzip2"              . ,(ref 'compression 'bzip2))
+      ("xz"                 . ,(ref 'compression 'xz))
+      ("po4a"               . ,(ref 'gettext 'po4a))
+      ("gettext-minimal"    . ,(ref 'gettext 'gettext-minimal))
+      ("gcc-toolchain"      . ,(ref 'commencement 'gcc-toolchain))
+      ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales))
+      ("graphviz"           . ,(ref 'graphviz 'graphviz))
+      ("texinfo"            . ,(ref 'texinfo 'texinfo)))))
+
+(define (specification->package name)
   ;; Use our own variant of that procedure because that of (gnu packages)
   ;; would traverse all the .scm files, which is wasteful.
-  (let ((ref (lambda (module variable)
-               (module-ref (resolve-interface module) variable))))
-    (match-lambda
-      ("guile"      (ref '(gnu packages guile) 'guile-3.0-latest))
-      ("guile-avahi" (ref '(gnu packages guile-xyz) 'guile-avahi))
-      ("guile-json" (ref '(gnu packages guile) 'guile-json-4))
-      ("guile-ssh"  (ref '(gnu packages ssh)   'guile-ssh))
-      ("guile-git"  (ref '(gnu packages guile) 'guile-git))
-      ("guile-semver"  (ref '(gnu packages guile-xyz) 'guile-semver))
-      ("guile-lib"  (ref '(gnu packages guile-xyz) 'guile-lib))
-      ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
-      ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
-      ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
-      ("guile-zstd" (ref '(gnu packages guile) 'guile-zstd))
-      ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
-      ("guile-gnutls"  (ref '(gnu packages tls) 'guile-gnutls))
-      ("disarchive" (ref '(gnu packages backup) 'disarchive))
-      ("guile-lzma" (ref '(gnu packages guile) 'guile-lzma))
-      ("gzip"       (ref '(gnu packages compression) 'gzip))
-      ("bzip2"      (ref '(gnu packages compression) 'bzip2))
-      ("xz"         (ref '(gnu packages compression) 'xz))
-      ("po4a"       (ref '(gnu packages gettext) 'po4a))
-      ("gettext"       (ref '(gnu packages gettext) 'gettext-minimal))
-      ("gcc-toolchain" (ref '(gnu packages commencement) 'gcc-toolchain))
-      (_            #f))))                        ;no such package
+  (and=> (assoc-ref %packages name) force))
 
 
 ;;;
@@ -239,9 +247,8 @@ record with the new file name."
                       #:optional (directory domain))
   "Return the locale data from 'po/DIRECTORY' in SOURCE, corresponding to
 DOMAIN, a gettext domain."
-  (define gettext
-    (module-ref (resolve-interface '(gnu packages gettext))
-                'gettext-minimal))
+  (define gettext-minimal
+    (specification->package "gettext-minimal"))
 
   (define build
     (with-imported-modules '((guix build utils))
@@ -257,7 +264,7 @@ DOMAIN, a gettext domain."
             (let ((gmo (string-append #$output "/" language "/LC_MESSAGES/"
                                       #$domain ".mo")))
               (mkdir-p (dirname gmo))
-              (invoke #+(file-append gettext "/bin/msgfmt")
+              (invoke #+(file-append gettext-minimal "/bin/msgfmt")
                       "-c" "--statistics" "--verbose"
                       "-o" gmo
                       (string-append po-directory "/" language ".po"))))
@@ -279,20 +286,19 @@ DOMAIN, a gettext domain."
   "Return the translated texinfo manuals built from SOURCE."
   (define po4a
     (specification->package "po4a"))
-  
-  (define gettext
-    (specification->package "gettext"))
+
+  (define gettext-minimal
+    (specification->package "gettext-minimal"))
 
   (define glibc-utf8-locales
-    (module-ref (resolve-interface '(gnu packages base))
-                'glibc-utf8-locales))
+    (specification->package "glibc-utf8-locales"))
 
   (define documentation
     (file-append* source "doc"))
 
   (define documentation-po
     (file-append* source "po/doc"))
-  
+
   (define build
     (with-imported-modules '((guix build utils) (guix build po))
       #~(begin
@@ -364,7 +370,7 @@ a list of extra files, such as '(\"contributing\")."
 
           (setenv "GUIX_LOCPATH"
                   #+(file-append glibc-utf8-locales "/lib/locale"))
-          (setenv "PATH" #+(file-append gettext "/bin"))
+          (setenv "PATH" #+(file-append gettext-minimal "/bin"))
           (setenv "LC_ALL" "en_US.UTF-8")
           (setlocale LC_ALL "en_US.UTF-8")
 
@@ -393,16 +399,13 @@ a list of extra files, such as '(\"contributing\")."
 (define (info-manual source)
   "Return the Info manual built from SOURCE."
   (define texinfo
-    (module-ref (resolve-interface '(gnu packages texinfo))
-                'texinfo))
+    (specification->package "texinfo"))
 
   (define graphviz
-    (module-ref (resolve-interface '(gnu packages graphviz))
-                'graphviz))
+    (specification->package "graphviz"))
 
   (define glibc-utf8-locales
-    (module-ref (resolve-interface '(gnu packages base))
-                'glibc-utf8-locales))
+    (specification->package "glibc-utf8-locales"))
 
   (define documentation
     (file-append* source "doc"))
@@ -585,8 +588,7 @@ instead of 'C'."
   "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
 load path."
   (define glibc-utf8-locales
-    (module-ref (resolve-interface '(gnu packages base))
-                'glibc-utf8-locales))
+    (specification->package "glibc-utf8-locales"))
 
   (define module-directory
     ;; To minimize the number of 'stat' calls needed to locate a module,
@@ -1029,10 +1031,7 @@ itself."
                           ;; Include 'guix-daemon'.  XXX: Here we inject an
                           ;; older snapshot of guix-daemon, but that's a good
                           ;; enough approximation for now.
-                          #:daemon (module-ref (resolve-interface
-                                                '(gnu packages
-                                                      package-management))
-                                               'guix-daemon)
+                          #:daemon (specification->package "guix-daemon")
 
                           #:info (info-manual source)
                           #:miscellany (miscellaneous-files source)