From b72f967841fec5f34e6c806bfe8b5824e6d6a2c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Jul 2020 23:15:43 +0200 Subject: Add datetime-. --- module/datetime.scm | 16 ++++++++++++---- 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 -- cgit v1.2.3