diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-20 02:14:57 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-20 02:14:57 +0200 |
| commit | c78c20a156487c8f43f10b6f02f05a24060d1c56 (patch) | |
| tree | 39fe9d385f29ff71d6a10c7fe94a79b3d9ac884a | |
| parent | Add year-day function. (diff) | |
| download | calp-c78c20a156487c8f43f10b6f02f05a24060d1c56.tar.gz calp-c78c20a156487c8f43f10b6f02f05a24060d1c56.tar.xz | |
Add some week handling procedures.
| -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))))) |