From 8538b3b269a03b9601ba0710435927787b318bec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 23 Jun 2022 02:26:23 +0200
Subject: Clean up (calp util config).

Introduced define-once-public. While only used once, removes a weird
export which was previously easily missed.
---
 module/calp/util/config.scm | 59 +++++++++++++++++++++++----------------------
 1 file changed, 30 insertions(+), 29 deletions(-)

diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm
index b2a46ea7..aba2cd2c 100644
--- a/module/calp/util/config.scm
+++ b/module/calp/util/config.scm
@@ -9,8 +9,7 @@
   :use-module (srfi srfi-1)
   :use-module (ice-9 curried-definitions) ; for ensure
   :use-module (calp translation)
-  :export (define-config)
-)
+  :export (define-config ensure))
 
 (define (fix-keywords args)
   (map (lambda (arg)
@@ -22,43 +21,45 @@
 (define %configuration-error
   (_ "Pre-property failed when setting ~s to ~s"))
 
+(define-syntax-rule (define-once-public symbol binding)
+  (begin (define-once symbol binding)
+         (export symbol)))
+
 (define-syntax (define-config stx)
   (syntax-case stx ()
     ((_ name default kw ...)
      (let ((pre  (cond ((memv pre:  (fix-keywords #'(kw ...))) => cadr) (else #f)))
            (post (cond ((memv post: (fix-keywords #'(kw ...))) => cadr) (else #f))))
-       #`(begin
-           (define-once name
-            (make-parameter
-             default
-             #,@(cond ((and pre post)
-                       #`((lambda (new-value)
-                            (cond ((#,pre new-value)
-                                   => (lambda (translated)
-                                        (#,post translated)
-                                        translated))
-                                  (else
-                                   (scm-error 'configuration-error
-                                              "set-config!"
-                                              %configuration-error
-                                              (list (quote name) new-value)))))))
-                      (pre
-                       #`((lambda (new-value)
-                            (or (#,pre new-value)
+       #`(define-once-public name
+         (make-parameter
+          default
+          #,@(cond ((and pre post)
+                    #`((lambda (new-value)
+                         (cond ((#,pre new-value)
+                                => (lambda (translated)
+                                     (#,post translated)
+                                     translated))
+                               (else
                                 (scm-error 'configuration-error
                                            "set-config!"
                                            %configuration-error
-                                           (list (quote name) new-value))))))
-                      (post
-                       #`((lambda (new-value)
-                            (#,post new-value)
-                            new-value))
-                       )
-                      (else #'()))))
-           (export name))))))
+                                           (list (quote name) new-value)))))))
+                   (pre
+                    #`((lambda (new-value)
+                         (or (#,pre new-value)
+                             (scm-error 'configuration-error
+                                        "set-config!"
+                                        %configuration-error
+                                        (list (quote name) new-value))))))
+                   (post
+                    #`((lambda (new-value)
+                         (#,post new-value)
+                         new-value))
+                    )
+                   (else #'()))))))))
 
 
 
-(define-public ((ensure predicate) value)
+(define ((ensure predicate) value)
   (if (predicate value)
       value #f))
-- 
cgit v1.2.3