self: Use a 'guile' that doesn't complain about locales.
[jackhill/guix/guix.git] / guix / self.scm
index e1350a7..bbfd2f1 100644 (file)
@@ -27,6 +27,7 @@
   #:use-module (guix packages)
   #:use-module (guix sets)
   #:use-module (guix modules)
+  #:use-module ((guix utils) #:select (version-major+minor))
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
                (module-ref (resolve-interface module) variable))))
     (match-lambda
       ("guile"      (ref '(gnu packages guile) 'guile-3.0/libgc-7))
-      ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
+      ("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-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+      ("guile-zlib" (ref '(gnu packages guile) 'guile-zlib))
+      ("guile-lzlib" (ref '(gnu packages guile) 'guile-lzlib))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
-      ("gnutls"     (ref '(gnu packages tls) 'guile3.0-gnutls))
-      ("zlib"       (ref '(gnu packages compression) 'zlib))
-      ("lzlib"      (ref '(gnu packages compression) 'lzlib))
+      ("gnutls"     (ref '(gnu packages tls) 'gnutls))
       ("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
 
 \f
@@ -580,6 +582,48 @@ that provide Guile modules."
 
   (computed-file name build))
 
+(define (quiet-guile guile)
+  "Return a wrapper that does the same as the 'guile' executable of GUILE,
+except that it does not complain about locales and falls back to 'en_US.utf8'
+instead of 'C'."
+  (define gcc
+    (specification->package "gcc-toolchain"))
+
+  (define source
+    (search-path %load-path
+                 "gnu/packages/aux-files/guile-launcher.c"))
+
+  (define effective
+    (version-major+minor (package-version guile)))
+
+  (define build
+    ;; XXX: Reuse <c-compiler> from (guix scripts pack) instead?
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils)
+                       (srfi srfi-26))
+
+          (mkdir-p (string-append #$output "/bin"))
+
+          (setenv "PATH" #$(file-append gcc "/bin"))
+          (setenv "C_INCLUDE_PATH"
+                  (string-join
+                   (map (cut string-append <> "/include")
+                        '#$(match (bag-transitive-build-inputs
+                                   (package->bag guile))
+                             (((labels packages . _) ...)
+                              (filter package? packages))))
+                   ":"))
+          (setenv "LIBRARY_PATH" #$(file-append gcc "/lib"))
+
+          (invoke "gcc" #$(local-file source) "-Wall" "-g0" "-O2"
+                  "-I" #$(file-append guile "/include/guile/" effective)
+                  "-L" #$(file-append guile "/lib")
+                  #$(string-append "-lguile-" effective)
+                  "-o" (string-append #$output "/bin/guile")))))
+
+  (computed-file "guile-wrapper" build))
+
 (define* (guix-command modules
                        #:key source (dependencies '())
                        guile (guile-version (effective-version)))
@@ -634,7 +678,9 @@ load path."
                       ;; XXX: It would be more convenient to change it to:
                       ;;   (exit (apply guix-main (command-line)))
                       (apply guix-main (command-line))))
-                #:guile guile))
+
+                ;; Use a 'guile' variant that doesn't complain about locales.
+                #:guile (quiet-guile guile)))
 
 (define (miscellaneous-files source)
   "Return data files taken from SOURCE."
@@ -647,13 +693,13 @@ load path."
                    ,(file-append* source "/etc/completion/zsh/_guix"))
                   ("share/fish/vendor_completions.d/guix.fish"
                    ,(file-append* source "/etc/completion/fish/guix.fish"))
-                  ("share/guix/berlin.guixsd.org.pub"
+                  ("share/guix/berlin.guix.gnu.org.pub"
                    ,(file-append* source
-                                  "/etc/substitutes/berlin.guixsd.org.pub"))
+                                  "/etc/substitutes/berlin.guix.gnu.org.pub"))
                   ("share/guix/ci.guix.gnu.org.pub"  ;alias
-                   ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub"))
+                   ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub"))
                   ("share/guix/ci.guix.info.pub"  ;alias
-                   ,(file-append* source "/etc/substitutes/berlin.guixsd.org.pub")))))
+                   ,(file-append* source "/etc/substitutes/berlin.guix.gnu.org.pub")))))
 
 (define* (whole-package name modules dependencies
                         #:key
@@ -727,8 +773,6 @@ Info manual."
                         (name (string-append "guix-" version))
                         (guile-version (effective-version))
                         (guile-for-build (default-guile))
-                        (zlib (specification->package "zlib"))
-                        (lzlib (specification->package "lzlib"))
                         (gzip (specification->package "gzip"))
                         (bzip2 (specification->package "bzip2"))
                         (xz (specification->package "xz"))
@@ -746,6 +790,12 @@ Info manual."
   (define guile-sqlite3
     (specification->package "guile-sqlite3"))
 
+  (define guile-zlib
+    (specification->package "guile-zlib"))
+
+  (define guile-lzlib
+    (specification->package "guile-lzlib"))
+
   (define guile-gcrypt
     (specification->package "guile-gcrypt"))
 
@@ -757,7 +807,7 @@ Info manual."
                          (cons (list "x" package)
                                (package-transitive-propagated-inputs package)))
                        (list guile-gcrypt gnutls guile-git guile-json
-                             guile-ssh guile-sqlite3))
+                             guile-ssh guile-sqlite3 guile-zlib guile-lzlib))
       (((labels packages _ ...) ...)
        packages)))
 
@@ -884,9 +934,7 @@ Info manual."
                  '()
                  #:extra-modules
                  `(((guix config)
-                    => ,(make-config.scm #:zlib zlib
-                                         #:lzlib lzlib
-                                         #:gzip gzip
+                    => ,(make-config.scm #:gzip gzip
                                          #:bzip2 bzip2
                                          #:xz xz
                                          #:package-name
@@ -983,7 +1031,7 @@ Info manual."
                                       (variables rest ...))))))
     (variables %localstatedir %storedir %sysconfdir)))
 
-(define* (make-config.scm #:key zlib lzlib gzip xz bzip2
+(define* (make-config.scm #:key gzip xz bzip2
                           (package-name "GNU Guix")
                           (package-version "0")
                           (bug-report-address "bug-guix@gnu.org")
@@ -1004,8 +1052,6 @@ Info manual."
                                %state-directory
                                %store-database-directory
                                %config-directory
-                               %libz
-                               %liblz
                                %gzip
                                %bzip2
                                %xz))
@@ -1048,15 +1094,7 @@ Info manual."
                    (define %bzip2
                      #+(and bzip2 (file-append bzip2 "/bin/bzip2")))
                    (define %xz
-                     #+(and xz (file-append xz "/bin/xz")))
-
-                   (define %libz
-                     #+(and zlib
-                            (file-append zlib "/lib/libz")))
-
-                   (define %liblz
-                     #+(and lzlib
-                            (file-append lzlib "/lib/liblz"))))
+                     #+(and xz (file-append xz "/bin/xz"))))
 
                ;; Guile 2.0 *requires* the 'define-module' to be at the
                ;; top-level or the 'toplevel-ref' in the resulting .go file are