From ba92fcb1b0b707b73ddc367b896ebdb6533d3be9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 1 Apr 2020 21:00:44 +0200 Subject: Add set-config! and get-config, along with print for debug. --- module/util/config.scm | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) (limited to 'module') diff --git a/module/util/config.scm b/module/util/config.scm index d7b29c55..fbf2bebe 100644 --- a/module/util/config.scm +++ b/module/util/config.scm @@ -9,8 +9,10 @@ (define-module (util config) :use-module (srfi srfi-9) + :use-module (srfi srfi-26) + :use-module (ice-9 match) + :use-module (ice-9 format) :use-module (util) - :export (register-config!) ) (define-public (ensure pred?) @@ -20,6 +22,8 @@ v (or (procedure-name pred?) "")))) v)) + + (define-once config-values (make-hash-table)) (define-record-type @@ -55,3 +59,33 @@ ,valid-value? (current-module)))]))) (export define-config) + +(define-public (set-config! key value) + (cond [(hashq-ref config-values key) + => (cut set-value! <> value)] + [else (hashq-set! config-values key value)])) + +(define %uniq (gensym)) +(define*-public (get-config key optional: (default %uniq)) + (let ((v (if (eq? default %uniq) + (let ((v (hashq-ref config-values key %uniq))) + (when (eq? v %uniq) + (error "Missing config" key)) + v) + (hashq-ref config-values key default)))) + (if (config? v) + (get-value v) + v))) + + +(define-public (print-configuration-documentation) + (define groups + (group-by (match-lambda [(__ v) + (if (config? v) + (get-source-module v) + #f)]) + (hash-map->list list config-values )) ) + (for (module values) in groups + (format #t "~%~a~%" (module-name module)) + (for (key value) in values + (format #t " ~20,a | ~a~%" key (get-documentation value))))) -- cgit v1.2.3