file-systems: Convey hint via '&fix-hint'.
[jackhill/guix/guix.git] / gnu / system / locale.scm
index 3bb9f95..689d238 100644 (file)
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 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,7 +20,7 @@
 (define-module (gnu system locale)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
+  #:use-module (guix modules)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix utils)
@@ -37,7 +38,9 @@
             locale-directory
 
             %default-locale-libcs
-            %default-locale-definitions))
+            %default-locale-definitions
+
+            glibc-supported-locales))
 
 ;;; Commentary:
 ;;;
@@ -82,59 +85,42 @@ 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."
-  (define (maybe-version-directory)
-    ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a
-    ;; version-specific sub-directory.  Check whether this is the case.
-    ;; TODO: Remove this hack once libc 2.21 is buried.
-    (let ((version (package-version libc)))
-      (if (version>=? version "2.22")
-          (list version "/")
-          '())))
-
-  #~(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 "/"
-                                     #$@(maybe-version-directory)
-                                     #$(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)
-
-        ;; XXX: For libcs < 2.22, locale data is stored in the top-level
-        ;; directory.
-        ;; TODO: Remove this hack once libc 2.21 is buried.
-        #$(if (version>=? version "2.22")
-              #~(mkdir (string-append #$output "/" #$version))
-              #~(symlink "." (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)))))
-
-  (gexp->derivation (string-append "locale-" version) build
-                    #:local-build? #t))
+    (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))
 
 (define* (locale-directory locales
                            #:key (libcs %default-locale-libcs))
@@ -148,22 +134,21 @@ data format changes between libc versions."
     ((libc)
      (single-locale-directory locales #:libc libc))
     ((libcs ..1)
-     (mlet %store-monad ((dirs (mapm %store-monad
-                                     (lambda (libc)
-                                       (single-locale-directory locales
-                                                                #:libc libc))
-                                     libcs)))
-       (gexp->derivation "locale-multiple-versions"
-                         (with-imported-modules '((guix build union))
-                           #~(begin
-                               (use-modules (guix build union))
-                               (union-build #$output (list #$@dirs))))
-                         #:local-build? #t
-                         #:substitutable? #f)))))
+     (let ((dirs (map (lambda (libc)
+                        (single-locale-directory locales #:libc libc))
+                      libcs)))
+       (computed-file "locale-multiple-versions"
+                      (with-imported-modules '((guix build union))
+                        #~(begin
+                            (use-modules (guix build union))
+                            (union-build #$output (list #$@dirs))))
+                      #:options '(#:local-build? #t
+                                  #:substitutable? #f))))))
 
 (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
@@ -219,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