gnu/installer/timezone.scm

   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
  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
  44 like \"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
  74 representing America/North_Dakota/New_Salem and America/North_Dakota/Center
  75 timezones."
  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
  99 TREE. 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 \f
 121 ;;;
 122 ;;; Configuration formatter.
 123 ;;;
 124
 125 (define (posix-tz->configuration timezone)
 126   "Return the configuration field for TIMEZONE."
 127   `((timezone ,timezone)))