work/ui: Implement logging system.

Implement logging system with five log levels. Rewrite warning and
user-error in terms of the new logging functions.

1 files changed, 47 insertions, 5 deletions

diff --git a/ravanan/work/ui.scm b/ravanan/work/ui.scm
index 758f2cc..5a9ceeb 100644
--- a/ravanan/work/ui.scm
+++ b/ravanan/work/ui.scm
@@ -1,5 +1,5 @@
 ;;; ravanan --- High-reproducibility CWL runner powered by Guix
-;;; Copyright © 2024 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024, 2025 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of ravanan.
 ;;;
@@ -17,16 +17,58 @@
 ;;; along with ravanan.  If not, see <https://www.gnu.org/licenses/>.
 
 (define-module (ravanan work ui)
-  #:export (warning
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (%log-level
+            log
+            log-debug
+            log-info
+            log-warning
+            log-error
+            log-critical
+            warning
             user-error))
 
+(define %log-level
+  (make-parameter #f))
+
+(define (log-level>=? level1 level2)
+  "Return @code{#t} if log @var{level1} has greater than or equal severity to log
+@var{level2}. Else, return @code{#f}."
+  (let ((levels '(debug info warning error critical)))
+    (>= (list-index (cut eq? level1 <>) levels)
+        (list-index (cut eq? level2 <>) levels))))
+
+(define (log level fmt . args)
+  "Log message when current log level is not @code{#f} and @var{level} has greater
+than or equal severity to the current log level. @var{fmt} and @var{args} are
+arguments to @code{format}."
+  (when (and (%log-level)
+             (log-level>=? level (%log-level)))
+    (apply format (current-error-port) fmt args)
+    (newline)))
+
+(define log-debug
+  (cut log 'debug <> <...>))
+
+(define log-info
+  (cut log 'info <> <...>))
+
+(define log-warning
+  (cut log 'warning <> <...>))
+
+(define log-error
+  (cut log 'error <> <...>))
+
+(define log-critical
+  (cut log 'critical <> <...>))
+
 (define (warning fmt . args)
   "Print warning. @var{fmt} and @var{args} are arguments to format."
-  (apply format (current-error-port) fmt args)
-  (newline))
+  (apply log-warning fmt args))
 
 (define (user-error fmt . args)
   "Print error message and exit with failure. @var{fmt} and @var{args} are
 arguments to format."
-  (apply warning fmt args)
+  (apply log-error fmt args)
   (exit #f))