#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE-TZ.plt - provides time-zone-based date calculations
;; Bonzai Lab, LLC.  All rights reserved.
;; released under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; - converts a zoneinfo file into a list of zones, rules, and links.
;; yc 10/2/2009 - first version

(require (planet bzlib/base:1:2)
         (only-in (planet bzlib/date/base) h->s
                  weekday->num month->num)

(define-struct time (hour minute second nano tz))

(define (parse-time str (make-if-not-time? #t))
  (if-it (regexp-match #px"^[+-]?(\\d+)(:(\\d+)(:(\\d+))?)?" str)
         (apply make-time 
                (map (lambda (n)
                       (if (not n) 0
                           (string->number n)))
                     (list (second it)
                           (fourth it)
                           (sixth it) #f #f)))
         (if (not make-if-not-time?) #f
             (make-time 0 0 0 0 0))))

;; time to write a function that'll read a whole zoneinfo file.
;; rules
;; a line starting with # means it'll be skipped.
;; we need special ways of reading the file I think... perhaps just using regular read would work...
;; and we need to skip the comments...

(define (read-zoneinfo in)
  (define (read-helper in)
    (define (helper acc)
      (parameterize ((current-readtable
                      (make-readtable (current-readtable)
                                      #\# #\; #f)))
        (let ((term (read in)))
          (cond ((eof-object? term)
                 (reverse acc))
                (else (helper (cons term acc)))))))
    (helper '()))
  (define (helper acc)
    (let ((l (read-line in 'any)))
      (cond ((eof-object? l)
             (reverse acc))
            ((equal? l "")
             (helper acc))
             (let ((res (read-helper (open-input-string l))))
               (cond ((null? res)
                      (helper acc))
                     ((equal? (car res) 'Rule)
                      (helper (cons (apply parse-rule (cdr res))
                     ((equal? (car res) 'Zone)
                      (helper (cons (parse-zone (cdr res)) acc)))
                     ((equal? (car res) 'Link)
                      (helper (cons (apply parse-link (cdr res)) acc)))
                     ((equal? (caar acc) 'zone)
                      (helper (cons (parse-zone res (cdar acc)) acc)))
                      (helper (cons res acc)))))))))
  (helper '()))
;; (trace read-zoneinfo)

 (read-zoneinfo (-> input-port? any))

;; we want a function to parse the time...
;; seems like there are multiple of such functions, though.
;; 1 regular time - 2am,2pm, etc.
;; 2 hours (for offsets) -2
;; 3 the *special time* such as 2:00s(standard time), 2:00u(universal time), 2:00w(wall time)
;; the common part is the numbers.
;; the non common part is the precedent & trailings.
;; so what we want to do is to parse that part out...
(define (parse-offset str (make-if-not-time? #t))
  (let ((time (parse-time str make-if-not-time?))
        (sign (regexp-match #px"^\\s*(\\+|-)?\\d+" str)))
    (if (not time) #f
        ((cond ((not sign) +)
               ((equal? (second sign) "-") -)
               (else +)) (h->s (time-hour time)
                               (time-minute time)
                               (time-second time))))))

(define (parse-extended-time str)
  (let ((time (parse-time str))
        (unit (regexp-match #px"\\d+\\s*(w|u|g|z|s)?\\s*$" str)))
    (list (time-hour time)
          (time-minute time)
          (time-second time)
          (if unit
              (if-it (second unit)
                     (string->symbol it)
;; this ought to produce a particular time (no tz attached)
(define (extended-time-helper t)
  (if (number? t)
      (list t 0 0 #f)
      (case t
        ((-) (list 0 0 0 #f))
         (parse-extended-time (symbol->string t))))))

(define (on-the-day-helper on month)
  (define (days-greater-helper days)
    ;; we need to spit the day up
    (if-it (regexp-match #px"(Sun|Mon|Tue|Wed|Thu|Fri|Sat)(>|<|>=|<=)(\\d+)"
           (let ((wday
                  (if-it (weekday->num (cadr it) #t)
                         (error 'wday-helper "Unkonwn weekday ~a" (cadr it))))
                 (match (string->symbol (caddr it)))
                 (day (string->number (cadddr it))))
             (list 'match wday match day))
           (error 'on-the-day-helper
                  "Unrecognized pattern ~a in ~a"
                  (list on month))))
  (cond ((symbol? on)
         (case on
           ((lastSun) ;; means the last sunday.
            (list 'last 0))
           ((lastMon) ;; means last monday.
            (list 'last 1))
           ((lastTue) ;; means last monday.
            (list 'last 2))
           ((lastWed) ;; means last monday.
            (list 'last 3))
           ((lastThu) ;; means last monday.
            (list 'last 4))
           ((lastFri) ;; means last monday.
            (list 'last 5))
           ((lastSat) ;; means last monday.
            (list 'last 6))
           (else ;; we need to split it up...
            (days-greater-helper (symbol->string on)))))
        ((number? on)
         ;; (list 'day on)
         (error 'on-the-day-helper
                "unknown on the day ~a in ~a"
                (list on month)))))

;; first thing - convert rules into their correct values.
;; name = string
;; from = (or/c integer? maximum minimum max min) = anything else ignored.
;; (min = epoch)
;; to = integer, max, min, only (means repeating from)
;; type = '-' (inclusive from - to), otherwise 'not sure for now' (string)
;; in = the month name (or number)? maybe abbreviated. (string)
(define (parse-rule name from to type in on at save letter/s)
  (define name-helper symbol->string)
  (define (from-year-helper year)
    (case year
      ((maximum max) +inf.0)
      ((min minimum) -inf.0)
      (else year)))
  (define (to-year-helper from to)
    (case to
      ((maximum max) +inf.0)
      ((min minimum) -inf.0)
      ((only) from)
      (else to)))
  (define (type-helper type from/y to/y)
    (case type
      ((-) type)
       (error 'type-helper
              "unknown type ~a in ~a"
              (list name from to type in on at save letter/s)))))
  (define (month-helper in)
    (if-it (month->num in #t)
           (error 'in-month-helper
                  "unknown month ~a in ~a"
                  (list name from to type in on at save letter/s))))
  (define (save-helper save)
    (if (number? save)
        (h->s save)
        (case save
          ((-) 0)
           (parse-offset (symbol->string save)
  (define (letter/s-helper letter/s)
    (case letter/s
      ((-) "")
      (else (symbol->string letter/s))))
  (let* ((name (name-helper name))
         (from-year (from-year-helper from))
         (to-year (to-year-helper from-year to))
         (type (type-helper type from-year to-year))
         (in-month (month-helper in))
         (on-the-day (on-the-day-helper on in-month))
         (at-when (extended-time-helper at))
         (offsets (save-helper save))
         (letter/s (letter/s-helper letter/s)))
    (list 'rule name from-year to-year type in-month on-the-day
          at-when offsets letter/s)))

;; according to ZIC (8)

       A rule line has the form

            Rule  NAME  FROM  TO    TYPE  IN   ON       AT    SAVE  LETTER/S

       For example:

            Rule  US    1967  1973  -     Apr  lastSun  2:00  1:00  D

       NAME    Gives the (arbitrary) name of the set of rules this rule is part of.

       FROM    Gives the first year in which the rule applies.  Any integer year can be supplied; the  Gregorian
               calendar  is assumed.  The word minimum (or an abbreviation) means the minimum year representable
               as an integer.  The word maximum (or an abbreviation) means the maximum year representable as  an
               integer.   Rules  can describe times that are not representable as time values, with the unrepre-
               sentable times ignored; this allows rules to be portable among hosts with  differing  time  value

       TO      Gives  the  final year in which the rule applies.  In addition to minimum and maximum (as above),
               the word only (or an abbreviation) may be used to repeat the value of the FROM field.

       TYPE    Gives the type of year in which the rule applies.  If TYPE is - then  the  rule  applies  in  all
               years between FROM and TO inclusive.  If TYPE is something else, then zic executes the command
                    yearistype year type
               to  check  the  type  of  a year: an exit status of zero is taken to mean that the year is of the
               given type; an exit status of one is taken to mean that the year is not of the given type.

       IN      Names the month in which the rule takes effect.  Month names may be abbreviated.

       ON      Gives the day on which the rule takes effect.  Recognized forms include:

                    5        the fifth of the month
                    lastSun  the last Sunday in the month
                    lastMon  the last Monday in the month
                    Sun>=8   first Sunday on or after the eighth
                    Sun<=25  last Sunday on or before the 25th

               Names of days of the week may be abbreviated or spelled out in full.  Note that there must be  no
               spaces within the ON field.

       AT      Gives the time of day at which the rule takes effect.  Recognized forms include:

                    2        time in hours
                    2:00     time in hours and minutes
                    15:00    24-hour format time (for times after noon)
                    1:28:14  time in hours, minutes, and seconds
                    -        equivalent to 0

               where  hour 0 is midnight at the start of the day, and hour 24 is midnight at the end of the day.
               Any of these forms may be followed by the letter w if the given time is local "wall clock"  time,
               s  if  the  given  time is local "standard" time, or u (or g or z) if the given time is universal
               time; in the absence of an indicator, wall clock time is assumed.

       SAVE    Gives the amount of time to be added to local standard time when the rule  is  in  effect.   This
               field  has  the  same  format  as the AT field (although, of course, the w and s suffixes are not

               Gives the "variable part" (for example, the "S" or "D" in "EST" or "EDT") of time zone  abbrevia-
               tions to be used when this rule is in effect.  If this field is -, the variable part is null.


;; second - time to parse zones.
       A zone line has the form

            Zone  NAME                GMTOFF  RULES/SAVE  FORMAT  [UNTIL]

       For example:

            Zone  Australia/Adelaide  9:30    Aus         CST     1971 Oct 31 2:00

       The fields that make up a zone line are:

       NAME  The  name of the time zone.  This is the name used in creating the time conversion information file
             for the zone.

             The amount of time to add to UTC to get standard time in this zone.  This field has the same format
             as  the  AT  and  SAVE fields of rule lines; begin the field with a minus sign if time must be sub-
             tracted from UTC.

             The name of the rule(s) that apply in the time zone or, alternately, an amount of time  to  add  to
             local standard time.  If this field is - then standard time always applies in the time zone.

             The  format  for  time  zone abbreviations in this time zone.  The pair of characters %s is used to
             show where the "variable part" of the time zone abbreviation goes.  Alternately, a slash (/)  sepa-
             rates standard and daylight abbreviations.

       UNTIL The  time at which the UTC offset or the rule(s) change for a location.  It is specified as a year,
             a month, a day, and a time of day.  If this is specified, the time zone  information  is  generated
             from  the  given  UTC offset and rule change until the time specified.  The month, day, and time of
             day have the same format as the IN, ON, and AT columns of a rule; trailing columns can be  omitted,
             and default to the earliest possible value for the missing columns.

             The  next line must be a "continuation" line; this has the same form as a zone line except that the
             string "Zone" and the name are omitted, as the continuation line will place information starting at
             the  time  specified as the UNTIL field in the previous line in the file used by the previous line.
             Continuation lines may contain an UNTIL field, just as zone lines do, indicating that the next line
             is a further continuation.

(define (parse-zone args (prev #f))
  (if (not prev) ;; this is not a continuation line.
      (apply parse-zone-helper args)
      ;; we'll take the first value and apply to the zone itself.
      (apply parse-zone-helper (cons (car prev) args))))

(define (parse-zone-helper name gmtoff rules/save format . until)
  (define (offset-helper offset)
    (if (number? offset)
        (h->s offset)
        (case offset
          ((-) 0)
          (else (parse-offset (symbol->string offset))))))
  (define (rules/save-helper rules/save)
    (case rules/save
      ((-) #f)
       (let ((save (symbol->string rules/save)))
         (if-it (parse-offset save #f)
  (define (until-helper (year #f) (month 1) (day 1) (time '0)) ;; this can be
    (if (not year) ;; nothing is passed in.
        (let ((month (month->num month #t)))
          (append (list year month (on-the-day-helper day month))
                  (extended-time-helper time)))))
  (define (format-helper format)
    (if (symbol? format)
        (format-helper (symbol->string format))
        (regexp-replace* #px"%s" format "~a")))
  (list 'zone
        (if (symbol? name) (symbol->string name) name)
        (offset-helper gmtoff)
        (rules/save-helper rules/save)
        (format-helper format)
        (apply until-helper until)))

(define (parse-link from to)
  (list 'link (symbol->string from)
        (symbol->string to)))

;; now that we have the zone.  the question is - how do we handle
;; the usage of the zones?