From c78c20a156487c8f43f10b6f02f05a24060d1c56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 20 Apr 2020 02:14:57 +0200 Subject: Add some week handling procedures. --- module/datetime/util.scm | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) (limited to 'module') 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))))) -- cgit v1.2.3