Commit | Line | Data |
---|---|---|
d0f3a672 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |
cbd01cff | 3 | ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> |
d0f3a672 MO |
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 installer locale) | |
21 | #:use-module (gnu installer utils) | |
15ec93a7 | 22 | #:use-module ((gnu build locale) #:select (normalize-codeset)) |
d0f3a672 MO |
23 | #:use-module (guix records) |
24 | #:use-module (json) | |
25 | #:use-module (srfi srfi-1) | |
26 | #:use-module (ice-9 match) | |
27 | #:use-module (ice-9 regex) | |
28 | #:export (locale-language | |
29 | locale-territory | |
30 | locale-codeset | |
31 | locale-modifier | |
32 | ||
33 | locale->locale-string | |
34 | supported-locales->locales | |
35 | ||
36 | iso639->iso639-languages | |
37 | language-code->language-name | |
38 | ||
39 | iso3166->iso3166-territories | |
dc5f3275 MO |
40 | territory-code->territory-name |
41 | ||
42 | locale->configuration)) | |
d0f3a672 MO |
43 | |
44 | \f | |
45 | ;;; | |
46 | ;;; Locale. | |
47 | ;;; | |
48 | ||
49 | ;; A glibc locale string has the following format: | |
50 | ;; language[_territory[.codeset][@modifier]]. | |
51 | (define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$") | |
52 | ||
53 | ;; LOCALE will be better expressed in a (guix record) that in an association | |
54 | ;; list. However, loading large files containing records does not scale | |
55 | ;; well. The same thing goes for ISO639 and ISO3166 association lists used | |
56 | ;; later in this module. | |
57 | (define (locale-language assoc) | |
58 | (assoc-ref assoc 'language)) | |
59 | (define (locale-territory assoc) | |
60 | (assoc-ref assoc 'territory)) | |
61 | (define (locale-codeset assoc) | |
62 | (assoc-ref assoc 'codeset)) | |
63 | (define (locale-modifier assoc) | |
64 | (assoc-ref assoc 'modifier)) | |
65 | ||
76269f6b LC |
66 | (define* (locale-string->locale string #:optional codeset) |
67 | "Return the locale association list built from the parsing of STRING and, | |
68 | optionally, CODESET." | |
d0f3a672 MO |
69 | (let ((matches (string-match locale-regexp string))) |
70 | `((language . ,(match:substring matches 1)) | |
71 | (territory . ,(match:substring matches 3)) | |
76269f6b | 72 | (codeset . ,(or codeset (match:substring matches 5))) |
d0f3a672 MO |
73 | (modifier . ,(match:substring matches 7))))) |
74 | ||
75 | (define (locale->locale-string locale) | |
76 | "Reverse operation of locale-string->locale." | |
77 | (let ((language (locale-language locale)) | |
78 | (territory (locale-territory locale)) | |
79 | (codeset (locale-codeset locale)) | |
80 | (modifier (locale-modifier locale))) | |
81 | (apply string-append | |
82 | `(,language | |
83 | ,@(if territory | |
84 | `("_" ,territory) | |
85 | '()) | |
86 | ,@(if codeset | |
cbd01cff | 87 | `("." ,(normalize-codeset codeset)) |
d0f3a672 MO |
88 | '()) |
89 | ,@(if modifier | |
90 | `("@" ,modifier) | |
91 | '()))))) | |
92 | ||
93 | (define (supported-locales->locales supported-locales) | |
76269f6b LC |
94 | "Given SUPPORTED-LOCALES, a file produced by 'glibc-supported-locales', |
95 | return a list of locales where each locale is an alist." | |
96 | (map (match-lambda | |
97 | ((locale . codeset) | |
98 | (locale-string->locale locale codeset))) | |
99 | (call-with-input-file supported-locales read))) | |
d0f3a672 MO |
100 | |
101 | \f | |
102 | ;;; | |
103 | ;;; Language. | |
104 | ;;; | |
105 | ||
106 | (define (iso639-language-alpha2 assoc) | |
107 | (assoc-ref assoc 'alpha2)) | |
108 | ||
109 | (define (iso639-language-alpha3 assoc) | |
110 | (assoc-ref assoc 'alpha3)) | |
111 | ||
112 | (define (iso639-language-name assoc) | |
113 | (assoc-ref assoc 'name)) | |
114 | ||
115 | (define (supported-locale? locales alpha2 alpha3) | |
116 | "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field | |
117 | matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus, | |
118 | if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was | |
119 | found." | |
120 | (find (lambda (locale) | |
121 | (let ((language (locale-language locale))) | |
122 | (or (and=> alpha2 | |
123 | (lambda (code) | |
124 | (string=? language code))) | |
125 | (string=? language alpha3)))) | |
126 | locales)) | |
127 | ||
128 | (define (iso639->iso639-languages locales iso639-3 iso639-5) | |
129 | "Return a list of ISO639 association lists created from the parsing of | |
130 | ISO639-3 and ISO639-5 files." | |
131 | (call-with-input-file iso639-3 | |
132 | (lambda (port-iso639-3) | |
133 | (call-with-input-file iso639-5 | |
134 | (lambda (port-iso639-5) | |
135 | (filter-map | |
136 | (lambda (hash) | |
81c3dc32 LC |
137 | (let ((alpha2 (assoc-ref hash "alpha_2")) |
138 | (alpha3 (assoc-ref hash "alpha_3")) | |
139 | (name (assoc-ref hash "name"))) | |
d0f3a672 MO |
140 | (and (supported-locale? locales alpha2 alpha3) |
141 | `((alpha2 . ,alpha2) | |
142 | (alpha3 . ,alpha3) | |
143 | (name . ,name))))) | |
144 | (append | |
81c3dc32 LC |
145 | (vector->list |
146 | (assoc-ref (json->scm port-iso639-3) "639-3")) | |
147 | (vector->list | |
148 | (assoc-ref (json->scm port-iso639-5) "639-5"))))))))) | |
d0f3a672 MO |
149 | |
150 | (define (language-code->language-name languages language-code) | |
151 | "Using LANGUAGES as a list of ISO639 association lists, return the language | |
152 | name corresponding to the given LANGUAGE-CODE." | |
153 | (let ((iso639-language | |
154 | (find (lambda (language) | |
155 | (or | |
156 | (and=> (iso639-language-alpha2 language) | |
157 | (lambda (alpha2) | |
158 | (string=? alpha2 language-code))) | |
159 | (string=? (iso639-language-alpha3 language) | |
160 | language-code))) | |
161 | languages))) | |
162 | (iso639-language-name iso639-language))) | |
163 | ||
164 | \f | |
165 | ;;; | |
166 | ;;; Territory. | |
167 | ;;; | |
168 | ||
169 | (define (iso3166-territory-alpha2 assoc) | |
170 | (assoc-ref assoc 'alpha2)) | |
171 | ||
172 | (define (iso3166-territory-alpha3 assoc) | |
173 | (assoc-ref assoc 'alpha3)) | |
174 | ||
175 | (define (iso3166-territory-name assoc) | |
176 | (assoc-ref assoc 'name)) | |
177 | ||
178 | (define (iso3166->iso3166-territories iso3166) | |
179 | "Return a list of ISO3166 association lists created from the parsing of | |
180 | ISO3166 file." | |
181 | (call-with-input-file iso3166 | |
182 | (lambda (port) | |
183 | (map (lambda (hash) | |
81c3dc32 LC |
184 | `((alpha2 . ,(assoc-ref hash "alpha_2")) |
185 | (alpha3 . ,(assoc-ref hash "alpha_3")) | |
186 | (name . ,(assoc-ref hash "name")))) | |
187 | (vector->list | |
188 | (assoc-ref (json->scm port) "3166-1")))))) | |
d0f3a672 MO |
189 | |
190 | (define (territory-code->territory-name territories territory-code) | |
191 | "Using TERRITORIES as a list of ISO3166 association lists return the | |
192 | territory name corresponding to the given TERRITORY-CODE." | |
193 | (let ((iso3166-territory | |
194 | (find (lambda (territory) | |
195 | (or | |
196 | (and=> (iso3166-territory-alpha2 territory) | |
197 | (lambda (alpha2) | |
198 | (string=? alpha2 territory-code))) | |
199 | (string=? (iso3166-territory-alpha3 territory) | |
200 | territory-code))) | |
201 | territories))) | |
202 | (iso3166-territory-name iso3166-territory))) | |
dc5f3275 MO |
203 | |
204 | \f | |
205 | ;;; | |
206 | ;;; Configuration formatter. | |
207 | ;;; | |
208 | ||
209 | (define (locale->configuration locale) | |
210 | "Return the configuration field for LOCALE." | |
211 | `((locale ,locale))) |