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 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'module/datetime.scm') 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). -- cgit v1.2.3