#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE.plt
;;
;; date-specific routines.  Reexports srfi/19
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; base.ss - basic structures, parameters, etc.
;; yc 8/31/2009 - first version
(require srfi/19
         scheme/contract
         mzlib/trace
         )
;; (provide (all-from-out srfi/19))

;; the following shall be implemented
;; date creation + manipulation (without timezone) (including time)
;; calendar creation + manipulation
;; formatting date
;; parsing date
;; relative date
;; tz version of the date objects... (+ loading in the zoneinfo)
;; (define (build-date year month day hour min sec nano #:tz tz)

;; basic date calculations - useful for date & calendar.
;; first we need to convert any date into an UTC date.
;; leap-year?
;; determine whether a particular year is a leap-year
(define (leap-year? year)
  ;; every 4 year is a leap year
  (or (and (= (modulo year 4) 0)
           ;; unless it's divisble by 100
           (not (= (modulo year 100) 0)))
       ;; but if it's divisible by 400 then we'll be fine.
      (= (modulo year 400) 0)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; calculating the weekday of a day.
;; use doom's day algorithm...

(define (doomsday y)
  (modulo (+ 2 (floor (+ y (/ y 4) (- (/ y 100)) (/ y 400)))) 7))

(define month-days '((0 . 0) (1 . 31) (2 . 28) (3 . 31) (4 . 30) (5 . 31) (6 . 30)
                             (7 . 31) (8 . 31) (9 . 30) (10 . 31) (11 . 30) (12 . 31)))

(define (year-day d)
  (define (helper month leap?)
    (map (lambda (kv)
           (cond ((>= (car kv) month) 0)
                 ((not leap?) (cdr kv))
                 (else 
                  (if (= (car kv) 2) 29 (cdr kv)))))
         month-days))
  (apply + (date-day d) -1
         (helper (date-month d) (leap-year? (date-year d)))))

;; if the year is a leap year, then use 29 for feburary.
;; otherwise - try to figure out if d overflows the maximum month day, and then adjust accordingly
;; there should be no possibility for overflowing for month 12, since it's 31.
(define (normalize-year/month/day year month day) 
  (define (month-day-helper)
    (if (and (= month 2) (leap-year? year))
        '(2 . 29)
        (assoc month month-days)))
  (define (helper month/day)
    (if (> day (cdr month/day)) ;; we need to add1 to month.
        (list year (add1 month) (- day (cdr month/day)))
        (list year month day)))
  (helper (month-day-helper)))
  
(define (week-day d)
  (modulo (+ (doomsday (date-year d)) (year-day d) -2)
          7))

(define (assoc/cdr key lst)
  (let ((val (assoc key lst))) 
    (if (not val) val (cdr val))))

;; month->num
;; what do we want to do?
;; convert the following to month
;; jan, january, "jan", "JAN", ...
;; the best way to do so is to convert everything into a lower case string.
;; and then we just do assoc*/cdr on it...
(define (month->num month (number-ok? #f))
  (define (helper mon)
    (cond ((symbol? mon)
           (helper (symbol->string mon)))
          ((string? mon)
           (string-downcase mon))
          (else #f)))
  (if (and number-ok? (number? month))
      (let ((it (modulo month 12)))
        (if (= it 0) 12 it))
      (assoc/cdr (helper month)
                 '(("jan" . 1)
                   ("january" . 1)
                   ("feb" . 2)
                   ("feburary" . 2)
                   ("mar" . 3)
                   ("march" . 3)
                   ("april" . 4)
                   ("apr" . 4)
                   ("may" . 5)
                   ("jun" . 6)
                   ("june" . 6)
                   ("jul" . 7)
                   ("july" . 7)
                   ("aug" . 8)
                   ("august" . 8)
                   ("sep" . 9)
                   ("sept" . 9)
                   ("september" . 9)
                   ("oct" . 10)
                   ("october" . 10)
                   ("nov" . 11)
                   ("november" . 11)
                   ("dec" . 12)
                   ("december" . 12)))))


(define (weekday->num week (number-ok? #f))
  (define (helper week)
    (cond ((symbol? week)
           (helper (symbol->string week)))
          ((string? week)
           (string-downcase week))
          (else #f)))
  (if (and number-ok? (number? week))
      (modulo week 7)
      (assoc/cdr (helper week)
                 '(("sun" . 0)
                   ("sunday" . 0)
                   ("mon" . 1)
                   ("monday" . 1)
                   ("tu" . 2)
                   ("tue" . 2)
                   ("tues" . 2)
                   ("tuesday" . 2)
                   ("wed" . 3)
                   ("wednesday" . 3)
                   ("thu" . 4)
                   ("thur" . 4)
                   ("thurs" . 4)
                   ("thursday" . 4)
                   ("fri" . 5)
                   ("friday" . 5)
                   ("sat" . 6)
                   ("saturday" . 6)))))

(define (m->s m) (* m 60))
(define (h->m h) (* h 60))
(define (h->s h (m 0) (s 0))
  (+ s (m->s (+ (h->m h) m))))


(provide/contract 
 (leap-year? (-> integer? boolean?))
 (doomsday (-> integer? (integer-in 0 6)))
 (year-day (-> date? (integer-in 0 366)))
 (week-day (-> date? (integer-in 0 6)))
 (normalize-year/month/day (-> integer? (integer-in 1 12) (integer-in 0 31)
                               (listof integer?)))
 (month->num (->* (any/c)
                  (boolean?)
                  (or/c #f number?)))
 (weekday->num (->* (any/c)
                    (boolean?)
                    (or/c #f number?)))
 (h->s (->* (exact-integer?)
            (exact-integer? exact-integer?)
            exact-integer?))
 )