aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer/timezone.scm
blob: c336b5f3ba41218ab686f8f2a87b7766c13c11bd (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 timezone)
  #:use-module (gnu installer utils)
  #:use-module (guix i18n)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (ice-9 match)
  #:use-module (ice-9 receive)
  #:export (locate-children
            timezone->posix-tz
            timezone-has-child?
            zonetab->timezone-tree
            posix-tz->configuration))

(define %not-blank
  (char-set-complement char-set:blank))

(define (posix-tz->timezone tz)
  "Convert given TZ in Posix format like \"Europe/Paris\" into a list like
(\"Europe\" \"Paris\")."
  (string-split tz #\/))

(define (timezone->posix-tz timezone)
  "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone
like \"Europe/Paris\"."
  (string-join timezone "/"))

(define (zonetab->timezones zonetab)
  "Parse ZONETAB file and return the corresponding list of timezones."

  (define (zonetab-line->posix-tz line)
    (let ((tokens (string-tokenize line %not-blank)))
      (match tokens
        ((code coordinates tz _ ...)
         tz))))

  (call-with-input-file zonetab
    (lambda (port)
      (let* ((lines (read-lines port))
             ;; Filter comment lines starting with '#' character.
             (tz-lines (filter (lambda (line)
                                 (not (eq? (string-ref line 0)
                                           #\#)))
                               lines)))
        (map (lambda (line)
               (posix-tz->timezone
                (zonetab-line->posix-tz line)))
             tz-lines)))))

(define (timezones->timezone-tree timezones)
  "Convert the list of timezones, TIMEZONES into a tree under the form:

	(\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\"))

representing America/North_Dakota/New_Salem and America/North_Dakota/Center
timezones."

  (define (remove-first lists)
    "Remove the first element of every sublists in the argument LISTS."
    (map (lambda (list)
           (if (null? list) list (cdr list)))
         lists))

  (let loop ((cur-timezones timezones))
    (match cur-timezones
      (() '())
      (((region . rest-region) . rest-timezones)
       (if (null? rest-region)
           (cons (list region) (loop rest-timezones))
           (receive (same-region other-region)
               (partition (lambda (timezone)
                            (string=? (car timezone) region))
                          cur-timezones)
             (acons region
                    (loop (remove-first same-region))
                    (loop other-region))))))))

(define (locate-children tree path)
  "Return the children of the timezone indicated by PATH in the given
TREE. Raise a condition if the PATH could not be found."
  (let ((extract-proc (cut map car <>)))
    (match path
      (() (sort (extract-proc tree) string<?))
      ((region . rest)
       (or (and=> (assoc-ref tree region)
                  (cut locate-children <> rest))
           (raise
            (condition
             (&message
              (message
               (format #f (G_ "Unable to locate path: ~a.") path))))))))))

(define (timezone-has-child? tree timezone)
  "Return #t if the given TIMEZONE any child in TREE and #f otherwise."
  (not (null? (locate-children tree timezone))))

(define* (zonetab->timezone-tree zonetab)
  "Return the timezone tree corresponding to the given ZONETAB file."
  (timezones->timezone-tree (zonetab->timezones zonetab)))


;;;
;;; Configuration formatter.
;;;

(define (posix-tz->configuration timezone)
  "Return the configuration field for TIMEZONE."
  `((timezone ,timezone)))
ookbook....* doc/build.scm (%languages): Add "sk" for "guix-cookbook" (it's currently at 57%). Ludovic Courtès 2022-01-19doc: Normalize language codes in menu URLs....* doc/build.scm (stylized-html)[build](base-language-url): Add calls to 'normalize'. Ludovic Courtès 2022-01-19doc: Make the HTML language menu disappear on narrow screens....* doc/build.scm (stylized-html)[build](navigation-bar): New procedure. (stylized-html): Use it. Ludovic Courtès 2022-01-18doc: Add a language menu in the HTML manual....* doc/build.scm (stylized-html): New procedure. (html-manual): Use it. Ludovic Courtès 2022-01-18doc: Factorize 'language-code->native-name'....* doc/build.scm (localization-helper-module)[content](translate): Add call to 'setenv' before 'write'. Remove use of 'with-language'. (language-code->native-name): New procedure. (html-manual-indexes)[build](top-level-index): Use it. Ludovic Courtès 2022-01-18doc: Extract (localization) module....* doc/build.scm (localization-helper-module): New procedure. (html-manual-indexes)[build]: Use it. Remove use of GUILE-JSON-3. Ludovic Courtès 2022-01-15doc: Remove now unnecessary workaround....* doc/build.scm (translated-texi-manuals): Turn into an alias for (@@ (guix self) translated-texi-manuals). Ludovic Courtès 2021-12-13Merge branch 'master' into core-updates-frozenLudovic Courtès 2021-12-13doc: Handle '&nbsp' when syntax-highlighting HTML....* doc/build.scm (syntax-highlighted-html)[build](entity->string): Handle "&nbsp". Ludovic Courtès 2021-10-31Merge remote-tracking branch 'origin/master' into core-updates-frozenEfraim Flashner 2021-10-28doc: Allow offloading of the expensive derivations....* doc/build.scm (translated-texi-manuals) (html-manual, pdf-manual): Pass #:local-build? #f. Ludovic Courtès 2021-07-18Merge branch 'master' into core-updatesLudovic Courtès 2021-07-09doc: Build manual translations with 'guile-3.0-latest'....Fixes <https://bugs.gnu.org/47428>. Reported by Leo Famulari <leo@famulari.name>. * doc/build.scm (translated-texi-manuals): Explicitly use 'guile-3.0-latest'. Ludovic Courtès 2021-05-09Merge branch 'master' into core-updates... Conflicts: gnu/local.mk gnu/packages/bioinformatics.scm gnu/packages/django.scm gnu/packages/gtk.scm gnu/packages/llvm.scm gnu/packages/python-web.scm gnu/packages/python.scm gnu/packages/tex.scm guix/build-system/asdf.scm guix/build/emacs-build-system.scm guix/profiles.scm Marius Bakke 2021-04-20doc: Clarify further the distinction between the web-based manuals....As discussed on #guix IRC, several of us struggle to reliably choose the right option based on the old labels: https://logs.guix.gnu.org/guix/2021-04-20.log#182137 * doc/build.scm (html-manual-indexes): Try to distinguish between the two options more clearly. Leo Famulari 2021-04-18doc: Build the French HTML cookbook....* doc/build.scm (%languages): Add 'fr' cookbook translation. Julien Lepiller 2021-03-24Merge remote-tracking branch 'origin/master' into core-updatesEfraim Flashner 2021-03-20doc: Remove the guile-lib/htmlprag-fixed package....This hotfix package is no longer necessary as the ability to parameterize the way htmlprag tokenizes HTML was added in guile-lib 0.2.7. * doc/build.scm (guile-lib/htmlprag-fixed): Remove variable. (html-manual-identifier-index): Replace guile-lib/htmlprag-fixed by guile-lib, and make set the %strict-tokenizer? parameter to #t. (syntax-highlighted-html): Likewise. Maxim Cournoyer