Subject: [PATCH 1/2] Add (gnu build locale).

From: Ludovic Courtès <[email-masked]>
Date: Thu, 6 Jun 2019 16:59:26 +0200

* 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 <[email-masked]>
+;;;
+;;; 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