;;;; srfi-174.scm  -*- Scheme -*-
;;;; Kon Lovett, Aug '23

;from SRFI 174 sample implementation srfi-174.sld

(module (srfi-174 srfi-19)

(;export
  ;SRFI 174
  timespec timespec? timespec-seconds timespec-nanoseconds
  timespec=? timespec<? timespec-hash
  timespec->inexact inexact->timespec
  ;Extensions
  timespec->time
  timespec-print)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken format))
(import (only srfi-19-time time-utc
                           make-time time-nanosecond time-second
                           time-copy
                           time=? time<?
                           time-hash
                           time->seconds seconds->time))

;NOTE works w/o recourse to `define-record' for tag, so ok for tag "defining" module
(cond-expand
  ((or chicken-5.0 chicken-5.1)
    (define (set-record-printer! tag proc)
      (##sys#register-record-printer tag proc) ) )
  (else) )

(define-type time (struct time))  ;srfi-19-time

(define-type timespec (struct <timespec>))

(: timespec (integer fixnum -> timespec))
(: timespec? (* -> boolean : timespec))
(: timespec-seconds (timespec --> integer))
(: timespec-nanoseconds (timespec --> fixnum))

(: timespec=? (timespec timespec --> boolean))
(: timespec<? (timespec timespec --> boolean))

(: timespec-hash (timespec --> fixnum))

(: timespec->inexact (timespec -> float))
(: inexact->timespec (float -> timespec))

(: timespec->time (timespec -> time))
(: timespec-print (timespec #!optional output-port -> void))

;A timespec is immutable so do not expose mutable time
(define-record-type <timespec>
  (wrap-time tim)
  timespec?
  (tim unwrap-time))

(define (timespec sec ns) (wrap-time (make-time time-utc ns sec)))
(define (timespec-seconds ts) (time-second (unwrap-time ts)))
(define (timespec-nanoseconds ts) (time-nanosecond (unwrap-time ts)))

(define (timespec=? a b) (time=? (unwrap-time a) (unwrap-time b)))
(define (timespec<? a b) (time<? (unwrap-time a) (unwrap-time b)))

(define (timespec-hash ts) (time-hash (unwrap-time ts)))

(define (timespec->inexact ts) (exact->inexact (time->seconds (unwrap-time ts))))
(define (inexact->timespec inex) (wrap-time (seconds->time inex time-utc)))

;;

;A timespec is immutable so do not expose mutable time
(define (timespec->time ts) (time-copy (unwrap-time ts)))

(define (timespec-print ts #!optional (port (current-output-port)))
  (format port "#<~S ~A ~A>" 'timespec (timespec-seconds ts) (timespec-nanoseconds ts)) )

(set-record-printer! <timespec> timespec-print)

) ;module (srfi-174 srfi-19)