#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE.plt
;;
;; date-specific routines.  Reexports srfi/19
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; date.ss - date creation & manipulations
;; yc 8/31/2009 - first version
(require "base.ss"
         srfi/19
         (planet bzlib/base)
         )

;; we'll ensure the leap year, month, day, etc are taken care of...
;; but not leap seconds, yet.
(define (build-date year month day (hour 0) (min 0) (sec 0) (nano 0) #:tz (tz 0))
  (define (helper year month day)
    (make-date nano sec min hour day month year tz))
  (apply helper (normalize-year/month/day year month day)))

;; date->date/tz
;; change the date's offset - use this to convert a date into its appropriate localtime
;; (date->date/offset
(define (date->date/tz d (tz #f))
  (julian-day->date (date->julian-day d)
                    (if (not tz)
                        (date-zone-offset d)
                        tz)))

(define (date-comp? comp?)
  (lambda (d1 d2)
    (comp? (date->julian-day d1) 
           (date->julian-day d2))))

(define date=? (date-comp? =))
(define date>? (date-comp? >))
(define date<? (date-comp? <))
(define date>=? (date-comp? >=))
(define date<=? (date-comp? <=))
(define date!=? (date-comp? (lambda (v1 v2) (not (= v1 v2)))))
(define (day=? d1 d2)
  (and (= (date-year d1) (date-year d2))
       (= (date-month d1) (date-month d2))
       (= (date-day d1) (date-day d2))))

(define (date===? d1 d2)
  (and (date=? d1 d2)
       (= (date-zone-offset d1)
          (date-zone-offset d2))))

(define (date->seconds d)
  (time-second (date->time-utc d)))

(define (seconds->date s (tz 0)) 
  (time-utc->date (make-time time-utc 0 s) tz))

;; date object manipulation!!
;; does not account for leap seconds.
;; the day is a regular number, as long as it's not +inf.0 or -inf.0.
;; this date+ function does not work with daylight savings... it would be cool if it does...
;; this is of course a very simple function.
;; what is needed is a function that'll account for the correct timezone + daylight saving.
;; for that we'll need to figure out whether we've crossed a particular daylight saving boundary
;; and then change the offset by that amount (but keep the time exactly the same)
(define (date+ date day)
  (julian-day->date (+ (date->julian-day date) day)
                    (date-zone-offset date)))

(define (date- d1 d2) 
  (- (date->julian-day d1) (date->julian-day d2)))

(define (date->alarm date)
  (alarm-evt (* 1000 (date->seconds date))))

(define (date->future-alarm date (d (current-date)))
  (if (date>? date d)
      (date->alarm date)
      #f))

(provide/contract 
 (build-date (->* (integer? (integer-in 1 12) (integer-in 1 31))
                  ((integer-in 0 23) (integer-in 0 59) (integer-in 0 60)
                                     #:tz (integer-in -86400 86400))
                  date?))
 (date->date/tz (->* (date?)
                     ((or/c #f (integer-in -86400 86400)))
                     date?))
 (date=? (-> date? date? boolean?))
 (date>? (-> date? date? boolean?))
 (date<? (-> date? date? boolean?))
 (date>=? (-> date? date? boolean?))
 (date<=? (-> date? date? boolean?))
 (date!=? (-> date? date? boolean?))
 (day=? (-> date? date? boolean?))
 (date===? (-> date? date? boolean?))
 (date+ (-> date? (lambda (n)
                    (and (number? n)
                         (not (equal? n +inf.0))
                         (not (equal? n -inf.0))))
            date?))
 (date- (-> date? date? number?))
 (date->seconds (-> date? number?))
 (seconds->date (->* (exact-nonnegative-integer?)
                     ((integer-in -86400 86400))
                     date?))
 (date->alarm (-> date? evt?))
 (date->future-alarm (->* (date?)
                          (date?)
                          (or/c #f evt?)))
 )