From f8a20883d10370529b2cc468816530587fb53bad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 16 Apr 2020 23:08:30 +0200 Subject: Add datetime functions for working with week numbers. --- module/datetime/util.scm | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) (limited to 'module/datetime') diff --git a/module/datetime/util.scm b/module/datetime/util.scm index dda2b1ad..17d4f4da 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -13,6 +13,10 @@ (define-public (start-of-month date) (set (day date) 1)) +(define-public (start-of-year date) + (set-> date + (day 1) + (month 1))) (define-public (parse-freeform-date str) (let* (((year month day) (map string->number (string-split str #\-)))) @@ -102,7 +106,36 @@ (sat) 6 ) + +;; TODO parameter for default week start? + +;; given a date, returns the date the first week of that year starts on. +;; @example +;; (week-1-start #2020-04-01 mon) +;; ⇒ 2019-12-30 +;; @end example +(define*-public (week-1-start d optional: (wkst sun)) + (let* ((ystart (start-of-year d)) + (day-index (- (week-day ystart) + wkst))) + (if (> 0 day-index) + (date+ ystart (date day: (abs day-index))) + (date- ystart (date day: day-index))))) + +(define*-public (week-number date optional: (wkst sun)) + (let* ((week day (floor/ (days-in-interval (week-1-start date wkst) date) + 7))) + (if (zero? day) + week (1+ week)))) + + +(define*-public (date-starting-week week-number d optional: (wkst sun)) + (date+ (week-1-start d wkst) + (date day: (* week-number 7)))) + + (define*-public (week-day-name week-day-number optional: truncate-to) + ;; NOTE this allows days larger than 7 (sunday if counting from monday). (let ((str (catch 'out-of-range (lambda () (locale-day (1+ (modulo week-day-number 7)))) -- cgit v1.2.3