You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

200 lines
6.9 KiB

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