guix: system: Add `--label' option.

[jackhill/guix/guix.git] / gnu / system / locale.scm

diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 533a45e..689d238 100644 (file)
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -85,22 +85,8 @@ 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)))
+                                  #:key (libc glibc))
   "Return a directory containing all of LOCALES for LIBC compiled.
 
 Because locale data formats are incompatible when switching from one libc to
@@ -110,17 +96,29 @@ of LIBC."
     (version-major+minor (package-version libc)))
 
   (define build
-    #~(begin
-        (mkdir #$output)
-
-        (mkdir (string-append #$output "/" #$version))
-
-        ;; 'localedef' executes 'gzip' to access compressed locale sources.
-        (setenv "PATH" (string-append #$gzip "/bin"))
-
-        (exit
-         (and #$@(map (cut localedef-command <> #:libc libc)
-                      locales)))))
+    (with-imported-modules (source-module-closure
+                            '((gnu build locale)))
+     #~(begin
+         (use-modules (gnu build locale))
+
+         (mkdir #$output)
+         (mkdir (string-append #$output "/" #$version))
+
+         ;; 'localedef' executes 'gzip' to access compressed locale sources.
+         (setenv "PATH"
+                 (string-append #+gzip "/bin:" #+libc "/bin"))
+
+         (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))
 
@@ -149,7 +147,8 @@ data format changes between libc versions."
 
 (define %default-locale-libcs
   ;; The libcs for which we build locales by default.
-  (list (canonical-package glibc)))
+  ;; List the previous and current libc to ease transition.
+  (list glibc-2.29 glibc))
 
 (define %default-locale-definitions
   ;; Arbitrary set of locales that are built by default.  They are here mostly
@@ -216,45 +215,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") ":"