diff options
| -rw-r--r-- | ravanan/work/ui.scm | 52 |
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)) |