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