gnu/system/locale.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu system locale)
  20   #:use-module (guix gexp)
  21   #:use-module (guix store)
  22   #:use-module (guix monads)
  23   #:use-module (guix records)
  24   #:use-module (guix packages)
  25   #:use-module (guix utils)
  26   #:use-module (gnu packages base)
  27   #:use-module (gnu packages compression)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (ice-9 match)
  30   #:export (locale-definition
  31             locale-definition?
  32             locale-definition-name
  33             locale-definition-source
  34             locale-definition-charset
  35
  36             locale-name->definition
  37             locale-directory
  38
  39             %default-locale-libcs
  40             %default-locale-definitions))
  41
  42 ;;; Commentary:
  43 ;;;
  44 ;;; Locale definitions, and compilation thereof.
  45 ;;;
  46 ;;; Code:
  47
  48 (define-record-type* <locale-definition> locale-definition
  49   make-locale-definition
  50   locale-definition?
  51   (name    locale-definition-name)                ;string--e.g., "fr_FR.utf8"
  52   (source  locale-definition-source)              ;string--e.g., "fr_FR"
  53   (charset locale-definition-charset              ;string--e.g., "UTF-8"
  54            (default "UTF-8")))
  55
  56 (define %not-dot
  57   (char-set-complement (char-set #\.)))
  58
  59 (define (denormalize-codeset codeset)
  60   "Attempt to guess the \"real\" name of CODESET, a normalized codeset as
  61 defined in (info \"(libc) Using gettextized software\")."
  62   (cond ((string=? codeset "utf8")
  63          "UTF-8")
  64         ((string-prefix? "iso8859" codeset)
  65          (string-append "ISO-8859-" (string-drop codeset 7)))
  66         ((string=? codeset "eucjp")
  67          "EUC-JP")
  68         (else                                ;cross fingers, hope for the best
  69          codeset)))
  70
  71 (define (locale-name->definition name)
  72   "Return a <locale-definition> corresponding to NAME, guessing the charset,
  73 or #f on failure."
  74   (match (string-tokenize name %not-dot)
  75     ((source charset)
  76      ;; XXX: NAME is supposed to use the "normalized codeset", such as "utf8",
  77      ;; whereas the actual name used is different.  Add a special case to make
  78      ;; the right guess for UTF-8.
  79      (locale-definition (name name)
  80                         (source source)
  81                         (charset (denormalize-codeset charset))))
  82     (_
  83      #f)))
  84
  85 (define* (localedef-command locale
  86                             #:key (libc (canonical-package glibc)))
  87   "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
  88   (define (maybe-version-directory)
  89     ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a
  90     ;; version-specific sub-directory.  Check whether this is the case.
  91     ;; TODO: Remove this hack once libc 2.21 is buried.
  92     (let ((version (package-version libc)))
  93       (if (version>=? version "2.22")
  94           (list version "/")
  95           '())))
  96
  97   #~(begin
  98       (format #t "building locale '~a'...~%"
  99               #$(locale-definition-name locale))
 100       (zero? (system* (string-append #$libc "/bin/localedef")
 101                       "--no-archive" "--prefix" #$output
 102                       "-i" #$(locale-definition-source locale)
 103                       "-f" #$(locale-definition-charset locale)
 104                       (string-append #$output "/"
 105                                      #$@(maybe-version-directory)
 106                                      #$(locale-definition-name locale))))))
 107
 108 (define* (single-locale-directory locales
 109                                   #:key (libc (canonical-package glibc)))
 110   "Return a directory containing all of LOCALES for LIBC compiled.
 111
 112 Because locale data formats are incompatible when switching from one libc to
 113 another, locale data is put in a sub-directory named after the 'version' field
 114 of LIBC."
 115   (define version
 116     (package-version libc))
 117
 118   (define build
 119     #~(begin
 120         (mkdir #$output)
 121
 122         ;; XXX: For libcs < 2.22, locale data is stored in the top-level
 123         ;; directory.
 124         ;; TODO: Remove this hack once libc 2.21 is buried.
 125         #$(if (version>=? version "2.22")
 126               #~(mkdir (string-append #$output "/" #$version))
 127               #~(symlink "." (string-append #$output "/" #$version)))
 128
 129         ;; 'localedef' executes 'gzip' to access compressed locale sources.
 130         (setenv "PATH" (string-append #$gzip "/bin"))
 131
 132         (exit
 133          (and #$@(map (cut localedef-command <> #:libc libc)
 134                       locales)))))
 135
 136   (gexp->derivation (string-append "locale-" version) build
 137                     #:local-build? #t))
 138
 139 (define* (locale-directory locales
 140                            #:key (libcs %default-locale-libcs))
 141   "Return a locale directory containing all of LOCALES for each libc package
 142 listed in LIBCS.
 143
 144 It is useful to list more than one libc when willing to support
 145 already-installed packages built against a different libc since the locale
 146 data format changes between libc versions."
 147   (match libcs
 148     ((libc)
 149      (single-locale-directory locales #:libc libc))
 150     ((libcs ..1)
 151      (mlet %store-monad ((dirs (mapm %store-monad
 152                                      (lambda (libc)
 153                                        (single-locale-directory locales
 154                                                                 #:libc libc))
 155                                      libcs)))
 156        (gexp->derivation "locale-multiple-versions"
 157                          #~(begin
 158                              (use-modules (guix build union))
 159                              (union-build #$output (list #$@dirs)))
 160                          #:modules '((guix build union))
 161                          #:local-build? #t
 162                          #:substitutable? #f)))))
 163
 164 (define %default-locale-libcs
 165   ;; The libcs for which we build locales by default.
 166   (list (canonical-package glibc)))
 167
 168 (define %default-locale-definitions
 169   ;; Arbitrary set of locales that are built by default.  They are here mostly
 170   ;; to facilitate first-time use to some people, while others may have to add
 171   ;; a specific <locale-definition>.
 172   (letrec-syntax ((utf8-locale (syntax-rules ()
 173                                  ((_ name*)
 174                                   (locale-definition
 175                                    ;; Note: We choose "utf8", which is the
 176                                    ;; "normalized codeset".
 177                                    (name (string-append name* ".utf8"))
 178                                    (source name*)
 179                                    (charset "UTF-8")))))
 180                   (utf8-locales (syntax-rules ()
 181                                   ((_ name ...)
 182                                    (list (utf8-locale name) ...)))))
 183     ;; Add "en_US.UTF-8" for compatibility with Guix 0.8.
 184     (cons (locale-definition
 185            (name "en_US.UTF-8")
 186            (source "en_US")
 187            (charset "UTF-8"))
 188           (utf8-locales "ca_ES"
 189                         "cs_CZ"
 190                         "da_DK"
 191                         "de_DE"
 192                         "el_GR"
 193                         "en_AU"
 194                         "en_CA"
 195                         "en_GB"
 196                         "en_US"
 197                         "es_AR"
 198                         "es_CL"
 199                         "es_ES"
 200                         "es_MX"
 201                         "fi_FI"
 202                         "fr_BE"
 203                         "fr_CA"
 204                         "fr_CH"
 205                         "fr_FR"
 206                         "ga_IE"
 207                         "it_IT"
 208                         "ja_JP"
 209                         "ko_KR"
 210                         "nb_NO"
 211                         "nl_NL"
 212                         "pl_PL"
 213                         "pt_PT"
 214                         "ro_RO"
 215                         "ru_RU"
 216                         "sv_SE"
 217                         "tr_TR"
 218                         "uk_UA"
 219                         "vi_VN"
 220                         "zh_CN"))))
 221
 222 ;;; locale.scm ends here