;;;;srfi-19-timezone.scm  -*- Scheme -*-

;;Issues
;;
;; - internal -/+ meaning vs external ISO 8601 +/- meaning

(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)
(import (chicken base))
(import miscmacros)
(import locale)
(import type-checks)
(import type-errors)

;;;

(include "srfi-19-common")

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

(define-inline (make-utc-timezone)
  (update-timezone-components!
    (make-timezone-components "UTC0" (builtin-source-name))
    '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 #t
  (lambda (x)
    (cond
      ((timezone-components? x)
        x )
      ((true? x)
        (current-timezone-components) )
      (else
        (warning-argument-type 'local-timezone-locale x 'timezone-components)
        (local-timezone-locale) ) ) ) )

(define-parameter utc-timezone-locale #t
  (lambda (x)
    (cond
      ((timezone-components? x)
        x )
      ((true? x)
        (make-utc-timezone) )
      (else
        (warning-argument-type 'utc-timezone-locale x 'timezone-components)
        (utc-timezone-locale) ) ) ) )

;;

;converts external ISO 8601 +/- meaning to internal -/+ meaning
(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
      (check-timezone-components 'timezone-locale-name
        (optional tzc (local-timezone-locale))))
    (tzn
      (timezone-components-ref/dst? tzc 'dst-name 'std-name)) )
    ;TZ may not be set
    (and
      (not (unknown-timezone-name? tzn))
      tzn ) ) )

;converts internal -/+ meaning to external ISO 8601 +/- meaning
(define (timezone-locale-offset . tzc)
  (let* (
    (tzc
      (check-timezone-components 'timezone-locale-offset
        (optional tzc (local-timezone-locale))))
    (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 (not tzo) 0 (- tzo)) ) )

(define (timezone-locale-dst? . tzc)
  (timezone-component-ref
    (check-timezone-components 'timezone-locale-dst?
      (optional tzc (local-timezone-locale)))
    '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)
    ((timezone-offset? tzi)       tzi)
    (else
      (error-timezone-info loc tzi)) ) )

) ;module srfi-19-timezone