#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE-TZ.plt - provides time-zone-based date calculations
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tz.ss - functions for calculating dates based on the timezones...
;; yc 10/2/2009 - first version

(require (planet bzlib/base) 
         "base.ss" "serialize.ss" "util.ss" "normalize.ss"
         srfi/19
         (planet bzlib/date)
         )

(define current-tz (make-parameter "America/Los_Angeles"))

(define zones (make-immutable-hash '()))

(define (zone-set! name)
  (set! zones (hash-set zones name (file->tz name))))

(define (zone-ref/load name) 
  (if-it (hash-ref zones name #f)
         it
         (begin 
           (zone-set! name)
           (hash-ref zones name)))) 

(define (tz->span date (tz (current-tz))) 
  (define (rules-helper jdate zs)
    (define (walk rest)
      (cond ((null? rest) (make-span -inf.0 (*zone-span-offset zs) 0 -inf.0))
            ((>= jdate (date->julian-day (span-bound (car rest)))) (car rest))
            (else (walk (cdr rest)))))
    (walk (normalize-rules (*zone-span-rule zs) 
                           '() 
                           (sub1 (date-year date)) 
                           (date-year date) (*zone-span-offset zs))))
  (define (spans-helper jdate spans) ;; just iterate through the spans....
    (define (walk rest)
      (cond ((equal? (span-bound (car rest)) -inf.0) (car rest))
            ((>= jdate (span-bound (car rest))) (car rest))
            (else
             (walk (cdr rest)))))
    (walk (hash-ref spans 
                    (if (< (date-year date) TZ-YEAR-MIN) 
                        TZ-YEAR-MAX
                        (date-year date)))))
  (define (helper tz)
    (let ((jdate (date->julian-day date)))
      (cond ((> (date-year date) TZ-YEAR-MAX)
             (rules-helper jdate (tz-rules tz)))
            ((< (date-year date) (span-year (car (tz-min tz))))
             (cadr (tz-min tz)))
            (else
             (spans-helper jdate (tz-spans tz))))))
  (helper (zone-ref/load tz)))

(define (tz->span/julian jdate (tz (current-tz)))
  (tz->span (julian-day->date jdate) tz))

(define (tz-daylight-saving-offset date (tz (current-tz)))
  (span-dst (tz->span date tz))) 

(define (tz-standard-offset date (tz (current-tz)))
  (span-std (tz->span date tz))) 

(define (tz-offset date (tz (current-tz)))
  (define (helper span)
    (+ (span-std span) (span-dst span)))
  (helper (tz->span date tz)))

(define (date->offset date offset)
  (build-date (date-year date)
              (date-month date)
              (date-day date)
              (date-hour date)
              (date-minute date)
              (date-second date)
              #:tz offset))

(define (date->tz date (tz (current-tz))) 
  (date->offset date (tz-offset date tz)))

(define (build-date/tz year month day (h 0) (m 0) (s 0) #:tz (tz (current-tz)))
  (date->tz (build-date year month day h m s #:tz 0) tz))

;; how do I convert from one offset to another?
;; what I want to do is to add up the difference between the offsets?
;; and then reset the
(define (tz-convert date from to)
  (let ((date (date->tz date from))) 
    (let ((offset (tz-offset date to))) 
      (date->offset (date+ date (/ (- offset (date-zone-offset date)) 86400))
                    offset))))

(define (date+/tz date day (tz (current-tz)))
  (date->tz (date+ date day) tz))

(provide/contract 
 (current-tz (parameter/c zone-exists?))
 (zone-ref/load (-> zone-exists? tz?))
 (tz-daylight-saving-offset (->* (date?)
                                 (zone-exists?)
                                 number?))
 (tz-standard-offset (->* (date?)
                          (zone-exists?)
                          number?))
 (tz-offset (->* (date?)
                 (zone-exists?)
                 number?))
 (date->tz (->* (date?)
                (zone-exists?)
                date?))
 (tz-convert (-> date? zone-exists? zone-exists? date?))
 (date+/tz (->* (date? number?) 
                (zone-exists?)
                date?))
 (build-date/tz (->* (number? (integer-in 1 12) (integer-in 1 31))
                     ((integer-in 0 23) (integer-in 0 59) (integer-in 0 61)
                                        #:tz zone-exists?)
                     date?))
 )