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)))
ing the AVR system. ;;; (define make-avr-binutils (mlambda () (package (inherit (cross-binutils "avr")) (name "avr-binutils")))) (define make-avr-gcc (mlambda () (let ((xgcc (cross-gcc "avr" #:xbinutils (make-avr-binutils)))) (package (inherit xgcc) (name "avr-gcc") (arguments (substitute-keyword-arguments (package-arguments xgcc) ((#:phases phases) #~(modify-phases #$phases (add-after 'set-paths 'augment-CPLUS_INCLUDE_PATH (lambda* (#:key inputs #:allow-other-keys) (let ((gcc (assoc-ref inputs "gcc"))) ;; Remove the default compiler from CPLUS_INCLUDE_PATH ;; to prevent header conflict with the GCC from ;; native-inputs. (setenv "CPLUS_INCLUDE_PATH" (string-join (delete (string-append gcc "/include/c++") (string-split (getenv "CPLUS_INCLUDE_PATH") #\:)) ":")) (format #t "environment variable `CPLUS_INCLUDE_PATH' \ changed to ~a~%" (getenv "CPLUS_INCLUDE_PATH"))))) ;; Without a working multilib build, the resulting GCC lacks ;; support for nearly every AVR chip. (add-after 'unpack 'fix-genmultilib (lambda _ ;; patch-shebang doesn't work here because there are ;; actually several scripts inside this script, each with ;; a #!/bin/sh that needs patching. (substitute* "gcc/genmultilib" (("#!/bin/sh") (string-append "#!" (which "sh")))))))) ((#:configure-flags flags) #~(delete "--disable-multilib" #$flags)))) (native-search-paths (list (search-path-specification (variable "CROSS_C_INCLUDE_PATH") (files '("avr/include"))) (search-path-specification (variable "CROSS_CPLUS_INCLUDE_PATH") (files '("avr/include"))) (search-path-specification (variable "CROSS_OBJC_INCLUDE_PATH") (files '("avr/include"))) (search-path-specification (variable "CROSS_OBJCPLUS_INCLUDE_PATH") (files '("avr/include"))) (search-path-specification (variable "CROSS_LIBRARY_PATH") (files '("avr/lib"))))) (native-inputs `(("gcc" ,gcc) ,@(package-native-inputs xgcc))))))) (define make-avr-libc (mlambda () (package (name "avr-libc") (version "2.0.0") (source (origin (method url-fetch) (uri (string-append "mirror://savannah//avr-libc/avr-libc-" version ".tar.bz2")) (sha256 (base32 "15svr2fx8j6prql2il2fc0ppwlv50rpmyckaxx38d3gxxv97zpdj")))) (build-system gnu-build-system) (arguments '(#:out-of-source? #t #:configure-flags '("--host=avr"))) (native-inputs `(("avr-binutils" ,(make-avr-binutils)) ("avr-gcc" ,(make-avr-gcc)))) (home-page "https://www.nongnu.org/avr-libc/") (synopsis "The AVR C Library") (description "AVR Libc is a project whose goal is to provide a high quality C library for use with GCC on Atmel AVR microcontrollers.") (license (license:non-copyleft "http://www.nongnu.org/avr-libc/LICENSE.txt"))))) (define make-avr-toolchain (mlambda () (let ((avr-binutils (make-avr-binutils)) (avr-libc (make-avr-libc)) (avr-gcc (make-avr-gcc))) ;; avr-libc checks the compiler version and passes "--enable-device-lib" ;; for avr-gcc > 5.1.0. It wouldn't install the library for atmega32u4 ;; etc if we didn't use the corret avr-gcc. (package (name "avr-toolchain") (version (package-version avr-gcc)) (source #f) (build-system trivial-build-system) (arguments '(#:builder (begin (mkdir %output) #t))) (propagated-inputs `(("avrdude" ,avrdude) ("binutils" ,avr-binutils) ("gcc" ,avr-gcc) ("libc" ,avr-libc))) (synopsis "Complete GCC tool chain for AVR microcontroller development") (description "This package provides a complete GCC tool chain for AVR microcontroller development. This includes the GCC AVR cross compiler and avrdude for firmware flashing. The supported programming languages are C and C++.") (home-page (package-home-page avr-libc)) (license (package-license avr-gcc)))))) (define-public microscheme (package (name "microscheme") (version "0.9.4") (source (origin (method git-fetch) (uri (git-reference (url "https://github.com/ryansuchocki/microscheme") (commit (string-append "v" version)))) (sha256 (base32 "1bflwirpcd58bngbs6hgjfwxl894ni2gpdd4pj10pm2mjhyj5dgw")) (file-name (git-file-name name version)))) (build-system gnu-build-system) (arguments `(#:parallel-build? #f ; fails to build otherwise #:tests? #f ; no tests #:phases (modify-phases %standard-phases (delete 'configure)) #:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))))) (native-inputs (list clang cppcheck unzip xxd)) (home-page "https://github.com/ryansuchocki/microscheme/") (synopsis "Scheme subset for Atmel microcontrollers") (description "Microscheme, or @code{(ms)} for short, is a functional programming language for the Arduino, and for Atmel 8-bit AVR microcontrollers in general. Microscheme is a subset of Scheme, in the sense that every valid @code{(ms)} program is also a valid Scheme program (with the exception of Arduino hardware-specific primitives). The @code{(ms)} compiler performs function inlining, and features an aggressive tree-shaker, eliminating unused top-level definitions. Microscheme has a robust @dfn{Foreign Function Interface} (FFI) meaning that C code may be invoked directly from (ms) programs.") (license license:expat)))