#lang scheme/base
(require "base.ss" "depend.ss" scheme/pretty)
(define (make-rules rules)
(make-immutable-hash (map (lambda (kv)
(cons (car kv)
(map (lambda (rule)
(apply make-rule rule))
(cdr kv))))
(if (not rules) '()
(cdr rules)))))
(define (make-zones zones rules)
(make-immutable-hash
(map (lambda (kv)
(cons (car kv)
(map (lambda (zone)
(define (helper offset rule format until)
(make-zone-span offset
(if (number? rule) rule
(hash-ref rules rule #f))
format until))
(apply helper zone))
(cdr kv))))
(if (not zones) '()
(cdr zones)))))
(define (make-links zones links)
(define (helper zones key rest)
(if (null? rest)
zones
(helper (hash-set zones (car rest)
(hash-ref zones key))
key (cdr rest))))
(foldl (lambda (link zones)
(let ((key (car link))
(links (map car (cdr link))))
(helper zones key links)))
zones
(if (not links) '()
(cdr links))))
(define (make-raw-zoneinfo zi)
(let ((zi (cdr zi)))
(make-links (make-zones (assoc 'zone zi) (make-rules (assoc 'rule zi)))
(assoc 'link zi))))
(define (save-zoneinfo-db! zi)
(call-with-output-atomic-file (build-path (this-expression-source-directory) "zoneinfo.db")
(lambda (out)
(pretty-display zi out))))
(provide/contract
(make-raw-zoneinfo (-> any/c any))
(save-zoneinfo-db! (-> any/c any))
)