gnu/system/locale.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015 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-directory
  37
  38             %default-locale-libcs
  39             %default-locale-definitions))
  40
  41 ;;; Commentary:
  42 ;;;
  43 ;;; Locale definitions, and compilation thereof.
  44 ;;;
  45 ;;; Code:
  46
  47 (define-record-type* <locale-definition> locale-definition
  48   make-locale-definition
  49   locale-definition?
  50   (name    locale-definition-name)                ;string--e.g., "fr_FR.utf8"
  51   (source  locale-definition-source)              ;string--e.g., "fr_FR"
  52   (charset locale-definition-charset              ;string--e.g., "UTF-8"
  53            (default "UTF-8")))
  54
  55 (define* (localedef-command locale
  56                             #:key (libc (canonical-package glibc)))
  57   "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
  58   (define (maybe-version-directory)
  59     ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a
  60     ;; version-specific sub-directory.  Check whether this is the case.
  61     ;; TODO: Remove this hack once libc 2.21 is buried.
  62     (let ((version (package-version libc)))
  63       (if (version>=? version "2.22")
  64           (list version "/")
  65           '())))
  66
  67   #~(begin
  68       (format #t "building locale '~a'...~%"
  69               #$(locale-definition-name locale))
  70       (zero? (system* (string-append #$libc "/bin/localedef")
  71                       "--no-archive" "--prefix" #$output
  72                       "-i" #$(locale-definition-source locale)
  73                       "-f" #$(locale-definition-charset locale)
  74                       (string-append #$output "/"
  75                                      #$@(maybe-version-directory)
  76                                      #$(locale-definition-name locale))))))
  77
  78 (define* (single-locale-directory locales
  79                                   #:key (libc (canonical-package glibc)))
  80   "Return a directory containing all of LOCALES for LIBC compiled.
  81
  82 Because locale data formats are incompatible when switching from one libc to
  83 another, locale data is put in a sub-directory named after the 'version' field
  84 of LIBC."
  85   (define version
  86     (package-version libc))
  87
  88   (define build
  89     #~(begin
  90         (mkdir #$output)
  91
  92         ;; XXX: For libcs < 2.22, locale data is stored in the top-level
  93         ;; directory.
  94         ;; TODO: Remove this hack once libc 2.21 is buried.
  95         #$(if (version>=? version "2.22")
  96               #~(mkdir (string-append #$output "/" #$version))
  97               #~(symlink "." (string-append #$output "/" #$version)))
  98
  99         ;; 'localedef' executes 'gzip' to access compressed locale sources.
 100         (setenv "PATH" (string-append #$gzip "/bin"))
 101
 102         (exit
 103          (and #$@(map (cut localedef-command <> #:libc libc)
 104                       locales)))))
 105
 106   (gexp->derivation (string-append "locale-" version) build
 107                     #:local-build? #t))
 108
 109 (define* (locale-directory locales
 110                            #:key (libcs %default-locale-libcs))
 111   "Return a locale directory containing all of LOCALES for each libc package
 112 listed in LIBCS.
 113
 114 It is useful to list more than one libc when willing to support
 115 already-installed packages built against a different libc since the locale
 116 data format changes between libc versions."
 117   (match libcs
 118     ((libc)
 119      (single-locale-directory locales #:libc libc))
 120     ((libcs ..1)
 121      (mlet %store-monad ((dirs (mapm %store-monad
 122                                      (lambda (libc)
 123                                        (single-locale-directory locales
 124                                                                 #:libc libc))
 125                                      libcs)))
 126        (gexp->derivation "locale-multiple-versions"
 127                          #~(begin
 128                              (use-modules (guix build union))
 129                              (union-build #$output (list #$@dirs)))
 130                          #:modules '((guix build union))
 131                          #:local-build? #t
 132                          #:substitutable? #f)))))
 133
 134 (define %default-locale-libcs
 135   ;; The libcs for which we build locales by default.
 136   (list (canonical-package glibc)))
 137
 138 (define %default-locale-definitions
 139   ;; Arbitrary set of locales that are built by default.  They are here mostly
 140   ;; to facilitate first-time use to some people, while others may have to add
 141   ;; a specific <locale-definition>.
 142   (letrec-syntax ((utf8-locale (syntax-rules ()
 143                                  ((_ name*)
 144                                   (locale-definition
 145                                    ;; Note: We choose "utf8", which is the
 146                                    ;; "normalized codeset".
 147                                    (name (string-append name* ".utf8"))
 148                                    (source name*)
 149                                    (charset "UTF-8")))))
 150                   (utf8-locales (syntax-rules ()
 151                                   ((_ name ...)
 152                                    (list (utf8-locale name) ...)))))
 153     ;; Add "en_US.UTF-8" for compatibility with Guix 0.8.
 154     (cons (locale-definition
 155            (name "en_US.UTF-8")
 156            (source "en_US")
 157            (charset "UTF-8"))
 158           (utf8-locales "ca_ES"
 159                         "cs_CZ"
 160                         "da_DK"
 161                         "de_DE"
 162                         "el_GR"
 163                         "en_AU"
 164                         "en_CA"
 165                         "en_GB"
 166                         "en_US"
 167                         "es_AR"
 168                         "es_CL"
 169                         "es_ES"
 170                         "es_MX"
 171                         "fi_FI"
 172                         "fr_BE"
 173                         "fr_CA"
 174                         "fr_CH"
 175                         "fr_FR"
 176                         "ga_IE"
 177                         "it_IT"
 178                         "ja_JP"
 179                         "ko_KR"
 180                         "nb_NO"
 181                         "nl_NL"
 182                         "pl_PL"
 183                         "pt_PT"
 184                         "ro_RO"
 185                         "ru_RU"
 186                         "sv_SE"
 187                         "tr_TR"
 188                         "uk_UA"
 189                         "vi_VN"
 190                         "zh_CN"))))
 191
 192 ;;; locale.scm ends here