From 01527c7b52e80541e7f87b589feb950ec833ac76 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 1 Jun 2020 13:11:17 +0200
Subject: Fix configuration help, print with --help.

---
 module/util/config.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 49 insertions(+), 6 deletions(-)

(limited to 'module/util')

diff --git a/module/util/config.scm b/module/util/config.scm
index 6d2d9ab8..a5d29f8e 100644
--- a/module/util/config.scm
+++ b/module/util/config.scm
@@ -114,15 +114,58 @@
         (get-value v)
         v)))
 
-
-(define-public (print-configuration-documentation)
+;; (format-procedure (lambda (x y) ...)) => λx, y
+;; (define (f x) ...)
+;; (format-procedure f) => f(x)
+(define (format-procedure proc)
+  ((aif (procedure-name proc)
+        (lambda (s) (string-append (symbol->string it) "(" s ")"))
+        (lambda (s) (string-append "λ" s)))
+   (let ((args ((@ (ice-9 session) procedure-arguments)
+                proc)))
+     (string-join
+      (remove null?
+              (list
+               (awhen ((ensure (negate null?))
+                       (assoc-ref args 'required))
+                      (format #f "~{~a~^, ~}" it))
+               (awhen ((ensure (negate null?))
+                       (assoc-ref args 'optional))
+                      (format #f "[~{~a~^, ~}]" it))
+               (awhen ((ensure (negate null?))
+                       (assoc-ref args 'keyword))
+                      (format #f "key: ~{~a~^, ~}"
+                              (map keyword->symbol
+                                   (map car it))))
+               (awhen ((ensure (negate null?))
+                       (assoc-ref args 'rest))
+                      (format #f "~a ..." it))))
+      ", "))))
+
+(export format-procedure)
+
+(define-public (get-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)))))
+
+
+  `(*TOP*
+    (header "Configuration variables")
+    (dl
+     ,@(concatenate
+        (for (module values) in groups
+             `((dt "") (dd (header ,(format #f "~a" (module-name module))))
+               ,@(concatenate
+                  (for (key value) in values
+                       `((dt ,key)
+                         (dd (p (@ (inline)) ,(get-documentation value)))
+                         (dt "V:")
+                         (dd ,(let ((v (get-value value)))
+                                (if (procedure? v)
+                                    (format-procedure v)
+                                    `(scheme ,v)))
+                             (br)))))))))))
-- 
cgit v1.2.3