;;; 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.
;;;
(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)
locale-directory
%default-locale-libcs
- %default-locale-definitions))
+ %default-locale-definitions
+
+ glibc-supported-locales))
;;; Commentary:
;;;
(_
#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))
((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
"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