226 lines
7.7 KiB
Scheme
226 lines
7.7 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
|
||
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
|
||
;;;
|
||
;;; This file is part of GNU Guix.
|
||
;;;
|
||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||
;;; under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||
;;; your option) any later version.
|
||
;;;
|
||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (gnu installer locale)
|
||
#:use-module (gnu installer utils)
|
||
#:use-module (guix records)
|
||
#:use-module (json)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (ice-9 match)
|
||
#:use-module (ice-9 regex)
|
||
#:export (locale-language
|
||
locale-territory
|
||
locale-codeset
|
||
locale-modifier
|
||
|
||
locale->locale-string
|
||
supported-locales->locales
|
||
|
||
iso639->iso639-languages
|
||
language-code->language-name
|
||
|
||
iso3166->iso3166-territories
|
||
territory-code->territory-name
|
||
|
||
locale->configuration))
|
||
|
||
|
||
;;;
|
||
;;; Locale.
|
||
;;;
|
||
|
||
;; A glibc locale string has the following format:
|
||
;; language[_territory[.codeset][@modifier]].
|
||
(define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$")
|
||
|
||
;; LOCALE will be better expressed in a (guix record) that in an association
|
||
;; list. However, loading large files containing records does not scale
|
||
;; well. The same thing goes for ISO639 and ISO3166 association lists used
|
||
;; later in this module.
|
||
(define (locale-language assoc)
|
||
(assoc-ref assoc 'language))
|
||
(define (locale-territory assoc)
|
||
(assoc-ref assoc 'territory))
|
||
(define (locale-codeset assoc)
|
||
(assoc-ref assoc 'codeset))
|
||
(define (locale-modifier assoc)
|
||
(assoc-ref assoc 'modifier))
|
||
|
||
(define* (locale-string->locale string #:optional codeset)
|
||
"Return the locale association list built from the parsing of STRING and,
|
||
optionally, CODESET."
|
||
(let ((matches (string-match locale-regexp string)))
|
||
`((language . ,(match:substring matches 1))
|
||
(territory . ,(match:substring matches 3))
|
||
(codeset . ,(or codeset (match:substring matches 5)))
|
||
(modifier . ,(match:substring matches 7)))))
|
||
|
||
(define (normalize-codeset codeset)
|
||
"Compute the \"normalized\" variant of CODESET."
|
||
;; info "(libc) Using gettextized software", for the algorithm used to
|
||
;; compute the normalized codeset.
|
||
(letrec-syntax ((-> (syntax-rules ()
|
||
((_ proc value)
|
||
(proc value))
|
||
((_ proc rest ...)
|
||
(proc (-> rest ...))))))
|
||
(-> (lambda (str)
|
||
(if (string-every char-set:digit str)
|
||
(string-append "iso" str)
|
||
str))
|
||
string-downcase
|
||
(lambda (str)
|
||
(string-filter char-set:letter+digit str))
|
||
codeset)))
|
||
|
||
(define (locale->locale-string locale)
|
||
"Reverse operation of locale-string->locale."
|
||
(let ((language (locale-language locale))
|
||
(territory (locale-territory locale))
|
||
(codeset (locale-codeset locale))
|
||
(modifier (locale-modifier locale)))
|
||
(apply string-append
|
||
`(,language
|
||
,@(if territory
|
||
`("_" ,territory)
|
||
'())
|
||
,@(if codeset
|
||
`("." ,(normalize-codeset codeset))
|
||
'())
|
||
,@(if modifier
|
||
`("@" ,modifier)
|
||
'())))))
|
||
|
||
(define (supported-locales->locales supported-locales)
|
||
"Given SUPPORTED-LOCALES, a file produced by 'glibc-supported-locales',
|
||
return a list of locales where each locale is an alist."
|
||
(map (match-lambda
|
||
((locale . codeset)
|
||
(locale-string->locale locale codeset)))
|
||
(call-with-input-file supported-locales read)))
|
||
|
||
|
||
;;;
|
||
;;; Language.
|
||
;;;
|
||
|
||
(define (iso639-language-alpha2 assoc)
|
||
(assoc-ref assoc 'alpha2))
|
||
|
||
(define (iso639-language-alpha3 assoc)
|
||
(assoc-ref assoc 'alpha3))
|
||
|
||
(define (iso639-language-name assoc)
|
||
(assoc-ref assoc 'name))
|
||
|
||
(define (supported-locale? locales alpha2 alpha3)
|
||
"Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field
|
||
matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus,
|
||
if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was
|
||
found."
|
||
(find (lambda (locale)
|
||
(let ((language (locale-language locale)))
|
||
(or (and=> alpha2
|
||
(lambda (code)
|
||
(string=? language code)))
|
||
(string=? language alpha3))))
|
||
locales))
|
||
|
||
(define (iso639->iso639-languages locales iso639-3 iso639-5)
|
||
"Return a list of ISO639 association lists created from the parsing of
|
||
ISO639-3 and ISO639-5 files."
|
||
(call-with-input-file iso639-3
|
||
(lambda (port-iso639-3)
|
||
(call-with-input-file iso639-5
|
||
(lambda (port-iso639-5)
|
||
(filter-map
|
||
(lambda (hash)
|
||
(let ((alpha2 (hash-ref hash "alpha_2"))
|
||
(alpha3 (hash-ref hash "alpha_3"))
|
||
(name (hash-ref hash "name")))
|
||
(and (supported-locale? locales alpha2 alpha3)
|
||
`((alpha2 . ,alpha2)
|
||
(alpha3 . ,alpha3)
|
||
(name . ,name)))))
|
||
(append
|
||
(hash-ref (json->scm port-iso639-3) "639-3")
|
||
(hash-ref (json->scm port-iso639-5) "639-5"))))))))
|
||
|
||
(define (language-code->language-name languages language-code)
|
||
"Using LANGUAGES as a list of ISO639 association lists, return the language
|
||
name corresponding to the given LANGUAGE-CODE."
|
||
(let ((iso639-language
|
||
(find (lambda (language)
|
||
(or
|
||
(and=> (iso639-language-alpha2 language)
|
||
(lambda (alpha2)
|
||
(string=? alpha2 language-code)))
|
||
(string=? (iso639-language-alpha3 language)
|
||
language-code)))
|
||
languages)))
|
||
(iso639-language-name iso639-language)))
|
||
|
||
|
||
;;;
|
||
;;; Territory.
|
||
;;;
|
||
|
||
(define (iso3166-territory-alpha2 assoc)
|
||
(assoc-ref assoc 'alpha2))
|
||
|
||
(define (iso3166-territory-alpha3 assoc)
|
||
(assoc-ref assoc 'alpha3))
|
||
|
||
(define (iso3166-territory-name assoc)
|
||
(assoc-ref assoc 'name))
|
||
|
||
(define (iso3166->iso3166-territories iso3166)
|
||
"Return a list of ISO3166 association lists created from the parsing of
|
||
ISO3166 file."
|
||
(call-with-input-file iso3166
|
||
(lambda (port)
|
||
(map (lambda (hash)
|
||
`((alpha2 . ,(hash-ref hash "alpha_2"))
|
||
(alpha3 . ,(hash-ref hash "alpha_3"))
|
||
(name . ,(hash-ref hash "name"))))
|
||
(hash-ref (json->scm port) "3166-1")))))
|
||
|
||
(define (territory-code->territory-name territories territory-code)
|
||
"Using TERRITORIES as a list of ISO3166 association lists return the
|
||
territory name corresponding to the given TERRITORY-CODE."
|
||
(let ((iso3166-territory
|
||
(find (lambda (territory)
|
||
(or
|
||
(and=> (iso3166-territory-alpha2 territory)
|
||
(lambda (alpha2)
|
||
(string=? alpha2 territory-code)))
|
||
(string=? (iso3166-territory-alpha3 territory)
|
||
territory-code)))
|
||
territories)))
|
||
(iso3166-territory-name iso3166-territory)))
|
||
|
||
|
||
;;;
|
||
;;; Configuration formatter.
|
||
;;;
|
||
|
||
(define (locale->configuration locale)
|
||
"Return the configuration field for LOCALE."
|
||
`((locale ,locale)))
|