#lang scheme/base

(require srfi/19)

(define nps 10000)

(define (current)
  (encode-time (current-time)))

(define (encode d)
  (encode-time (date->time-utc d)))

(define (encode-time t)
  (floor
   (* nps (+ (/ (time-nanosecond t) 10000000) ; nanosecond? <.<
             (time-second t)))))

(define (decode n)
  (define-values (q r) (quotient/remainder n nps))
  (let ((t (make-time 'time-utc (* (/ r nps) 10000000) q)))
    (time-utc->date t 0)))

(provide current encode decode)