Hi,
I have a web app that makes heavy use of SRFI 19 dates and times and I'd like
to serialize them to disk. Unfortunately they're not currently serializable.
I've written a patch that adds serialize and deserialize info to both struct
types - diffs attached. Is this an okay sort of thing to add?
Cheers,
-- Dave
Index: srfi/19/time.ss
===================================================================
--- srfi/19/time.ss (revision 18393)
+++ srfi/19/time.ss (working copy)
@@ -59,13 +59,15 @@
;; internal.
(module time mzscheme
- (require srfi/8/receive
+ (require scheme/serialize
+ srfi/8/receive
srfi/29
srfi/optional)
(provide time-tai time-utc time-monotonic time-thread time-process
time-duration time-gc
current-date current-julian-day current-modified-julian-day
current-time time-resolution
;; Time object and accessors
make-time time? time-type time-nanosecond
+ deserialize-info:tm:time-v0
time-second set-time-type! set-time-nanosecond! set-time-second!
copy-time
;; Time comparison
@@ -75,6 +77,7 @@
;; Date object and accessors
;; date structure is provided by core PLT Scheme, we just extended
tu support miliseconds:
srfi:make-date srfi:date?
+ deserialize-info:tm:date-v0
date-nanosecond srfi:date-second srfi:date-minute srfi:date-hour
srfi:date-day srfi:date-month
srfi:date-year date-zone-offset
;; This are not part of the date structure (as they are in the
original PLT Scheme's date)
@@ -268,8 +271,29 @@
(define-values (tm:time make-time time? tm:time-ref tm:time-set!)
(make-struct-type
- 'tm:time #f 3 0 #f null (make-inspector) #f null))
+ 'tm:time #f 3 0 #f
+ (list (cons prop:serializable
+ (make-serialize-info
+ (lambda (t)
+ (vector (time-type t)
+ (time-nanosecond t)
+ (time-second t)))
+ #'deserialize-info:tm:time-v0
+ #f
+ (or (current-load-relative-directory)
+ (current-directory)))))
+ (make-inspector) #f null))
+ (define deserialize-info:tm:time-v0
+ (make-deserialize-info
+ make-time
+ (lambda ()
+ (let ([t0 (make-time #f #f #f)])
+ (values t0 (lambda (t1)
+ (set-time-type! t0 (time-type t1))
+ (set-time-nanosecond! t0 (time-nanosecond t1))
+ (set-time-second! t0 (time-second t1))))))))
+
(define (time-type t) (tm:time-ref t 0))
(define (time-nanosecond t) (tm:time-ref t 1))
(define (time-second t) (tm:time-ref t 2))
@@ -587,7 +611,39 @@
;; -- Date Structures
(define-values (tm:date srfi:make-date srfi:date? tm:date-ref tm:date-set!)
(make-struct-type
- 'tm:date #f 8 0 #f null (make-inspector) #f null))
+ 'tm:date #f 8 0 #f
+ (list (cons prop:serializable
+ (make-serialize-info
+ (lambda (d)
+ (vector (date-nanosecond d)
+ (srfi:date-second d)
+ (srfi:date-minute d)
+ (srfi:date-hour d)
+ (srfi:date-day d)
+ (srfi:date-month d)
+ (srfi:date-year d)
+ (date-zone-offset d)))
+ #'deserialize-info:tm:date-v0
+ #f
+ (or (current-load-relative-directory)
+ (current-directory)))))
+ (make-inspector) #f null))
+
+ (define deserialize-info:tm:date-v0
+ (make-deserialize-info
+ srfi:make-date
+ (lambda ()
+ (let ([d0 (srfi:make-date #f #f #f #f #f #f #f #f)])
+ (values d0 (lambda (d1)
+ (tm:set-date-nanosecond! d1 (date-nanosecond d0))
+ (tm:set-date-second! d1 (srfi:date-second d0))
+ (tm:set-date-minute! d1 (srfi:date-minute d0))
+ (tm:set-date-hour! d1 (srfi:date-hour d0))
+ (tm:set-date-day! d1 (srfi:date-day d0))
+ (tm:set-date-month! d1 (srfi:date-month d0))
+ (tm:set-date-year! d1 (srfi:date-year d0))
+ (tm:set-date-zone-offset! d1 (date-zone-offset d0))))))))
+
;; PLT Scheme date structure has the following:
;; * second : 0 to 61 (60 and 61 are for unusual leap-seconds)
;; * minute : 0 to 59
Index: tests/srfi/19/tests.ss
===================================================================
--- tests/srfi/19/tests.ss (revision 17241)
+++ tests/srfi/19/tests.ss (working copy)
@@ -5,7 +5,8 @@
;; Dave Gurnell (string->date, date->string) -- 2007-09-14
;; Dave Gurnell (time{=,<,>,<=,>=}?) -- 2009-11-26
-(require srfi/19/time)
+(require scheme/serialize
+ srfi/19/time)
(require schemeunit/test
schemeunit/text-ui)
@@ -187,7 +188,12 @@
(check = 365 (- (date->modified-julian-day (srfi:make-date 0 0 0 0 1 1
2004 0))
(date->modified-julian-day (srfi:make-date 0 0 0 0 1 1
2003 0))))
(let ([test-date (srfi:make-date 0 0 0 0 1 1 2003 -7200)])
- (check tm:date= test-date (modified-julian-day->date
(date->modified-julian-day test-date) -7200))))))
+ (check tm:date= test-date (modified-julian-day->date
(date->modified-julian-day test-date) -7200))))
+
+ (test-case "serialize and deserialize"
+ (check-equal? (deserialize (serialize (make-time time-utc 0 1)))
(make-time time-utc 0 1))
+ (check-equal? (deserialize (serialize (make-time time-tai 2 3)))
(make-time time-tai 2 3))
+ (check-equal? (deserialize (serialize (srfi:make-date 0 1 2 3 4 5 6 7)))
(srfi:make-date 0 1 2 3 4 5 6 7)))))
; Helper checks and procedures -----------------
_________________________________________________
For list-related administrative tasks:
http://list.cs.brown.edu/mailman/listinfo/plt-dev
