normalize.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE-TZ.plt - provides time-zone-based date calculations
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; normalize.ss - normalize a raw zone into a tz struct, by expanding the zone/rules into spans
;; as well as keeping the minimum rules (rules before the span) and maximum rules (rules after the
;; span) for dynamic calculations
;; yc 10/2/2009 - first version

(require "base.ss" mzlib/trace (planet bzlib/date) srfi/19
         scheme/match
         scheme/contract
         "util.ss"
         )

(define (raw-zoneinfo->normalized-zoneinfo zoneinfo)
  (hash-map zoneinfo
            (lambda (tz zone)
              (cons tz (raw-zone->normalized-zone zone)))))

(provide raw-zoneinfo->normalized-zoneinfo)

#|
conversion from a raw zone, which contains a list of zone-span and a list of rules.

(listof zone-span?) 

we want to basically go from each zone span upwards, and then within the zonespan, come down...

  ("US"
   (1918 1919 - 3 (last 0) (2 0 0 w) 3600 "D")
   (1918 1919 - 10 (last 0) (2 0 0 w) 0 "S")
   (1942 1942 - 2 9 (2 0 0 w) 3600 "W")
   (1945 1945 - 8 14 (23 0 0 u) 3600 "P")
   (1945 1945 - 9 30 (2 0 0 w) 0 "S")
   (1967 2006 - 10 (last 0) (2 0 0 w) 0 "S")
   (1967 1973 - 4 (last 0) (2 0 0 w) 3600 "D")
   (1974 1974 - 1 6 (2 0 0 w) 3600 "D")
   (1975 1975 - 2 23 (2 0 0 w) 3600 "D")
   (1976 1986 - 4 (last 0) (2 0 0 w) 3600 "D")
   (1987 2006 - 4 (match 0 >= 1) (2 0 0 w) 3600 "D")
   (2007 +inf.0 - 3 (match 0 >= 8) (2 0 0 w) 3600 "D")
   (2007 +inf.0 - 11 (match 0 >= 1) (2 0 0 w) 0 "S"))
  ("CA"
   (1948 1948 - 3 14 (2 0 0 w) 3600 "D")
   (1949 1949 - 1 1 (2 0 0 w) 0 "S")
   (1950 1966 - 4 (last 0) (2 0 0 w) 3600 "D")
   (1950 1961 - 9 (last 0) (2 0 0 w) 0 "S")
   (1962 1966 - 10 (last 0) (2 0 0 w) 0 "S"))

  ("America/Los_Angeles"
   (-28378 #f "LMT" (1883 11 18 12 7 2 w))
   (-28800 "US" "P~aT" (1946 1 1 0 0 0 #f))
   (-28800 "CA" "P~aT" (1967 1 1 0 0 0 #f))
   (-28800 "US" "P~aT" #f))

each zone-span will start from the previous zone's UNTIL (or -inf.0)... 

so the first America/Los_Angeles's zone-span will become.... 
   (-28378 #f "LMT" (1883 11 18 12 7 2 w))

FROM     TO                              STD    DST 
(-inf.0 (1883 11 18 12 7 2:00:00 -28378) -28378 0) 

Then the TO (1883 11 18 12 7 2:00:00 -28378) is passed to the next span... as its base... 
((1919 10 (last 0) 2:00:00 -25200) -28800 0 "PST")
((1919 3 (last 0) 2:00:00 -28800) -28800 3600 "PDT")
((1918 10 (last 0) 2:00:00 -25200) -28800 0 "PST")
((1918 3 (last 0) 2:00:00 -28800) -28800 3600 "PDT")
((1883 11 18 12 7 2:00:00 -28378) -28800 0 "PST") ;; not sure how to generate the PST... (by default use S)
(-inf.0 -28378 0 "LMT") 

;; these are the reversed, normalized zonespans. 
(+inf.0 -28800 0) 
((1967 1 1 0 0 0 w) -28800 0)
((1946 1 1 0 0 0 w) -28800 0)
((1883 11 18 12 7 2:00:00 w) -28800 0) ;; the only trouble is that the w depends on the next timezone... 
(-inf.0 -28378 0)

;;|#

(define (spans-lower-bound spans)
  (cond ((equal? -inf.0 (span-bound (car spans)))
         (cons (make-span* (build-date TZ-YEAR-MAX 12 1 #:tz (span-std (car spans)))
                           (span-std (car spans))
                           (span-dst (car spans)))
               spans))
        ((equal? -inf.0 (span-bound (cadr spans)))
         spans)
        (else
         (spans-lower-bound (cdr spans)))))

(define (raw-zone->normalized-zone zone)
  (define (helper spans)
    (make-tz spans (normalize-zone-rules zone) 
             (spans-lower-bound spans)))
  (helper (foldl normalize-zone-spans 
                 '()
                 zone)))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; converting zone-span/rules to the left over infinite rules...
(define (normalize-zone-rules zone)
  ;; we want to find the ones that have +inf.0 as he
  (define (rule-helper zone acc)
    (make-*zone-span (zone-span-offset zone)
                     (filter (lambda (rule)
                               (equal? +inf.0 (rule-to rule)))
                             (if (not (zone-span-rule zone)) 
                                 '()
                                 (zone-span-rule zone)))
                     (zone-span-format zone)))
  (define (helper rest acc)
    (if (null? rest) 
        acc
        (let ((zone (car rest))) 
          (helper (cdr rest)
                  (if (not (zone-span-until zone)) 
                      (rule-helper zone acc)
                      acc)))))
  (helper zone '()))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; converting zone-span/rules to spans
(define (normalize-zone-spans zone spans)
  (define (end-helper acc)
    ;; end-helper will either add an upper bound or will have no upper bounds...
    ;; adding an upper bound means there is another span on top of this span...
    (if (not (zone-span-until zone)) 
        acc
        (cons (make-span* (apply spec->date (zone-span-offset zone) 
                                 (if (number? (zone-span-rule zone))
                                     (zone-span-rule zone)
                                     0)
                                 (zone-span-until zone))
                          (zone-span-offset zone)
                          0)
              acc)))
  (define (rule-helper acc) 
    ;; rules-helper normalizes the rules into the correct spans and then calls end-helper
    (end-helper (normalize-rules (zone-span-rule zone) acc
                                 (if (equal? (span-bound (car acc)) -inf.0)
                                     TZ-YEAR-MIN
                                     (date-year (span-bound (car acc))))
                                 (if (not (zone-span-until zone)) 
                                     TZ-YEAR-MAX
                                     (car (zone-span-until zone)))
                                 (zone-span-offset zone))))
  (define (helper acc)
    ;; if there are rules, call rule-helper, otherwise call end-helper
    (cond ((list? (zone-span-rule zone)) 
           (rule-helper acc))
          (else (end-helper acc))))
  (define (previous-helper acc)
    ;; first-helper helps process the *previous* values.
    ;; if there were previous values - it was the boundary from the last zone-span
    ;; convert it to use the current zone's standard offset (but keep the boundary)
    ;; if there are no previous value - it means this is the first zone-span we are processing
    ;; we'll add a -inf.0 as the bound (i.e. no lower bounds).
    (if (null? acc)
        (list (make-span* -inf.0 (zone-span-offset zone) 0)) 
        ;; we have the boundary from the previous span... and we want to convert it into the
        ;; current std-offset.
        (cons (make-span* (span-bound (car acc)) (zone-span-offset zone) 
                          (if (number? (zone-span-rule zone)) 
                              (zone-span-rule zone)
                              0))
              (cdr acc))))
  (helper (previous-helper spans)))

(define (normalize-rules rules spans from to std-offset)
  ;; normalize-rules will generate the applicable rules by year basd on the from -> to
  ;; and then sort them according to the month ascending, and then apply the correct wall-time
  ;; (which comes from the previous span's daylight saving offset + the standard-offset)
  (define (helper year acc)
    (define (normalize rules acc) 
      (if (null? rules) 
          acc 
          (let ((rule (car rules)))
            (normalize (cdr rules)
                       (cons (make-span* (apply spec->date 
                                               std-offset 
                                               ;; if there are no previous spans - dst = 0
                                               ;; otherwise, get the dst from the previous span...
                                               (if (null? spans) 
                                                   0 
                                                   (span-dst (car acc)))  
                                               year (rule-month rule) (rule-date rule) (rule-time rule))
                                        std-offset
                                        (rule-offset rule))
                             acc)))))
    (if (> year to) 
        acc
        (let ((rules (applicable-rules-by-year rules year))) 
          (helper (add1 year) (normalize rules acc)))))
  (helper from spans)) 

(define (applicable-rules-by-year rules year)
  ;; filter the rules based on whether the year falls within the from-to range
  ;; and then sort the rules according to the months first
  ;; if they have the same month - then sort according to the date.
  (define (rule<? r1 r2) 
    (cond ((< (rule-month r1) (rule-month r2)) #t)
          ((> (rule-month r1) (rule-month r2)) #f)
          (else
           (date<? (spec->date 0 0 year (rule-month r1) (rule-date r1) 0 0 0 'u)
                   (spec->date 0 0 year (rule-month r1) (rule-date r1) 0 0 0 'u)))))
  (sort (filter (lambda (rule)
                  (<= (rule-from rule) year (rule-to rule)))
                rules)
        rule<?))

(provide normalize-rules)