civodul pushed a commit to branch devel
in repository shepherd.
commit 8bfae35576bdd67998b727e37f84d0162fe61f03
Author: Ludovic Courtès <[email protected]>
AuthorDate: Tue Mar 26 00:29:41 2024 +0100
timer: Streamline representation of #:days-of-week.
This removes the special case where the ‘days-of-week’ field could be #f.
* modules/shepherd/service/timer.scm (any-day-of-week): New variable.
(calendar-event): Use it as the default #:days-of-week value.
(next-calendar-event)[day]: Adjust accordingly.
---
modules/shepherd/service/timer.scm | 23 ++++++++++++-----------
1 file changed, 12 insertions(+), 11 deletions(-)
diff --git a/modules/shepherd/service/timer.scm
b/modules/shepherd/service/timer.scm
index 068a93f..e5489d7 100644
--- a/modules/shepherd/service/timer.scm
+++ b/modules/shepherd/service/timer.scm
@@ -76,15 +76,15 @@
(define any-minute (iota 60))
(define any-hour (iota 24))
(define any-day-of-month (iota 31 1))
+(define any-day-of-week (iota 7))
(define any-month (iota 12 1))
(define* (calendar-event #:key
(seconds '(0))
(minutes any-minute)
(hours any-hour)
- days-of-week
- (days-of-month
- (and (not days-of-week) any-day-of-month))
+ (days-of-week any-day-of-week)
+ (days-of-month any-day-of-month)
(months any-month))
"Return a calendar event that obeys the given constraints."
(%calendar-event seconds minutes hours days-of-month months days-of-week))
@@ -241,14 +241,15 @@ event record."
(fit-month date (calendar-event-months event))))
(define (day date)
- (let ((days (append
- (or (calendar-event-days-of-month event) '())
- (match (calendar-event-days-of-week event)
- (#f
- '())
- (days (week-days->month-days days
- (date-month date)
- (date-year date)))))))
+ (let ((days (if (eq? (calendar-event-days-of-week event)
+ any-day-of-week)
+ (calendar-event-days-of-month event)
+ (lset-intersection
+ =
+ (calendar-event-days-of-month event)
+ (week-days->month-days (calendar-event-days-of-week event)
+ (date-month date)
+ (date-year date))))))
(if (memv (date-day date) days)
date
(fit-day date days))))
