diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-07-30 23:15:43 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-07-30 23:15:43 +0200 |
| commit | b72f967841fec5f34e6c806bfe8b5824e6d6a2c3 (patch) | |
| tree | 140d454e015d0834a6f5fcb92524f888833eba25 | |
| parent | Move type formatters away from HTML. (diff) | |
| download | calp-b72f967841fec5f34e6c806bfe8b5824e6d6a2c3.tar.gz calp-b72f967841fec5f34e6c806bfe8b5824e6d6a2c3.tar.xz | |
Add datetime-.
| -rw-r--r-- | module/datetime.scm | 16 | ||||
| -rw-r--r-- | tests/datetime.scm | 10 |
2 files changed, 22 insertions, 4 deletions
diff --git a/module/datetime.scm b/module/datetime.scm index 0a37f8df..fdab2fe6 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -723,16 +723,16 @@ minute: ,(minute t) second: ,(second t))) -(define (datetime->sexp dt) - `(datetime date: ,(get-date dt) - time: ,(get-time% dt) +(define* (datetime->sexp dt optional: verbose) + `(datetime date: ,(if verbose (date->sexp (get-date dt)) (get-date dt)) + time: ,(if verbose (time->sexp (get-time% dt)) (get-time% dt)) tz: ,(tz dt))) (define (date-reader chr port) (unread-char chr port) (let ((line (symbol->string (read port)))) (cond [(string-contains line "T") - (-> line string->datetime datetime->sexp)] + (-> line string->datetime (datetime->sexp #t))] [(string-contains line ":") (-> line string->time time->sexp)] [(string-contains line "-") @@ -1084,6 +1084,14 @@ tz: (get-timezone base) ))) +(define-public (datetime- base change) + (let* ((time underflow (time- (get-time% base) (get-time% change)))) + (datetime date: (date- (get-date base) + (get-date change) + (date day: underflow)) + time: time + tz: (tz base)))) + ;;; the *-difference procedures takes two actual datetimes. ;;; date- instead takes a date and a delta (but NOT an actual date). diff --git a/tests/datetime.scm b/tests/datetime.scm index 0cbb130d..463feb95 100644 --- a/tests/datetime.scm +++ b/tests/datetime.scm @@ -85,6 +85,16 @@ (datetime+ (datetime date: #2020-01-01) (datetime time: #10:00:00))) +(test-equal + #2020-10-09T14:00:00 + (datetime- #2020-10-10T00:00:00 + (datetime time: #10:00:00))) + +(test-equal + #2020-09-24T14:00:00 + (datetime- #2020-10-10T00:00:00 + #0000-00-15T10:00:00)) + (test-equal #2020-03-10 (date+ #2020-03-01 |