[shepherd] 02/05: timer: Streamline representation of #:days-of-week.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 8bfae35576bdd67998b727e37f84d0162fe61f03
Author: Ludovic Courtès <ludo@gnu.org>
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))))