;;;; locale-builtin.scm
;;;; Kon Lovett, Mar '19
;;;; Kon Lovett, Mar '09

;; Issues
;;
;; - Only Posix for now.

(module locale-builtin

(;export
  ;
  builtin-source-name builtin-source-name?
  unknown-timezone-name unknown-timezone-name?
  ;
  use-builtin-timezone
  use-builtin-locale
  use-builtin-language)

(import scheme)
(import (chicken base))
(import (only (chicken time posix) seconds->local-time local-timezone-abbreviation))
(import locale-posix)
(import locale-components)
(import locale-categories)
(import locale-timezone)

;;; When no environment info use Plan B

;FIXME use immutable core string

(define-constant BUILTIN-SOURCE "BUILTIN")

(define (builtin-source-name)
  BUILTIN-SOURCE )

(define (builtin-source-name? x)
  (equal? BUILTIN-SOURCE x) )

(define-constant UNKNOWN-LOCAL-TZ-NAME "XXXX")

(define (unknown-timezone-name)
  UNKNOWN-LOCAL-TZ-NAME )

(define (unknown-timezone-name? x)
  (equal? UNKNOWN-LOCAL-TZ-NAME x) )

;; Builtin Timezone

;; Daylight saving time offset from standard offset.
;; ("spring forward" add it, "fall back" subtract it)

(define-constant DEFAULT-DST-OFFSET 3600)

(define (tm-dst? tm) (vector-ref tm 8))
(define (tm-off tm) (vector-ref tm 9))

(define (current-local-time) (seconds->local-time))

(define (make-builtin-timezone)
  ;Need local timezone info
  (let* (
    (tm (current-local-time))
    (tzn (local-timezone-abbreviation) #;(local-timezone-name tm))
    (tzo (tm-off tm))
    (dst? (tm-dst? tm)) )
    ;Since the tzo reflects the dst status need to fake the one not in effect.
    ;UTC doesn't have dst
    (if dst?
      (make-posix-timezone
        UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET)
        tzn tzo)
      (make-posix-timezone
        tzn tzo
        UNKNOWN-LOCAL-TZ-NAME (if (zero? tzo) 0 (- tzo DEFAULT-DST-OFFSET))) ) ) )

(define (use-builtin-timezone)
  (set-locale-category!
    'timezone
    (posix-timezone-string->timezone-components (make-builtin-timezone) BUILTIN-SOURCE)) )

;; Builtin Locale

(define-constant DEFAULT-LANGUAGE "en")
(define-constant DEFAULT-REGION "US")

(define (make-builtin-locale-string)
  (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION) )

(define (use-builtin-locale)
  (set-locale-category!
    'current
    (posix-locale-string->locale-components (make-builtin-locale-string) BUILTIN-SOURCE)) )

;; Builtin Language List

(define (use-builtin-language)
  (and-let* (
    (msglc (locale-category-ref 'current)) )
    (let (
      (lc
        (make-locale-components
          (locale-component-ref msglc 'name)
          BUILTIN-SOURCE
          'language)) )
      (update-locale-components! lc 'locales (list msglc))
      (set-locale-category! 'language lc) ) ) )

) ;module locale-builtin