gnu: glibc-locales: Install symlinks using the normalized codeset.

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.

diff --git a/gnu/build/locale.scm b/gnu/build/locale.scm
index c75a2e9..412759a 100644 (file)
--- 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 a941a8f..15f3500 100644 (file)
--- 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)