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)))
shared libs. Don't access %build-inputs directly in PATCH-PATHS-PHASE. [license]: Add MPL2.0. Marius Bakke 2018-02-20gnu: calendar.scm: Use license: prefix....* gnu/packages/calendar.scm (libical, khal, remind, libhdate): Use license: prefix. Marius Bakke 2017-12-19gnu: Remove redundant cmake libdir configure flags....* gnu/packages/bioinformatics.scm (imp)[arguments]: Remove CMAKE_INSTALL_LIBDIR flag. * gnu/packages/calendar.scm (libical): Same. * gnu/packages/engineering.scm (kicad): Same. * gnu/packages/games.scm (openrct2, mgba): Same. * gnu/packages/gl.scm (virtualgl): Same. * gnu/packages/image-processing.scm (mia): Same. * gnu/packages/linux.scm (rdma-core): Same. * gnu/packages/machine-learning.scm (dlib): Same. * gnu/packages/maths.scm (lapack, superlu, z3): Same. * gnu/packages/password-utils.scm (keepassxc): Same. * gnu/packages/photo.scm (darktable): Same. * gnu/packages/rdesktop.scm (freerdp): Same. Efraim Flashner 2017-11-19Merge branch 'master' into core-updatesMarius Bakke 2017-11-18gnu: Move date/time packages from python.scm to time.scm....* gnu/packages/python.scm (python-pytz, python2-pytz, python-dateutil, python2-dateutil, python-parsedatetime, python2-parsedatetime, python-tzlocal, python-isodate, python2-isodate, python-iso8601, python2-iso8601, python-monotonic, python2-monotonic, python-pyrfc3339, python2-pyrfc3339, python-arrow, python2-arrow, python-aniso8601, python2-aniso8601): Move from here... * gnu/packages/time.scm: ...to here. * gnu/packages/calendar.scm, gnu/packages/check.scm, gnu/packages/django.scm, gnu/packages/ebook.scm, gnu/packages/gnome.scm, gnu/packages/irc.scm, gnu/packages/jrnl.scm, gnu/packages/mail.scm, gnu/packages/openstack.scm, gnu/packages/package-management.scm, gnu/packages/python-crypto.scm, gnu/packages/python-web.scm, gnu/packages/rdf.scm, gnu/packages/statistics.scm, gnu/packages/tls.scm, gnu/packages/tryton.scm, gnu/packages/version-control.scm: Adjust accordingly. Ricardo Wurmus 2017-11-17gnu: Move testing packages from python.scm to check.scm....* gnu/packages/python.scm (python-behave-web-api, python2-behave-web-api, python-mock, python2-mock, python-mock-2, python-nose, python2-nose, python-nose2, python2-nose2, python-unittest2, python2-unittest2, python-pytest, python2-pytest, python-pytest-3.0, python2-pytest-3.0, python-pytest-cov, python2-pytest-cov, python-pytest-runner, python2-pytest-runner, python-pytest-mock, python2-pytest-mock, python-pytest-xdist, python2-pytest-xdist, python-scripttest, python2-scripttest, python-testtools, python2-testtools, python-testscenarios, python2-testscenarios, python-testresources, python2-testresources, python-subunit, python2-subunit, python-fixtures, python2-fixtures, python-testrepository, python2-testrepository, python-coverage, python2-coverage, python-cov-core, python2-cov-core, python-testpath, python2-testpath, python-testlib, python2-testlib, python-pytest-cache, python2-pytest-cache, python-pytest-localserver, python-pytest-xprocess, python-pytest-subtesthack, python2-pytest-subtesthack, python-hypothesis, python2-hypothesis, python-lit, python2-lit, python-pytest-pep8, python2-pytest-pep8, python-pytest-flakes, python2-pytest-flakes, python2-coverage-test-runner, python-pylint, python2-pylint, python-paramunittest, python2-python-paramunittest, python-pytest-warnings, python2-pytest-warnings, python-pytest-capturelog, python2-pytest-capturelog, python-pytest-catchlog, python2-pytest-catchlog, python-nosexcover, python2-nosexcover, python-discover, python2-discover, behave, python-rednose, python2-rednose, python-nose-randomly, python2-nose-randomly, python-nose-timer, python2-nose-timer): Move from here... * gnu/packages/check.scm: ...to here. * gnu/packages/admin.scm, gnu/packages/android.scm, gnu/packages/backup.scm, gnu/packages/bioinformatics.scm, gnu/packages/calendar.scm, gnu/packages/dav.scm, gnu/packages/django.scm, gnu/packages/freedesktop.scm, gnu/packages/haskell.scm, gnu/packages/image.scm, gnu/packages/irc.scm, gnu/packages/jrnl.scm, gnu/packages/ldc.scm, gnu/packages/libffi.scm, gnu/packages/mail.scm, gnu/packages/mpd.scm, gnu/packages/openstack.scm, gnu/packages/package-management.scm, gnu/packages/password-utils.scm, gnu/packages/python-crypto.scm, gnu/packages/python-web.scm, gnu/packages/rdf.scm, gnu/packages/statistics.scm, gnu/packages/storage.scm, gnu/packages/time.scm, gnu/packages/tls.scm, gnu/packages/tor.scm, gnu/packages/tryton.scm: Adjust accordingly. Ricardo Wurmus