projects/guix·blob javascript-team · refs

127 lines · 4.3 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Mathieu Othacehe <[email protected]>
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 installer timezone)
20 #:use-module (gnu installer utils)
21 #:use-module (guix i18n)
22 #:use-module (srfi srfi-1)
23 #:use-module (srfi srfi-26)
24 #:use-module (srfi srfi-34)
25 #:use-module (srfi srfi-35)
26 #:use-module (ice-9 match)
27 #:use-module (ice-9 receive)
28 #:export (locate-children
29 timezone->posix-tz
30 timezone-has-child?
31 zonetab->timezone-tree
32 posix-tz->configuration))
33
34(define %not-blank
35 (char-set-complement char-set:blank))
36
37(define (posix-tz->timezone tz)
38 "Convert given TZ in Posix format like \"Europe/Paris\" into a list like
39(\"Europe\" \"Paris\")."
40 (string-split tz #\/))
41
42(define (timezone->posix-tz timezone)
43 "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone
44like \"Europe/Paris\"."
45 (string-join timezone "/"))
46
47(define (zonetab->timezones zonetab)
48 "Parse ZONETAB file and return the corresponding list of timezones."
49
50 (define (zonetab-line->posix-tz line)
51 (let ((tokens (string-tokenize line %not-blank)))
52 (match tokens
53 ((code coordinates tz _ ...)
54 tz))))
55
56 (call-with-input-file zonetab
57 (lambda (port)
58 (let* ((lines (read-lines port))
59 ;; Filter comment lines starting with '#' character.
60 (tz-lines (filter (lambda (line)
61 (not (eq? (string-ref line 0)
62 #\#)))
63 lines)))
64 (map (lambda (line)
65 (posix-tz->timezone
66 (zonetab-line->posix-tz line)))
67 tz-lines)))))
68
69(define (timezones->timezone-tree timezones)
70 "Convert the list of timezones, TIMEZONES into a tree under the form:
71
72 (\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\"))
73
74representing America/North_Dakota/New_Salem and America/North_Dakota/Center
75timezones."
76
77 (define (remove-first lists)
78 "Remove the first element of every sublists in the argument LISTS."
79 (map (lambda (list)
80 (if (null? list) list (cdr list)))
81 lists))
82
83 (let loop ((cur-timezones timezones))
84 (match cur-timezones
85 (() '())
86 (((region . rest-region) . rest-timezones)
87 (if (null? rest-region)
88 (cons (list region) (loop rest-timezones))
89 (receive (same-region other-region)
90 (partition (lambda (timezone)
91 (string=? (car timezone) region))
92 cur-timezones)
93 (acons region
94 (loop (remove-first same-region))
95 (loop other-region))))))))
96
97(define (locate-children tree path)
98 "Return the children of the timezone indicated by PATH in the given
99TREE. Raise a condition if the PATH could not be found."
100 (let ((extract-proc (cut map car <>)))
101 (match path
102 (() (sort (extract-proc tree) string<?))
103 ((region . rest)
104 (or (and=> (assoc-ref tree region)
105 (cut locate-children <> rest))
106 (raise
107 (condition
108 (&message
109 (message
110 (format #f (G_ "Unable to locate path: ~a.") path))))))))))
111
112(define (timezone-has-child? tree timezone)
113 "Return #t if the given TIMEZONE any child in TREE and #f otherwise."
114 (not (null? (locate-children tree timezone))))
115
116(define* (zonetab->timezone-tree zonetab)
117 "Return the timezone tree corresponding to the given ZONETAB file."
118 (timezones->timezone-tree (zonetab->timezones zonetab)))
119
120
121;;;
122;;; Configuration formatter.
123;;;
124
125(define (posix-tz->configuration timezone)
126 "Return the configuration field for TIMEZONE."
127 `((timezone ,timezone)))