file-systems: Convey hint via '&fix-hint'.

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

diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 75cb855..689d238 100644 (file)
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 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.
 ;;;
@@ -19,8 +20,10 @@
 (define-module (gnu system locale)
   #:use-module (guix gexp)
   #:use-module (guix store)
+  #:use-module (guix modules)
   #:use-module (guix records)
   #:use-module (guix packages)
+  #:use-module (guix utils)
   #:use-module (gnu packages base)
   #:use-module (gnu packages compression)
   #:use-module (srfi srfi-26)
@@ -35,7 +38,9 @@
             locale-directory
 
             %default-locale-libcs
-            %default-locale-definitions))
+            %default-locale-definitions
+
+            glibc-supported-locales))
 
 ;;; Commentary:
 ;;;
@@ -80,42 +85,40 @@ 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 "/"
-                                     #$(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
 another, locale data is put in a sub-directory named after the 'version' field
 of LIBC."
   (define version
-    (package-version 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))
 
@@ -144,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
@@ -200,4 +204,40 @@ data format changes between libc versions."
                         "vi_VN"
                         "zh_CN"))))
 
+\f
+;;;
+;;; Locales supported by glibc.
+;;;
+
+(define* (glibc-supported-locales #:optional (glibc glibc))
+  "Return a file-like object that contains a list of locale name/encoding
+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)
+                              (gnu build locale)))
+      #~(begin
+          (use-modules (guix build gnu-build-system)
+                       (gnu build locale)
+                       (ice-9 pretty-print))
+
+          (define unpack
+            (assq-ref %standard-phases 'unpack))
+
+
+          (setenv "PATH"
+                  (string-append #+(file-append tar "/bin") ":"
+                                 #+(file-append xz "/bin") ":"
+                                 #+(file-append gzip "/bin")))
+          (unpack #:source #+(package-source glibc))
+
+          (let ((locales (call-with-input-file "localedata/SUPPORTED"
+                           read-supported-locales)))
+            (call-with-output-file #$output
+              (lambda (port)
+                (pretty-print locales port)))))))
+
+  (computed-file "glibc-supported-locales.scm" build))
+
 ;;; locale.scm ends here