diff options
-rw-r--r-- | module/datetime/util.scm | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/module/datetime/util.scm b/module/datetime/util.scm index 57b2acf4..4e781806 100644 --- a/module/datetime/util.scm +++ b/module/datetime/util.scm @@ -336,3 +336,23 @@ (define-config week-start sun "First day of week" (lambda (x) (<= sun x sat))) + + +;; Returns the first instance of the given week-day in the given month. +;; @example +;; (find-first-week-day mon #2020-04-10) +;; => 2020-04-06 +;; @end example +(define-public (find-first-week-day wday month-date) + (let* ((mstart (start-of-month month-date)) + (start-day (week-day mstart)) + (diff (- wday start-day))) + (date+ mstart (date day: (modulo diff 7))))) + +;; returns instances of the given week-day in month. +;; week-day, date → (list date) +(define-public (all-wday-in-month wday month-date) + (stream->list + (stream-take-while + (lambda (d) (= (month d) (month month-date))) + (week-stream (find-first-week-day wday month-date))))) |