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)))
iases): New procedure. (home-bash-configuration, home-bash-extension): Add ‘aliases’ field. (home-bash-extensions): Adjust accordingly. * guix/scripts/home/import.scm (generate-bash-configuration+modules): Populate the ‘alias’ field. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Xinglu Chen 2021-10-16home: services: shells: Fix documentation about file-like objects....* gnu/home/services/shells.scm: (home-shell-profile-configuration, home-shell-profile-service-type, home-zsh-configuration, home-zsh-extension, home-bash-configuration, home-bash-extension, home-fish-configuration, home-fish-extension): Replace 'strings or gexps' with 'file-like objects' in the documentation. * doc/guix.texi (Shells Home Services): Same. Oleg Pykhalov 2021-10-09home: services: configuration: Support file-like objects....* gnu/home/services/configuration.scm (interpose): Operate only with file-like objects. (string-or-gexp?): Delete procedure. (serialize-string-or-gexp): Rename to 'serialize-file-like'. (text-config?): Call 'file-like' intead of 'string-or-gexp?'. * guix/scripts/home/import.scm: (generate-bash-module+configuration): Don't call slurp-file-gexp. * gnu/home/services/configuration.scm: Move content ... * gnu/services/configuration.scm: here. * gnu/home/services/shells.scm: Delete (gnu home services configuration). * gnu/home/services/xdg.scm: Same. * gnu/local.mk: Same. * tests/guix-home.sh: Test home-bash-service-type and extension with home-bash-extension. Oleg Pykhalov 2021-10-09scripts: home: Make sure profile directory exists....* guix/scripts/home.scm (process-action): Make sure profile directory exists. Oleg Pykhalov 2021-10-09Move (gnu home-services) to (gnu home services)....* gnu/home-services.scm (%guix-home-root-directory): Replace gnu/home-services.scm with "gnu/home/services.scm". Rename to gnu/home/services.scm. * gnu/local.mk (GNU_SYSTEM_MODULES): Rename gnu/home-services.scm to gnu/home/services.scm. * doc/he-config-bare-bones.scm: Replace (gnu home-services) with (gnu home services). * gnu/home.scm: Same. * gnu/home/services/fontutils.scm: Same. * gnu/home/services/mcron.scm: Same. * gnu/home/services/shells.scm: Same. * gnu/home/services/shepherd.scm: Same. * gnu/home/services/symlink-manager.scm: Same. * gnu/home/services/xdg.scm: Same. * guix/scripts/home.scm: Same. * guix/self.scm: Same. Oleg Pykhalov 2021-10-08gnu: Move (gnu home-services) to (gnu home services)....* gnu/home-services/configuration.scm: Move the content ... * gnu/home/services/configuration.scm: ... here. * doc/guix.texi: Replace (gnu home-services mcron) with (gnu home services mcron). Replace (gnu home-services) with (gnu home services). * gnu/home.scm: Replace (gnu home-services fontutils) with (gnu services fontutils). Replace (gnu home-services shells) with (gnu home services shells). Replace (gnu home-services symlink-manager) with (gnu home services symlink-manager). Replace (gnu home-services xdg) with (gnu home services xdg). * gnu/home-services/fontutils.scm: Rename to gnu/services/fontutils.scm. * gnu/home-services/mcron.scm: Move to gnu/home/services/mcron.scm. Replace (gnu home-services shepherd) with (gnu home services shepherd). * gnu/home-services.scm (%service-type-path): Search home services in "gnu/services". * gnu/home-services/shells.scm: Replace (gnu home-services configuration) with (gnu home services configuration). Rename to gnu/home/services/shells.scm. Replace (gnu home-services utils) with (gnu home services utils). * gnu/home-services/shepherd.scm: Move to gnu/home/services/shepherd.scm. * gnu/home-services/symlink-manager.scm: Rename to gnu/home/services/symlink-manager.scm. * gnu/home-services/utils.scm: Rename to gnu/home/services/utils.scm. * gnu/home-services/xdg.scm: Rename to gnu/home/services/xdg.scm. * guix/scripts/home/import.scm: Replace (gnu home-services bash) with (gnu home services bash). * gnu/home-services.scm: Update documentation string. * doc/he-config-bare-bones.scm: Apply new (gnu home-services ...) modules location. * gnu/local.mk (GNU_SYSTEM_MODULES): Same. Oleg Pykhalov