serialize.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE-TZ.plt - provides time-zone-based date calculations
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; serialize.ss - serialize and deserialize the normalized tz struct
;; yc 10/2/2009 - first version
;; yc 10/7/2009 - adding serialize-tz-abbrs!
;; yc 10/19/2009 - use depend.ss for centralized dependency

(require "base.ss" "depend.ss" "util.ss" 
         scheme/pretty
         )
(define (serialize-tz tz)
  (define (span-helper span)
    (make-span (if (date? (span-bound span)) 
                   (date->*date (span-bound span))
                   (span-bound span))
               (span-std span)
               (span-dst span)
               (span-year span)
               (span-abbr span)))
  (make-tz (map span-helper (tz-spans tz))
           (tz-rules tz)
           (map span-helper (tz-min tz))
           ))

;; this function should only be called during the deserialization...
;; honestly we only want the
(define (serialize-tz-abbrs! name tz)
  (call-with-output-file (abbr-path)
    (lambda (out)
      (write (cons name 
                   (filter-not 
                    (lambda (abbr)
                      (or (equal? abbr "LMT") ;; local meridian time.
                          (equal? abbr "") ;; empty string...
                          (regexp-match #px"~a" abbr))) 
                    (list->unique (map span-abbr 
                                       (tz-spans tz))))) out))
    #:exists 'append))

(define (tz->file! name tz) 
  (let ((path (zone-path name))) 
    (make-directory* (parent-path path))
    (serialize-tz-abbrs! name tz)
    (call-with-output-atomic-file path
                                  (lambda (out)
                                    (pretty-print (serialize-tz tz) out)))))

(define (spans->hash spans (year 2039) (hash (make-immutable-hash '())))
  (if (null? spans) 
      hash
      (let ((span (car spans))) 
        (if (equal? -inf.0 (span-bound span))
            hash
            (cond ((> year (span-year span))
                   (spans->hash spans (sub1 year) (hash-set hash year spans)))
                  ((= year (span-year span))
                   (spans->hash (cdr spans) (sub1 year) (hash-set hash year spans)))
                  ((< year (span-year span))
                   (spans->hash (cdr spans) year (hash-set hash year spans))))))))

(define (deserialize-tz tz)
  (define (span-helper span)
    (make-span (if (*date? (span-bound span)) 
                   (date->julian-day (*date->date (span-bound span)))
                   (span-bound span))
               (span-std span)
               (span-dst span)
               (span-year span)
               (span-abbr span)))
  (make-tz (spans->hash (map span-helper (tz-spans tz)))
           (tz-rules tz)
           (map span-helper (tz-min tz))))

(define (file->tz name)
  (let ((path (zone-path name))) 
    (call-with-input-file path 
      (lambda (in)
        (deserialize-tz (read in))))))

(provide/contract 
 (serialize-tz (-> tz? tz?))
 (deserialize-tz (-> tz? tz?))
 (tz->file! (-> path-string? tz? any))
 (file->tz (-> path-string? tz?))
 )