[bug#36116] [PATCH 0/2] Add (gnu build locale), and fix 'glib-locales'

[bug#36116] [PATCH 0/2] Add (gnu build locale), and fix 'glib-locales'

[Ludovic Courtès]

Hello,

The first patch here factorizes common locale-related code in
(gnu build locale).  Eventually we can probably use it in
‘glibc-utf8-locales’.

The second patch adds symlinks for “en_US.utf8” etc., which were
missing from ‘glibc-locales’, as reported at
<https://issues.guix.gnu.org/issue/36076>.

Thanks,
Ludo’.

Ludovic Courtès (2):
  Add (gnu build locale).
  gnu: glibc-locales: Install symlinks using the normalized codeset.

 gnu/build/locale.scm     | 95 ++++++++++++++++++++++++++++++++++++++++
 gnu/installer/locale.scm | 19 +-------
 gnu/local.mk             |  1 +
 gnu/packages/base.scm    | 37 +++++++++++++++-
 gnu/system/locale.scm    | 77 ++++++++++----------------------
 5 files changed, 156 insertions(+), 73 deletions(-)
 create mode 100644 gnu/build/locale.scm

-- 
2.21.0

[bug#36116] [PATCH 1/2] Add (gnu build locale).

[Ludovic Courtès]

* gnu/build/locale.scm: New file.
* gnu/local.mk (MODULES_NOT_COMPILED): Add it.
* gnu/installer/locale.scm (normalize-codeset): Remove.
* gnu/system/locale.scm (localedef-command): Remove.
(single-locale-directory): Use (gnu build locale).
(glibc-supported-locales)[build]: Likewise, and remove
'read-supported-locales'.
---
 gnu/build/locale.scm     | 86 ++++++++++++++++++++++++++++++++++++++++
 gnu/installer/locale.scm | 19 +--------
 gnu/local.mk             |  1 +
 gnu/system/locale.scm    | 77 +++++++++++------------------------
 4 files changed, 111 insertions(+), 72 deletions(-)
 create mode 100644 gnu/build/locale.scm

diff --git a/gnu/build/locale.scm b/gnu/build/locale.scm
new file mode 100644
index 0000000000..c75a2e9dc5
--- /dev/null
+++ b/gnu/build/locale.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 build locale)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (build-locale
+            normalize-codeset
+            read-supported-locales))
+
+(define locale-rx
+  ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
+  (make-regexp
+   "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
+
+(define (read-supported-locales port)
+  "Read the 'localedata/SUPPORTED' file from PORT.  That file is actually a
+makefile snippet, with one locale per line, and a header that can be
+discarded."
+  (let loop ((locales '()))
+    (define line
+      (read-line port))
+
+    (cond ((eof-object? line)
+           (reverse locales))
+          ((string-prefix? "#" (string-trim line)) ;comment
+           (loop locales))
+          ((string-contains line "=")            ;makefile variable assignment
+           (loop locales))
+          (else
+           (match (regexp-exec locale-rx line)
+             (#f
+              (loop locales))
+             (m
+              (loop (alist-cons (match:substring m 1)
+                                (match:substring m 2)
+                                locales))))))))
+
+(define (normalize-codeset codeset)
+  "Compute the \"normalized\" variant of CODESET."
+  ;; info "(libc) Using gettextized software", for the algorithm used to
+  ;; compute the normalized codeset.
+  (letrec-syntax ((-> (syntax-rules ()
+                        ((_ proc value)
+                         (proc value))
+                        ((_ proc rest ...)
+                         (proc (-> rest ...))))))
+    (-> (lambda (str)
+          (if (string-every char-set:digit str)
+              (string-append "iso" str)
+              str))
+        string-downcase
+        (lambda (str)
+          (string-filter char-set:letter+digit str))
+        codeset)))
+
+(define* (build-locale locale
+                       #:key
+                       (localedef "localedef")
+                       (directory ".")
+                       (codeset "UTF-8")
+                       (name (string-append locale "." codeset)))
+  "Compute locale data for LOCALE and CODESET--e.g., \"en_US\" and
+\"UTF-8\"--with LOCALEDEF, and store it in DIRECTORY under NAME."
+  (format #t "building locale '~a'...~%" name)
+  (invoke localedef "--no-archive" "--prefix" directory
+          "-i" locale "-f" codeset
+          (string-append directory "/" name)))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 2ee5eecd96..13f3a1e881 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -19,6 +19,7 @@
 
 (define-module (gnu installer locale)
   #:use-module (gnu installer utils)
+  #:use-module ((gnu build locale) #:select (normalize-codeset))
   #:use-module (guix records)
   #:use-module (json)
   #:use-module (srfi srfi-1)
@@ -71,24 +72,6 @@ optionally, CODESET."
       (codeset   . ,(or codeset (match:substring matches 5)))
       (modifier  . ,(match:substring matches 7)))))
 
-(define (normalize-codeset codeset)
-  "Compute the \"normalized\" variant of CODESET."
-  ;; info "(libc) Using gettextized software", for the algorithm used to
-  ;; compute the normalized codeset.
-  (letrec-syntax ((-> (syntax-rules ()
-                        ((_ proc value)
-                         (proc value))
-                        ((_ proc rest ...)
-                         (proc (-> rest ...))))))
-    (-> (lambda (str)
-          (if (string-every char-set:digit str)
-              (string-append "iso" str)
-              str))
-        string-downcase
-        (lambda (str)
-          (string-filter char-set:letter+digit str))
-        codeset)))
-
 (define (locale->locale-string locale)
   "Reverse operation of locale-string->locale."
   (let ((language (locale-language locale))
diff --git a/gnu/local.mk b/gnu/local.mk
index 6878aef44a..03ea8f94b0 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -637,6 +637,7 @@ dist_installer_DATA =				\
 
 # Modules that do not need to be compiled.
 MODULES_NOT_COMPILED +=				\
+  %D%/build/locale.scm				\
   %D%/build/shepherd.scm			\
   %D%/build/svg.scm
 
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 533a45e149..8466d5b07d 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -85,20 +85,6 @@ or #f on failure."
     (_
      #f)))
 
-(define* (localedef-command locale
-                            #:key (libc (canonical-package glibc)))
-  "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
-  #~(begin
-      (format #t "building locale '~a'...~%"
-              #$(locale-definition-name locale))
-      (zero? (system* (string-append #+libc "/bin/localedef")
-                      "--no-archive" "--prefix" #$output
-                      "-i" #$(locale-definition-source locale)
-                      "-f" #$(locale-definition-charset locale)
-                      (string-append #$output "/" #$(version-major+minor
-                                                     (package-version libc))
-                                     "/" #$(locale-definition-name locale))))))
-
 (define* (single-locale-directory locales
                                   #:key (libc (canonical-package glibc)))
   "Return a directory containing all of LOCALES for LIBC compiled.
@@ -110,17 +96,29 @@ of LIBC."
     (version-major+minor (package-version libc)))
 
   (define build
-    #~(begin
-        (mkdir #$output)
+    (with-imported-modules (source-module-closure
+                            '((gnu build locale)))
+     #~(begin
+         (use-modules (gnu build locale))
 
-        (mkdir (string-append #$output "/" #$version))
+         (mkdir #$output)
+         (mkdir (string-append #$output "/" #$version))
 
-        ;; 'localedef' executes 'gzip' to access compressed locale sources.
-        (setenv "PATH" (string-append #$gzip "/bin"))
+         ;; 'localedef' executes 'gzip' to access compressed locale sources.
+         (setenv "PATH"
+                 (string-append #$gzip "/bin:" #$libc "/bin"))
 
-        (exit
-         (and #$@(map (cut localedef-command <> #:libc libc)
-                      locales)))))
+         (setvbuf (current-output-port) 'line)
+         (setvbuf (current-error-port) 'line)
+         (for-each (lambda (locale codeset name)
+                     (build-locale locale
+                                   #:codeset codeset
+                                   #:name name
+                                   #:directory
+                                   (string-append #$output "/" #$version)))
+                   '#$(map locale-definition-source locales)
+                   '#$(map locale-definition-charset locales)
+                   '#$(map locale-definition-name locales)))))
 
   (computed-file (string-append "locale-" version) build))
 
@@ -216,45 +214,16 @@ pairs such as (\"oc_FR.UTF-8\" . \"UTF-8\").  Each pair corresponds to a
 locale supported by GLIBC."
   (define build
     (with-imported-modules (source-module-closure
-                            '((guix build gnu-build-system)))
+                            '((guix build gnu-build-system)
+                              (gnu build locale)))
       #~(begin
           (use-modules (guix build gnu-build-system)
-                       (srfi srfi-1)
-                       (ice-9 rdelim)
-                       (ice-9 match)
-                       (ice-9 regex)
+                       (gnu build locale)
                        (ice-9 pretty-print))
 
           (define unpack
             (assq-ref %standard-phases 'unpack))
 
-          (define locale-rx
-            ;; Regexp matching a locale line in 'localedata/SUPPORTED'.
-            (make-regexp
-             "^[[:space:]]*([[:graph:]]+)/([[:graph:]]+)[[:space:]]*\\\\$"))
-
-          (define (read-supported-locales port)
-            ;; Read the 'localedata/SUPPORTED' file from PORT.  That file is
-            ;; actually a makefile snippet, with one locale per line, and a
-            ;; header that can be discarded.
-            (let loop ((locales '()))
-              (define line
-                (read-line port))
-
-              (cond ((eof-object? line)
-                     (reverse locales))
-                    ((string-prefix? "#" (string-trim line)) ;comment
-                     (loop locales))
-                    ((string-contains line "=")  ;makefile variable assignment
-                     (loop locales))
-                    (else
-                     (match (regexp-exec locale-rx line)
-                       (#f
-                        (loop locales))
-                       (m
-                        (loop (alist-cons (match:substring m 1)
-                                          (match:substring m 2)
-                                          locales))))))))
 
           (setenv "PATH"
                   (string-append #+(file-append tar "/bin") ":"
-- 
2.21.0

[bug#36116] [PATCH 2/2] gnu: glibc-locales: Install symlinks using the normalized codeset.

[Ludovic Courtès]

Fixes <https://bugs.gnu.org/36076>.
Reported by Jack Hill <jackhill@jackhill.us>
and Giovanni Biscuolo <g@xelera.eu>

* gnu/build/locale.scm (locale->name+codeset): New file.
* gnu/packages/base.scm (make-glibc-locales): Add #:modules
and #:imported-modules.  Add a 'symlink-normalized-codesets' phase.
---
 gnu/build/locale.scm  |  9 +++++++++
 gnu/packages/base.scm | 37 ++++++++++++++++++++++++++++++++++++-
 2 files changed, 45 insertions(+), 1 deletion(-)

diff --git a/gnu/build/locale.scm b/gnu/build/locale.scm
index c75a2e9dc5..412759a320 100644
--- a/gnu/build/locale.scm
+++ b/gnu/build/locale.scm
@@ -24,6 +24,7 @@
   #:use-module (ice-9 regex)
   #:export (build-locale
             normalize-codeset
+            locale->name+codeset
             read-supported-locales))
 
 (define locale-rx
@@ -84,3 +85,11 @@ discarded."
   (invoke localedef "--no-archive" "--prefix" directory
           "-i" locale "-f" codeset
           (string-append directory "/" name)))
+
+(define (locale->name+codeset locale)
+  "Split a locale name such as \"aa_ER@saaho.UTF-8\" into two values: the
+language/territory/modifier part, and the codeset."
+  (match (string-rindex locale #\.)
+    (#f  (values locale #f))
+    (dot (values (string-take locale dot)
+                 (string-drop locale (+ dot 1))))))
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index a941a8f8eb..15f35009a9 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2019 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014, 2015, 2016, 2018 Mark H Weaver <mhw@netris.org>
@@ -1050,12 +1050,47 @@ to the @code{share/locale} sub-directory of this package.")
      (let ((args `(#:tests? #f #:strip-binaries? #f
                    ,@(package-arguments glibc))))
        (substitute-keyword-arguments args
+         ((#:modules modules '((guix build utils)
+                               (guix build gnu-build-system)))
+          `((srfi srfi-11)
+            (gnu build locale)
+            ,@modules))
+         ((#:imported-modules modules '())
+          `((gnu build locale)
+            ,@%gnu-build-system-modules))
          ((#:phases phases)
           `(modify-phases ,phases
              (replace 'build
                (lambda _
                  (invoke "make" "localedata/install-locales"
                          "-j" (number->string (parallel-job-count)))))
+             (add-after 'build 'symlink-normalized-codesets
+               (lambda* (#:key outputs #:allow-other-keys)
+                 ;; The above phase does not install locales with names using
+                 ;; the "normalized codeset."  Thus, create symlinks like:
+                 ;;   en_US.utf8 -> en_US.UTF-8
+                 (define (locale-directory? file stat)
+                   (and (file-is-directory? file)
+                        (string-index (basename file) #\_)
+                        (string-rindex (basename file) #\.)))
+
+                 (let* ((out (assoc-ref outputs "out"))
+                        (locales (find-files out locale-directory?
+                                             #:directories? #t)))
+                   (for-each (lambda (directory)
+                               (let*-values (((base)
+                                              (basename directory))
+                                             ((name codeset)
+                                              (locale->name+codeset base))
+                                             ((normalized)
+                                              (normalize-codeset codeset)))
+                                 (unless (string=? codeset normalized)
+                                   (symlink base
+                                            (string-append (dirname directory)
+                                                           "/" name "."
+                                                           normalized)))))
+                             locales)
+                   #t)))
              (delete 'install)
              (delete 'move-static-libs)))
          ((#:configure-flags flags)
-- 
2.21.0

bug#36116: [PATCH 0/2] Add (gnu build locale), and fix 'glib-locales'

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

>   Add (gnu build locale).
>   gnu: glibc-locales: Install symlinks using the normalized codeset.

Pushed as 0e6cee21a48294b81a5e57e00602728fe7f7075f.

Ludo'.