racket/date: change current-date', add
date*->seconds'
This commit is contained in:
parent
5dda7c4b14
commit
0583616dd7
|
@ -21,12 +21,6 @@
|
||||||
|
|
||||||
;; A date is always represented by the number of seconds since the platform-specific, UTC epoch
|
;; A date is always represented by the number of seconds since the platform-specific, UTC epoch
|
||||||
|
|
||||||
(define (date*->seconds dt [local-time? #t])
|
|
||||||
(match-define (date* s mn h d m y wd yd dst? tz ns tz-name)
|
|
||||||
dt)
|
|
||||||
(+ (date->seconds (date s mn h d m y wd yd dst? tz) local-time?)
|
|
||||||
(/ ns 1000000000)))
|
|
||||||
|
|
||||||
(define (date*->utc-seconds dt)
|
(define (date*->utc-seconds dt)
|
||||||
(- (date*->seconds dt #f) (date-time-zone-offset dt)))
|
(- (date*->seconds dt #f) (date-time-zone-offset dt)))
|
||||||
|
|
||||||
|
|
|
@ -6,8 +6,9 @@
|
||||||
racket/contract/base)
|
racket/contract/base)
|
||||||
|
|
||||||
(provide/contract
|
(provide/contract
|
||||||
[current-date (-> date?)]
|
[current-date (-> date*?)]
|
||||||
[date->seconds ((date?) (any/c) . ->* . exact-integer?)]
|
[date->seconds ((date?) (any/c) . ->* . exact-integer?)]
|
||||||
|
[date*->seconds ((date?) (any/c) . ->* . real?)]
|
||||||
[date->string ((date?) (any/c) . ->* . string?)]
|
[date->string ((date?) (any/c) . ->* . string?)]
|
||||||
[date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
|
[date-display-format (parameter/c (symbols 'american 'chinese 'german 'indian 'irish 'julian 'iso-8601 'rfc2822))]
|
||||||
[find-seconds (((integer-in 0 61)
|
[find-seconds (((integer-in 0 61)
|
||||||
|
@ -23,7 +24,7 @@
|
||||||
[julian/scalinger->string (exact-integer? . -> . string?)])
|
[julian/scalinger->string (exact-integer? . -> . string?)])
|
||||||
|
|
||||||
(define (current-date)
|
(define (current-date)
|
||||||
(seconds->date (current-seconds)))
|
(seconds->date (* #i1/1000 (current-inexact-milliseconds))))
|
||||||
|
|
||||||
;; Support for Julian calendar added by Shriram;
|
;; Support for Julian calendar added by Shriram;
|
||||||
;; current version only works until 2099 CE Gregorian
|
;; current version only works until 2099 CE Gregorian
|
||||||
|
@ -263,6 +264,12 @@
|
||||||
(date-year date)
|
(date-year date)
|
||||||
local-time?))
|
local-time?))
|
||||||
|
|
||||||
|
(define (date*->seconds date [local-time? #t])
|
||||||
|
(define s (date->seconds date local-time?))
|
||||||
|
(if (date*? date)
|
||||||
|
(+ s (/ (date*-nanosecond date) 1000000))
|
||||||
|
s))
|
||||||
|
|
||||||
(define (find-seconds sec min hour day month year [local-time? #t])
|
(define (find-seconds sec min hour day month year [local-time? #t])
|
||||||
(define (signal-error msg)
|
(define (signal-error msg)
|
||||||
(error 'find-secs (string-append
|
(error 'find-secs (string-append
|
||||||
|
|
|
@ -154,7 +154,7 @@ result is the result of the last @racket[body].}
|
||||||
|
|
||||||
@defproc[(current-date) date*?]{
|
@defproc[(current-date) date*?]{
|
||||||
|
|
||||||
An abbreviation for @racket[(seconds->date (current-seconds))].}
|
An abbreviation for @racket[(seconds->date (* 0.001 (current-inexact-milliseconds)))].}
|
||||||
|
|
||||||
@defproc[(date->string [date date?] [time? any/c #f]) string?]{
|
@defproc[(date->string [date date?] [time? any/c #f]) string?]{
|
||||||
|
|
||||||
|
@ -175,12 +175,19 @@ Parameter that determines the date string format. The initial format
|
||||||
is @racket['american].}
|
is @racket['american].}
|
||||||
|
|
||||||
@defproc[(date->seconds [date date?] [local-time? any/c #t]) exact-integer?]{
|
@defproc[(date->seconds [date date?] [local-time? any/c #t]) exact-integer?]{
|
||||||
Finds the representation of a date in platform-specific seconds.
|
Finds the representation of a date in platform-specific seconds.
|
||||||
The @racket[time-zone-offset] field of @racket[date] is ignored;
|
If the platform cannot represent the specified date,
|
||||||
the date is assumed to be in local time by default or in UTC
|
@exnraise[exn:fail].
|
||||||
if @racket[local-time?] is @racket[#f]. If
|
|
||||||
the platform cannot represent the specified date, an error is
|
The @racket[week-day], @racket[year-day] fields of @racket[date] are
|
||||||
signaled, otherwise an integer is returned. }
|
ignored. The @racket[dst?] and @racket[time-zone-offset] fields of
|
||||||
|
@racket[date] are also ignored; the date is assumed to be in local
|
||||||
|
time by default or in UTC if @racket[local-time?] is @racket[#f].}
|
||||||
|
|
||||||
|
@defproc[(date*->seconds [date date?] [local-time? any/c #t]) real?]{
|
||||||
|
Like @racket[date->seconds], but returns an exact number that can
|
||||||
|
include a fraction of a second based on @racket[(date*-nanosecond
|
||||||
|
date)] if @racket[date] is a @racket[date*] instance.}
|
||||||
|
|
||||||
@defproc[(find-seconds [second (integer-in 0 61)]
|
@defproc[(find-seconds [second (integer-in 0 61)]
|
||||||
[minute (integer-in 0 59)]
|
[minute (integer-in 0 59)]
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
(Section 'date)
|
(Section 'date)
|
||||||
|
|
||||||
(require mzlib/date)
|
(require racket/date)
|
||||||
|
|
||||||
(test #t date? (date* 0 0 0 1 1 -3000 0 0 #f -1000 0 "AST"))
|
(test #t date? (date* 0 0 0 1 1 -3000 0 0 #f -1000 0 "AST"))
|
||||||
(test #t date? (date* 60 59 23 31 12 3000 6 365 #t 1000 999999999 "ZST"))
|
(test #t date? (date* 60 59 23 31 12 3000 6 365 #t 1000 999999999 "ZST"))
|
||||||
|
@ -38,12 +38,21 @@
|
||||||
(let* ([secs (find-seconds 1 2 3 4 5 2006)]
|
(let* ([secs (find-seconds 1 2 3 4 5 2006)]
|
||||||
[d-some-tz (seconds->date secs)]
|
[d-some-tz (seconds->date secs)]
|
||||||
[d (struct-copy date d-some-tz
|
[d (struct-copy date d-some-tz
|
||||||
[time-zone-offset -21600])])
|
[time-zone-offset -21600])]
|
||||||
|
[d* (date* (date-second d) (date-minute d) (date-hour d)
|
||||||
|
(date-day d) (date-month d) (date-year d)
|
||||||
|
(date-week-day d) (date-year-day d) (date-dst? d)
|
||||||
|
(date-time-zone-offset d)
|
||||||
|
62500
|
||||||
|
"MDT")])
|
||||||
(define (test-string fmt time? result)
|
(define (test-string fmt time? result)
|
||||||
(test (parameterize ([date-display-format fmt])
|
(test (parameterize ([date-display-format fmt])
|
||||||
(date->string d time?))
|
(date->string d time?))
|
||||||
fmt result))
|
fmt result))
|
||||||
(test secs date->seconds d)
|
(test secs date->seconds d)
|
||||||
|
(test secs date*->seconds d)
|
||||||
|
(test (+ secs #e0.0625) date*->seconds d*)
|
||||||
|
(test (date->seconds d*) date->seconds (seconds->date (date*->seconds d*)))
|
||||||
|
|
||||||
(test-string 'american #f "Thursday, May 4th, 2006")
|
(test-string 'american #f "Thursday, May 4th, 2006")
|
||||||
(test-string 'american #t "Thursday, May 4th, 2006 3:02:01am")
|
(test-string 'american #t "Thursday, May 4th, 2006 3:02:01am")
|
||||||
|
|
|
@ -2,6 +2,8 @@ Version 5.3.2.2
|
||||||
Added extflonums
|
Added extflonums
|
||||||
racket/extflonum: added
|
racket/extflonum: added
|
||||||
racket/unsafe/ops: added extflonum operations
|
racket/unsafe/ops: added extflonum operations
|
||||||
|
racket/date: changed current-date to provide nanoseconds,
|
||||||
|
added date*->seconds
|
||||||
|
|
||||||
Version 5.3.2.2
|
Version 5.3.2.2
|
||||||
Added file-truncate
|
Added file-truncate
|
||||||
|
|
Loading…
Reference in New Issue
Block a user