[shepherd] 07/07: herd: Make 'status' output more colorful.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 3ee3fadda42a71d382797b087002405b54361db0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 19 19:05:18 2023 +0200

    herd: Make 'status' output more colorful.
    
    * modules/shepherd/colors.scm (highlight/error): New variable.
    * modules/shepherd/scripts/herd.scm (display-status-summary)
    (display-service-status): Use the highlight procedures.
---
 modules/shepherd/colors.scm       |  2 ++
 modules/shepherd/scripts/herd.scm | 21 ++++++++++++---------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/modules/shepherd/colors.scm b/modules/shepherd/colors.scm
index 60c8b88..2e03d7f 100644
--- a/modules/shepherd/colors.scm
+++ b/modules/shepherd/colors.scm
@@ -33,6 +33,7 @@
             colorize-string
             highlight
             highlight/warn
+            highlight/error
             dim
 
             colorize-full-matches
@@ -158,6 +159,7 @@ that subsequent output will not have any colors in effect."
 
 (define highlight (coloring-procedure (color BOLD)))
 (define highlight/warn (coloring-procedure (color BOLD MAGENTA)))
+(define highlight/error (coloring-procedure (color BOLD RED)))
 (define dim (coloring-procedure (color DARK)))
 
 (define (colorize-full-matches rules)
diff --git a/modules/shepherd/scripts/herd.scm 
b/modules/shepherd/scripts/herd.scm
index 30a163e..a840291 100644
--- a/modules/shepherd/scripts/herd.scm
+++ b/modules/shepherd/scripts/herd.scm
@@ -22,6 +22,7 @@
   #:use-module (shepherd support)
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
+  #:use-module (shepherd colors)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -77,18 +78,18 @@ of pairs."
                                 (and=> (assoc-ref properties 'startup-failures)
                                        (compose pair? car))))
                              stopped)))
-    (display-services (l10n "Started:\n") "+"
+    (display-services (highlight (l10n "Started:\n")) "+"
                       started)
-    (display-services (l10n "Stopped:\n") "-"
+    (display-services (highlight (l10n "Stopped:\n")) "-"
                       stopped)
 
     ;; TRANSLATORS: Here "one-shot" refers to "one-shot services".  These are
     ;; services that are immediately marked as stopped once their 'start'
     ;; method has completed.
-    (display-services (l10n "One-shot:\n") "*"
+    (display-services (highlight (l10n "One-shot:\n")) "*"
                       one-shot)
 
-    (display-services (l10n "Failed to start:\n") "!"
+    (display-services (highlight/error (l10n "Failed to start:\n")) "!"
                       failing)))
 
 (define (display-detailed-status services)
@@ -102,7 +103,7 @@ of pairs."
      (alist-let* properties (provides requires status running respawn? enabled?
                              last-respawns startup-failures
                              one-shot? transient?)
-       (format #t (l10n "Status of ~a:~%") (first provides))
+       (format #t (highlight (l10n "Status of ~a:~%")) (first provides))
 
        ;; Note: Shepherd up to 0.9.x included did not provide 'status', hence
        ;; the 'or' below.
@@ -120,8 +121,10 @@ of pairs."
           (if one-shot?
               (format #t (l10n "  It is stopped (one-shot).~%"))
               (if (pair? startup-failures)
-                  (format #t (l10n "  It is stopped (failing).~%"))
-                  (format #t (l10n "  It is stopped.~%")))))
+                  (format #t (highlight/error
+                              (l10n "  It is stopped (failing).~%")))
+                  (format #t (highlight/warn
+                              (l10n "  It is stopped.~%"))))))
          ('starting
           (format #t (l10n "  It is starting.~%")))
          ('stopping
@@ -131,7 +134,7 @@ of pairs."
 
        (if enabled?
            (format #t (l10n "  It is enabled.~%"))
-           (format #t (l10n "  It is disabled.~%")))
+           (format #t (highlight/warn (l10n "  It is disabled.~%"))))
        (format #t (l10n "  Provides ~a.~%") provides)
        (format #t (l10n "  Requires ~a.~%") requires)
        (if respawn?
@@ -146,7 +149,7 @@ of pairs."
        (when (or (eq? status 'stopped) (not running))
          (match startup-failures
            ((time _ ...)
-            (format #t (l10n "  Failed to start at ~a.~%")
+            (format #t (highlight/error (l10n "  Failed to start at ~a.~%"))
                     (date->string
                      (time-utc->date (make-time time-utc 0 time)))))
            (_ #t)))))))