[shepherd] 03/06: herd: Display upcoming timer alarms.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit f5fd34403fdb616437b14327e1b98e3decd812bc
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Mar 23 23:36:38 2024 +0100

    herd: Display upcoming timer alarms.
    
    * modules/shepherd/service/timer.scm (sexp->calendar-event): New
    procedure.
    * modules/shepherd/scripts/herd.scm (time->string): Make ‘now*’ an
    optional parameter.  Add clauses for ELAPSED < 0.
    (display-timer-events): New procedure.
    (display-service-status): Use it.
---
 modules/shepherd/scripts/herd.scm  | 53 +++++++++++++++++++++++++++++++++-----
 modules/shepherd/service/timer.scm | 16 ++++++++++++
 2 files changed, 62 insertions(+), 7 deletions(-)

diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 9c6b768..78917af 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -26,7 +26,9 @@
   #:autoload   (shepherd service timer) (sexp->command
                                          command?
                                          command-arguments
-                                         command-user)
+                                         command-user
+                                         next-calendar-event
+                                         sexp->calendar-event)
   #:use-module (ice-9 format)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
@@ -184,11 +186,8 @@ transient status for too long."
                                       #:show-recent-messages? #f))
             services))
 
-(define (time->string time)
+(define* (time->string time #:optional (now* (current-time time-utc)))
   "Return a string representing TIME in a concise, human-readable way."
-  (define now*
-    (current-time time-utc))
-
   (define now
     (time-second now*))
 
@@ -196,7 +195,25 @@ transient status for too long."
     (- now time))
 
   (define relative
-    (cond ((< elapsed 120)
+    (cond ((< elapsed (* -48 3600))
+           (let ((days (inexact->exact
+                        (round (/ elapsed (* -3600 24))))))
+             (format #f (l10n "in ~a day" "in ~a days" days)
+                     days)))
+          ((< elapsed -7200)
+           (let ((hours (inexact->exact
+                         (round (/ elapsed -3600)))))
+             (format #f (l10n "in ~a hour" "in ~a hours" hours)
+                     hours)))
+          ((< elapsed -120)
+           (let ((minutes (inexact->exact
+                           (round (/ elapsed -60)))))
+             (format #f (l10n "in ~a minute" "in ~a minutes" minutes)
+                     minutes)))
+          ((< elapsed 0)
+           (format #f (l10n "in ~a second" "in ~a seconds" (abs elapsed))
+                   (abs elapsed)))
+          ((< elapsed 120)
            (format #f (l10n "~a second ago" "~a seconds ago" elapsed)
                    elapsed))
           ((< elapsed 7200)
@@ -283,6 +300,19 @@ human-friendly way."
                        (l10n "Process stopped with signal ~a.~%"))
                    signal)))))
 
+(define* (display-timer-events event #:optional (count 5))
+  "Display the @var{count} upcoming timer alarms that match @var{event}, a
+calendar event."
+  (let loop ((n 0)
+             (date (current-date)))
+    (when (< n count)
+      (let ((next (next-calendar-event event date))
+            (now  (current-time time-utc)))
+        (format #t "  ~a~%"
+                (time->string (time-second (date->time-utc next))
+                              now))
+        (loop (+ n 1) next)))))
+
 (define* (display-service-status service
                                  #:key
                                  (show-recent-messages? #t)
@@ -458,7 +488,16 @@ human-friendly way."
                             (strftime default-logfile-date-format
                                       (localtime time))
                             line)))
-                 (reverse (at-most log-history-size messages)))))))
+                 (reverse (at-most log-history-size messages)))))
+
+    (match (live-service-running-value service)
+      (('timer ('version 0) ('event sexp) _ ...)
+       (let ((event (and=> sexp sexp->calendar-event)))
+         (when event
+           (newline)
+           (format #t (highlight (l10n "Upcoming timer alarms:~%")))
+           (display-timer-events event))))
+      (_ #t))))
 
 (define (display-event-log services)
   "Display status changes of @var{services} as a chronologically-sorted log."
diff --git a/modules/shepherd/service/timer.scm 
b/modules/shepherd/service/timer.scm
index 45627dd..539aea3 100644
--- a/modules/shepherd/service/timer.scm
+++ b/modules/shepherd/service/timer.scm
@@ -36,6 +36,7 @@
             calendar-event-hours
             calendar-event-minutes
             calendar-event-seconds
+            sexp->calendar-event
 
             next-calendar-event
 
@@ -327,6 +328,21 @@ list, to be executed as @var{user} and @var{group}, with 
the given
                    (days-of-week ,(calendar-event-days-of-week event))
                    (months ,(calendar-event-months event))))
 
+(define (sexp->calendar-event sexp)
+  "Return the calendar event deserialized from @var{sexp}.  Return #f if
+@var{sexp} is not recognized as a valid calendar event sexp."
+  (match sexp
+    (`(calendar-event (version 0)
+                      (seconds ,seconds)
+                      (minutes ,minutes)
+                      (hours ,hours)
+                      (days-of-month ,days-of-month)
+                      (days-of-week ,days-of-week)
+                      (months ,months))
+     (%calendar-event seconds minutes hours days-of-month months
+                      days-of-week))
+    (_ #f)))
+
 (define (command->sexp command)
   `(command (version 0)
             (arguments ,(command-arguments command))