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

(define-struct week (start days))

(define (week-day-diff to from)
  (modulo (- to from) 7))

;; week-range
;; calculating the range of the week offsets based on the week-day and the start of the week.
(define (week-range week-day (start 0))
  ;; -> 0 (0 1 2 3 4 5 6)
  ;; -> 1 (-1 0 1 2 3 4 5)
  ;; -> 2 (-2 -1 0 1 2 3 4)
  ;; -> 3 (-3 -2 -1 0 1 2 3)
  ;; -> 4 (-4 -3 -2 -1 0 1 2)
  ;; -> 5 (-5 -4 -3 -2 -1 0 1)
  ;; -> 6 (-6 -5 -4 -3 -2 -1 0)
  ;; the concept is - take the negation of the week-day, and then apply range of 7
  (build-list 7 (lambda (n)
                  (- n (week-day-diff week-day start)))))

(define (week-day/ref week day)
  (vector-ref (week-days week) (week-day-diff day (week-start week))))

(define (week-sunday week) 
  (week-day/ref week 0))

(define (week-monday week)
  (week-day/ref week 1))

(define (week-tuesday week)
  (week-day/ref week 2))

(define (week-wednesday week)
  (week-day/ref week 3))

(define (week-thursday week)
  (week-day/ref week 4))

(define (week-friday week)
  (week-day/ref week 5))

(define (week-saturday week)
  (week-day/ref week 6))

(define (date->week (date (current-date)) (start 0))
  (make-week start
             (list->vector (map (lambda (day)
                                  ;; if date+ automatically works with tz, we are done.
                                  ;; as is it'll keep the same offset, but that's not what we want...
                                  (date+ date day))
                                (week-range (week-day date) start)))))

(define (week->list week)
  (vector->list (week-days week)))
;; a week is a struture that holds the start + the list of dates!

;; figuring out the nth-day-of-month should be a straight froward task without generating a calendar-month.
;;
;; #|
(define (nth-week-day year month wday nth (hour 0) (min 0) (sec 0) #:tz (tz 0))
  ;; the way to do so is to figure out the weekday for the first of the month, and then work toward
  ;; the nth wday
  (define (date-helper date)
    (if (not (= (date-month date) month)) ;; or it might rol
        (date+ date -7)
        date))
  (define (helper date)
    (date-helper 
     (date+ date 
            (+ (week-day-diff wday (week-day date)) 
               (* (sub1 (case nth
                          ((first) 1)
                          ((last) 5)
                          (else nth))) 
                  7)))))
  (helper (build-date year month 1 hour min sec #:tz tz)))

(define (week-day>=mday year month wday mday (h 0) (m 0) (s 0) #:tz (tz 0)) 
  (define (helper date)
    (date+ date (week-day-diff wday (week-day date))))
  (helper (build-date year month mday h m s #:tz tz)))

(define (week-day>mday year month wday mday (h 0) (m 0) (s 0) #:tz (tz 0))
  (define (date-helper date)
    (if (= mday (date-day date))
        (date+ date 7)
        date))
  (date-helper (week-day>=mday year month wday mday h m s #:tz tz)))

(define (week-day<=mday year month wday mday (h 0) (m 0) (s 0) #:tz (tz 0))
  (define (helper date)
    (date+ date (- (week-day-diff (week-day date) wday))))
  (helper (build-date year month mday h m s #:tz tz)))

(define (week-day<mday year month wday mday (h 0) (m 0) (s 0) #:tz (tz 0))
  (define (date-helper date)
    (if (= mday (date-day date))
        (date+ date -7)
        date))
  (date-helper (week-day<=mday year month wday mday h m s #:tz tz)))

(provide/contract 
 (struct week ((start (integer-in 0 6))
               (days (vectorof date?))))
 (week-sunday (-> week? date?))
 (week-monday (-> week? date?))
 (week-tuesday (-> week? date?))
 (week-wednesday (-> week? date?))
 (week-thursday (-> week? date?))
 (week-friday (-> week? date?))
 (week-saturday (-> week? date?))
 (week-day/ref (-> week? (integer-in 0 6) date?))
 (week->list (-> week? (listof date?)))
 (date->week (->* ()
                  (date? (integer-in 0 6)) 
                  week?))
 (nth-week-day (->* (exact-integer? (integer-in 1 12) (integer-in 0 6) 
                                    (or/c 'first 'last (integer-in 1 5)))
                    ((integer-in 0 23) (integer-in 0 60) (integer-in 0 61) #:tz (integer-in -86400 86400))
                    date?))
 (week-day>=mday (->* (exact-integer? (integer-in 1 12) (integer-in 0 6) (integer-in 1 31))
                    ((integer-in 0 23) (integer-in 0 60) (integer-in 0 61) #:tz (integer-in -86400 86400))
                  date?))
 (week-day<=mday (->* (exact-integer? (integer-in 1 12) (integer-in 0 6) (integer-in 1 31))
                    ((integer-in 0 23) (integer-in 0 60) (integer-in 0 61) #:tz (integer-in -86400 86400))
                  date?))
 (week-day>mday (->* (exact-integer? (integer-in 1 12) (integer-in 0 6) (integer-in 1 31))
                    ((integer-in 0 23) (integer-in 0 60) (integer-in 0 61) #:tz (integer-in -86400 86400))
                  date?))
 (week-day<mday (->* (exact-integer? (integer-in 1 12) (integer-in 0 6) (integer-in 1 31))
                    ((integer-in 0 23) (integer-in 0 60) (integer-in 0 61) #:tz (integer-in -86400 86400))
                  date?))
 )

;; with the above we will be able to calculate a month!!