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

(define-struct month (year month start weeks))

(define-struct year (year start months))

;; we'll calculate the month's starting point and then figure out the dates...
(define (calendar-month year month (start 0))
  (define (helper date weeks)
    (cond ((not (= (date-month date) month)) 
           (reverse weeks))
          (else
           (helper (date+ date (- 7 (week-day date))) ;; should shift the date to the current start of the next week!
                   (cons (date->week date start) weeks)))))
  (make-month year month start
              (helper (build-date year month 1) '())))

(define (calendar-year year (start 0))
  (make-year year start
             (list->vector 
              (map (lambda (month)
                     (calendar-month year month start))
                   (build-list 12 (lambda (n) (add1 n)))))))

(define (year-month/ref year month)
  (vector-ref (year-months year) month))

(define (year-january year)
  (year-month/ref year 0))

(define (year-february year)
  (year-month/ref year 1))

(define (year-march year)
  (year-month/ref year 2))

(define (year-april year)
  (year-month/ref year 3))

(define (year-may year)
  (year-month/ref year 4))

(define (year-june year)
  (year-month/ref year 5))

(define (year-july year)
  (year-month/ref year 6))

(define (year-august year)
  (year-month/ref year 7))

(define (year-september year)
  (year-month/ref year 8))

(define (year-october year)
  (year-month/ref year 9))

(define (year-november year)
  (year-month/ref year 10))

(define (year-december year)
  (year-month/ref year 11))

;; we can pass in additional information, such as the timezone, etc. to setup the correct values...
;; for example - it isn't strictly necessary to hold start in every single week in a calendar, since within a single
;; calendar all of the week would share the same start date (and the start date can be inferred with the first item)
(provide/contract
 (struct month ((year exact-integer?)
                (month (integer-in 1 12))
                (start (integer-in 0 6))
                (weeks (listof week?))))
 (struct year ((year exact-integer?)
               (start (integer-in 0 6))
               (months (vectorof month?))))
 (calendar-month (->* (exact-integer? (integer-in 1 12))
                      ((integer-in 0 6)) 
                      month?))
 (calendar-year (->* (exact-integer?)
                     ((integer-in 0 6))
                     year?))
 (year-january (-> year? month?))
 (year-february (-> year? month?))
 (year-march (-> year? month?))
 (year-april (-> year? month?))
 (year-may (-> year? month?))
 (year-june (-> year? month?))
 (year-july (-> year? month?))
 (year-august (-> year? month?))
 (year-september (-> year? month?))
 (year-october (-> year? month?))
 (year-november (-> year? month?))
 (year-december (-> year? month?))
 )