diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:08:30 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-16 23:08:30 +0200 |
commit | f8a20883d10370529b2cc468816530587fb53bad (patch) | |
tree | b7ef8e9c821d43a7aed5260162dc4ee5cbb457ca /module/datetime | |
parent | Fix date-difference when changing year. (diff) | |
download | calp-f8a20883d10370529b2cc468816530587fb53bad.tar.gz calp-f8a20883d10370529b2cc468816530587fb53bad.tar.xz |
Add datetime functions for working with week numbers.
Diffstat (limited to 'module/datetime')
-rw-r--r-- | module/datetime/util.scm | 33 |
1 files changed, 33 insertions, 0 deletions
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)))) |