#lang scheme

(require (planet synx/displayz))

(require "engine-interface.ss")
(require (prefix-in general: "general.ss"))

(require srfi/19)

; note timestamps have an odd format. One oid, but...
; 9.3.13
; (12:06:36 PM) RhodiumToad: synx: timestamps are either float8 seconds offset from 2000-01-01 00:00:00, or they're int8 microsecond offsets from the same time
; (12:08:24 PM) RhodiumToad: synx: the value of the integer_datetimes config variable determines which format

(define (time->microseconds time)
  (+ (/ (time-nanosecond time) 1000) 
     (* (time-second time) 1000000)))

(define (microseconds->time microseconds)
  ((compose 
    (λ (seconds microseconds) 
      ; note that time-utc may not be in the UTC+0 timezone!
      (make-time 'time-utc (* microseconds 1000) seconds))
    quotient/remainder)
   microseconds 1000000))

(define epoch 
  (time->microseconds (date->time-utc (make-date 0 0 0 0 1 1 2000 0))))

(define date-epoch
  (floor (/ epoch 86400 1000000)))

(define (encode-timestamp engine time)
  (let ([microseconds (- (time->microseconds time) epoch)])
    (if (get-field integer-time engine)
        (general:encode-int8 (floor microseconds))
        (general:encode-real8 (/ microseconds 1000000)))))

(define (decode-timestamp engine bytes)
  (microseconds->time
   (+
    (if (get-field integer-time engine)
        (general:decode-integer bytes)
        (inexact->exact (floor (* 1000000 (general:decode-real bytes)))))
    epoch)))

(define (encode-timestamp-tz engine date)
  (encode-timestamp engine (date->time-utc date)))

(define (decode-timestamp-tz engine bytes)
  (time-utc->date
   (decode-timestamp engine bytes)
   0))

(define (bad-time? date)
  (and
   (= -1 (date-hour date))
   (= -1 (date-minute date))
   (= -1 (date-second date))))

(define (divine-time value)
  (if (time? value) 
      (if (< (time-second value) 86400)
          1083
          1114)
      (if (date? value)
          (if (bad-time? value) 
              1082
              1184)
          #f)))

(define (set-info! engine)
  (send engine set-codec! 1114 ; timestamp
        (λ (value) (encode-timestamp engine value))
        (λ (bytes) (decode-timestamp engine bytes)))
  (send engine set-codec! 1184 ; timestamp_tz
        (λ (value) (encode-timestamp-tz engine value))
        (λ (bytes) (decode-timestamp-tz engine bytes)))
  (send engine set-codec! 1082 ; date
        (λ (value) 
          (general:encode-int4 (floor (- (/ (time-second (date->time-utc value)) 86400) date-epoch))))
        (λ (bytes)
          (let ([template (time-utc->date (make-time 'time-utc (+ (* (general:decode-integer bytes) 86400) date-epoch) 0))])
            (make-date 0 0 0 0 (date-day template) (date-month template) (date-year template) 0))))
  (send engine set-codec! 1083 ; time
        (λ (value) (encode-timestamp engine value))
        (λ (bytes) (decode-timestamp engine bytes)))
  (send engine set-codec! 1266 ; time_tz (basically timestamp_tz with 0 days months or years)
        (λ (value) (encode-timestamp-tz engine value))
        (λ (bytes) (decode-timestamp-tz engine bytes)))
  (send engine add-diviner! divine-time))

(provide/contract
 [set-info! (engine? . -> . void?)])