projects/guix·blob python-team · refs

212 lines · 7.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Mathieu Othacehe <[email protected]>
3;;; Copyright © 2019 Ludovic Courtès <[email protected]>
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)
22 #:use-module ((gnu build locale) #:select (normalize-codeset))
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
40 territory-code->territory-name
41
42 locale->configuration))
43
44
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
66(define* (locale-string->locale string #:optional codeset)
67 "Return the locale association list built from the parsing of STRING and,
68optionally, CODESET."
69 (let ((matches (string-match locale-regexp string)))
70 `((language . ,(match:substring matches 1))
71 (territory . ,(match:substring matches 3))
72 (codeset . ,(or codeset (match:substring matches 5)))
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
87 `("." ,(normalize-codeset codeset))
88 '())
89 ,@(if modifier
90 `("@" ,modifier)
91 '())))))
92
93(define (supported-locales->locales supported-locales)
94 "Given SUPPORTED-LOCALES, a file produced by 'glibc-supported-locales',
95return a list of locales where each locale is an alist."
96 (filter-map (match-lambda
97 (("C.UTF-8" . codeset) #f)
98 ((locale . codeset)
99 (locale-string->locale locale codeset)))
100 (call-with-input-file supported-locales read)))
101
102
103;;;
104;;; Language.
105;;;
106
107(define (iso639-language-alpha2 assoc)
108 (assoc-ref assoc 'alpha2))
109
110(define (iso639-language-alpha3 assoc)
111 (assoc-ref assoc 'alpha3))
112
113(define (iso639-language-name assoc)
114 (assoc-ref assoc 'name))
115
116(define (supported-locale? locales alpha2 alpha3)
117 "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field
118matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus,
119if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was
120found."
121 (find (lambda (locale)
122 (let ((language (locale-language locale)))
123 (or (and=> alpha2
124 (lambda (code)
125 (string=? language code)))
126 (string=? language alpha3))))
127 locales))
128
129(define (iso639->iso639-languages locales iso639-3 iso639-5)
130 "Return a list of ISO639 association lists created from the parsing of
131ISO639-3 and ISO639-5 files."
132 (call-with-input-file iso639-3
133 (lambda (port-iso639-3)
134 (call-with-input-file iso639-5
135 (lambda (port-iso639-5)
136 (filter-map
137 (lambda (hash)
138 (let ((alpha2 (assoc-ref hash "alpha_2"))
139 (alpha3 (assoc-ref hash "alpha_3"))
140 (name (assoc-ref hash "name")))
141 (and (supported-locale? locales alpha2 alpha3)
142 `((alpha2 . ,alpha2)
143 (alpha3 . ,alpha3)
144 (name . ,name)))))
145 (append
146 (vector->list
147 (assoc-ref (json->scm port-iso639-3) "639-3"))
148 (vector->list
149 (assoc-ref (json->scm port-iso639-5) "639-5")))))))))
150
151(define (language-code->language-name languages language-code)
152 "Using LANGUAGES as a list of ISO639 association lists, return the language
153name corresponding to the given LANGUAGE-CODE."
154 (let ((iso639-language
155 (find (lambda (language)
156 (or
157 (and=> (iso639-language-alpha2 language)
158 (lambda (alpha2)
159 (string=? alpha2 language-code)))
160 (string=? (iso639-language-alpha3 language)
161 language-code)))
162 languages)))
163 (iso639-language-name iso639-language)))
164
165
166;;;
167;;; Territory.
168;;;
169
170(define (iso3166-territory-alpha2 assoc)
171 (assoc-ref assoc 'alpha2))
172
173(define (iso3166-territory-alpha3 assoc)
174 (assoc-ref assoc 'alpha3))
175
176(define (iso3166-territory-name assoc)
177 (assoc-ref assoc 'name))
178
179(define (iso3166->iso3166-territories iso3166)
180 "Return a list of ISO3166 association lists created from the parsing of
181ISO3166 file."
182 (call-with-input-file iso3166
183 (lambda (port)
184 (map (lambda (hash)
185 `((alpha2 . ,(assoc-ref hash "alpha_2"))
186 (alpha3 . ,(assoc-ref hash "alpha_3"))
187 (name . ,(assoc-ref hash "name"))))
188 (vector->list
189 (assoc-ref (json->scm port) "3166-1"))))))
190
191(define (territory-code->territory-name territories territory-code)
192 "Using TERRITORIES as a list of ISO3166 association lists return the
193territory name corresponding to the given TERRITORY-CODE."
194 (let ((iso3166-territory
195 (find (lambda (territory)
196 (or
197 (and=> (iso3166-territory-alpha2 territory)
198 (lambda (alpha2)
199 (string=? alpha2 territory-code)))
200 (string=? (iso3166-territory-alpha3 territory)
201 territory-code)))
202 territories)))
203 (iso3166-territory-name iso3166-territory)))
204
205
206;;;
207;;; Configuration formatter.
208;;;
209
210(define (locale->configuration locale)
211 "Return the configuration field for LOCALE."
212 `((locale ,locale)))