;;;;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
  (chicken base)
  (chicken type)
  miscmacros
  (only locale
    timezone-components? current-timezone-components timezone-offset?
    update-timezone-components! make-timezone-components builtin-source-name
    check-timezone-components timezone-component-ref unknown-timezone-name?)
  (only type-checks define-check+error-type)
  (only type-errors warning-argument-type))

;;;

(include-relative "srfi-19-common")

(include-relative "srfi-19-common.types")

(: local-timezone-locale (#!optional (or true timezone-components) -> timezone-components))
(: utc-timezone-locale (#!optional (or true timezone-components) -> timezone-components))

(: make-timezone-locale (timezone-name fixnum boolean --> timezone-components))
(: timezone-locale-name (#!optional timezone-components -> timezone-name))
(: timezone-locale-offset (#!optional timezone-components -> fixnum))
(: timezone-locale-dst? (#!optional timezone-components -> boolean))
(: timezone-name? (* -> boolean : timezone-name))
(: check-timezone-name (symbol * #!optional (or string symbol) -> string))
(: error-timezone-name (symbol * #!optional (or string symbol) -> void))
(: timezone-info? (* -> boolean : timezone-info))
(: check-timezone-info (symbol * #!optional (or string symbol) -> timezone-info))
(: error-timezone-info (symbol * #!optional (or string symbol) -> void))
(: checked-optional-timezone-info (symbol * -> timezone-info))

;;;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)
  ;NOTE compiler assumes (cond ...) -> void due to else clause so this rewrites
  (let ((tzi
          (cond
            ((not tzi)
              (utc-timezone-locale))
            ((true? tzi)
              (local-timezone-locale))
            ((timezone-components? tzi)
              tzi)
            ((timezone-offset? tzi)
              tzi)
            (else
              (error-timezone-info loc tzi)))) )
    tzi ) )

) ;module srfi-19-timezone