gnu/system/locale.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu system locale)
  21   #:use-module (guix gexp)
  22   #:use-module (guix store)
  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   #~(begin
  89       (format #t "building locale '~a'...~%"
  90               #$(locale-definition-name locale))
  91       (zero? (system* (string-append #+libc "/bin/localedef")
  92                       "--no-archive" "--prefix" #$output
  93                       "-i" #$(locale-definition-source locale)
  94                       "-f" #$(locale-definition-charset locale)
  95                       (string-append #$output "/" #$(version-major+minor
  96                                                      (package-version libc))
  97                                      "/" #$(locale-definition-name locale))))))
  98
  99 (define* (single-locale-directory locales
 100                                   #:key (libc (canonical-package glibc)))
 101   "Return a directory containing all of LOCALES for LIBC compiled.
 102
 103 Because locale data formats are incompatible when switching from one libc to
 104 another, locale data is put in a sub-directory named after the 'version' field
 105 of LIBC."
 106   (define version
 107     (version-major+minor (package-version libc)))
 108
 109   (define build
 110     #~(begin
 111         (mkdir #$output)
 112
 113         (mkdir (string-append #$output "/" #$version))
 114
 115         ;; 'localedef' executes 'gzip' to access compressed locale sources.
 116         (setenv "PATH" (string-append #$gzip "/bin"))
 117
 118         (exit
 119          (and #$@(map (cut localedef-command <> #:libc libc)
 120                       locales)))))
 121
 122   (computed-file (string-append "locale-" version) build))
 123
 124 (define* (locale-directory locales
 125                            #:key (libcs %default-locale-libcs))
 126   "Return a locale directory containing all of LOCALES for each libc package
 127 listed in LIBCS.
 128
 129 It is useful to list more than one libc when willing to support
 130 already-installed packages built against a different libc since the locale
 131 data format changes between libc versions."
 132   (match libcs
 133     ((libc)
 134      (single-locale-directory locales #:libc libc))
 135     ((libcs ..1)
 136      (let ((dirs (map (lambda (libc)
 137                         (single-locale-directory locales #:libc libc))
 138                       libcs)))
 139        (computed-file "locale-multiple-versions"
 140                       (with-imported-modules '((guix build union))
 141                         #~(begin
 142                             (use-modules (guix build union))
 143                             (union-build #$output (list #$@dirs))))
 144                       #:options '(#:local-build? #t
 145                                   #:substitutable? #f))))))
 146
 147 (define %default-locale-libcs
 148   ;; The libcs for which we build locales by default.
 149   (list (canonical-package glibc)))
 150
 151 (define %default-locale-definitions
 152   ;; Arbitrary set of locales that are built by default.  They are here mostly
 153   ;; to facilitate first-time use to some people, while others may have to add
 154   ;; a specific <locale-definition>.
 155   (letrec-syntax ((utf8-locale (syntax-rules ()
 156                                  ((_ name*)
 157                                   (locale-definition
 158                                    ;; Note: We choose "utf8", which is the
 159                                    ;; "normalized codeset".
 160                                    (name (string-append name* ".utf8"))
 161                                    (source name*)
 162                                    (charset "UTF-8")))))
 163                   (utf8-locales (syntax-rules ()
 164                                   ((_ name ...)
 165                                    (list (utf8-locale name) ...)))))
 166     ;; Add "en_US.UTF-8" for compatibility with Guix 0.8.
 167     (cons (locale-definition
 168            (name "en_US.UTF-8")
 169            (source "en_US")
 170            (charset "UTF-8"))
 171           (utf8-locales "ca_ES"
 172                         "cs_CZ"
 173                         "da_DK"
 174                         "de_DE"
 175                         "el_GR"
 176                         "en_AU"
 177                         "en_CA"
 178                         "en_GB"
 179                         "en_US"
 180                         "es_AR"
 181                         "es_CL"
 182                         "es_ES"
 183                         "es_MX"
 184                         "fi_FI"
 185                         "fr_BE"
 186                         "fr_CA"
 187                         "fr_CH"
 188                         "fr_FR"
 189                         "ga_IE"
 190                         "it_IT"
 191                         "ja_JP"
 192                         "ko_KR"
 193                         "nb_NO"
 194                         "nl_NL"
 195                         "pl_PL"
 196                         "pt_PT"
 197                         "ro_RO"
 198                         "ru_RU"
 199                         "sv_SE"
 200                         "tr_TR"
 201                         "uk_UA"
 202                         "vi_VN"
 203                         "zh_CN"))))
 204
 205 ;;; locale.scm ends here