From eb7bcbe84fa6f40202ab22a77318eb1034630e1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 25 Mar 2020 00:04:31 +0100 Subject: Improve *->decimal-hour procedures. --- module/datetime/util.scm | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) (limited to 'module/datetime/util.scm') diff --git a/module/datetime/util.scm b/module/datetime/util.scm index c8d199c9..9a04c99b 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -3,6 +3,7 @@ :use-module (srfi srfi-1) :use-module (srfi srfi-26) :use-module (srfi srfi-41) + :use-module (srfi srfi-41 util) :use-module (util) ) @@ -299,3 +300,35 @@ (map (lambda (d) (set (day (month+ date)) d)) (iota (modulo (- (* 7 5) month-len month-start) 7) 1))))) + + + +(define-public (days-in-interval start-date end-date) + (let ((diff (date-difference (date+ end-date (date day: 1)) start-date))) + (with-streams + (fold + (day diff) + (map days-in-month + (take (+ (month diff) + (* 12 (year diff))) + (month-stream start-date))))))) + +;; @example +;; (time->decimal-hour #10:30:00) ; => 10.5 +;; @end example +(define-public (time->decimal-hour time) + (exact->inexact (+ (hour time) + (/ (minute time) 60) + (/ (second time) 3600)))) + +(define*-public (datetime->decimal-hour dt optional: start-date) + + (let ((date-diff + (cond [start-date + (let* ((end-date (date+ start-date (get-date dt)))) + (days-in-interval start-date end-date)) ] + [(or (not (zero? (month (get-date dt)))) + (not (zero? (year (get-date dt))))) + (error "Multi-month intervals only supported when start-date is given" dt)] + [else (day (get-date dt))]))) + (+ (time->decimal-hour ((@ (datetime) get-time%) dt)) + (* (1- date-diff) 24)))) -- cgit v1.2.3