util.ss
#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATE-TZ.plt - provides time-zone-based date calculations
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; util.ss - basic functions that are shared by other modules, inclding
;; zone-path, spec->date, zone-exists..
;; yc 10/2/2009 - first version

(require (planet bzlib/date)
         srfi/19
         scheme/match
         (planet bzlib/base)
         "base.ss"
         (planet bzlib/file:1:1))

(define (spec->date std-offset offset year month day 
                    (hour 0) (minute 0) (second 0) (type 'w))
  (let ((tz (case type 
              ((u g z) 0)
              ((s) std-offset)
              (else 
               (+ offset std-offset)))))
    (match day 
      ((? integer? date)
       (build-date year month date hour minute second #:tz tz))
      ((list 'last (? number? wday))
       (nth-week-day year month wday 'last hour minute second #:tz tz)) 
      ('- 
       (build-date year month 1 hour minute second #:tz tz))
      ((list 'match (? number? wday) (? symbol? test) (? number? day))
       ((case test 
          ((>=) week-day>=mday)
          ((>) week-day>mday)
          ((<=) week-day<=mday)
          ((<) week-day<mday)) year month wday day hour minute second #:tz tz)))))

(define (zone-path tz)
  (build-path* (this-expression-source-directory) "zoneinfo" tz)) 

(define (zone-exists? tz)
  (file-exists? (zone-path tz)))

(provide/contract
 (spec->date (->* (number? number? number? number? (or/c number?
                                                         list?))
                  (number? number? number? (or/c 'w 'u 'g 'z 's #f))
                  date?))
 (zone-path (-> path-string? path-string?)) 
 (zone-exists? (-> path-string? any))
 )