;;;; srfi-19-timezone.scm

(module srfi-19-timezone

  (;export
    local-timezone-locale
    utc-timezone-locale
    #;make-timezone-locale
    timezone-locale-name
    timezone-locale-offset
    timezone-locale-dst?
    timezone-name?
    check-timezone-name
    timezone-info?
    error-timezone-name
    check-timezone-info
    error-timezone-info
    checked-optional-timezone-info)

  (import scheme chicken)

  (use miscmacros locale type-checks type-errors)

;;; Timezone Locale Object (Public Immutable, but not enforced)

(define-inline (make-utc-timezone)
  (let ((tz (make-timezone-components "UTC0" (builtin-source-name))))
    (update-timezone-components! tz 'std-name "UTC" 'std-offset 0) ) )

(define-inline (timezone-components-ref/dst? tzc a b)
  (timezone-component-ref tzc (if (timezone-component-ref tzc 'dst?) a b)) )

;;

(define-parameter local-timezone-locale (current-timezone-components)
  (lambda (obj)
    (cond ((timezone-components? obj) obj)
          (else
           (warning-argument-type 'local-timezone-locale obj 'timezone-components)
           (local-timezone-locale) ) ) ) )

(define-parameter utc-timezone-locale (make-utc-timezone)
  (lambda (obj)
    (cond ((timezone-components? obj) obj)
          (else
           (warning-argument-type 'utc-timezone-locale obj 'timezone-components)
           (utc-timezone-locale) ) ) ) )

;;

#; ;Unusued
(define (make-timezone-locale nam off dst?)
  (update-timezone-components! (make-timezone-components #f "SRFI 19")
    (if dst? 'dst-name 'std-name) nam
    (if dst? 'dst-offset 'std-offset) (- off) ;ISO 8601 -> locale
    'dst? dst?) )

(define (timezone-locale-name . tzc)
  (let ((tzc (optional tzc (local-timezone-locale))))
    (check-timezone-components 'timezone-locale-name tzc)
    (let ((tzn (timezone-components-ref/dst? tzc 'dst-name 'std-name)))
      ; TZ may not be set
      (and (not (unknown-timezone-name? tzn))
           tzn ) ) ) )

(define (timezone-locale-offset . tzc)
  (let ((tzc (optional tzc (local-timezone-locale))))
    (check-timezone-components 'timezone-locale-offset tzc)
    (let ((tzo (timezone-components-ref/dst? tzc 'dst-offset 'std-offset)))
      ; TZ may not be set but if it is then convert to ISO 8601
      (if tzo (- tzo)
          0 ) ) ) )

(define (timezone-locale-dst? . tzc)
  (let ((tzc (optional tzc (local-timezone-locale))))
    (check-timezone-components 'timezone-locale-offset tzc)
    (timezone-component-ref tzc 'dst?) ) )

;;

(define (timezone-name? obj) (or (not obj) (string? obj)))
(define (timezone-info? obj) (or (timezone-components? obj) (timezone-offset? obj)))

(define-check+error-type timezone-name)
(define-check+error-type timezone-info)

;;

(define (checked-optional-timezone-info loc tzi)
  (cond ((not tzi)                    (utc-timezone-locale))
        ((boolean? tzi)               (local-timezone-locale))
        ((timezone-components? tzi)   tzi)
        ((fixnum? tzi)                tzi)
        (else
          (error-timezone-info loc tzi)) ) )

) ;module srfi-19-timezone