From 060f31bab987ca20df5977f9351ee87dc44e423b 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:09:19 +0200
Subject: Modify config to store return of #:pre.

---
 module/datetime/util.scm |  2 +-
 module/output/html.scm   |  4 ++--
 module/util/config.scm   | 19 ++++++++++++++-----
 module/vcomponent.scm    |  8 ++++++--
 4 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/module/datetime/util.scm b/module/datetime/util.scm
index 6b0a8411..a7af4a5a 100644
--- a/module/datetime/util.scm
+++ b/module/datetime/util.scm
@@ -105,7 +105,7 @@
 
 (define-config week-start sun
   "First day of week"
-  pre: (lambda (x) (<= sun x sat))
+  pre: (ensure (lambda (x) (<= sun x sat)))
   post: week-start)
 
 ;; given a date, returns the date the first week of that year starts on.
diff --git a/module/output/html.scm b/module/output/html.scm
index 8ca831f0..15aa9ac0 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -26,11 +26,11 @@
 
 (define-config summary-filter (lambda (_ a) a)
   ""
-  pre: procedure?)
+  pre: (ensure procedure?))
 
 (define-config description-filter (lambda (_ a) a)
   ""
-  pre: procedure?)
+  pre: (ensure procedure?))
 
 (define debug (make-parameter #f))
 
diff --git a/module/util/config.scm b/module/util/config.scm
index af93ef41..6d2d9ab8 100644
--- a/module/util/config.scm
+++ b/module/util/config.scm
@@ -8,10 +8,12 @@
 ;;; Code:
 
 (define-module (util config)
+  :use-module (srfi srfi-1)
   :use-module (srfi srfi-9)
   :use-module (srfi srfi-26)
   :use-module (ice-9 match)
   :use-module (ice-9 format)
+  :use-module (ice-9 curried-definitions)
   :use-module (util)
   :use-module (util exceptions)
                )
@@ -76,20 +78,27 @@
        (cadr it)
        default))
 
+(define-public ((ensure predicate) value)
+  (if (not (predicate value))
+      #f value))
+
 (define-public (set-config! key value)
   (cond [(hashq-ref config-values key)
          => (lambda (conf)
-              (aif (not ((config-attribute conf #:pre (const #t))
-                         value))
+              (aif (or (not value)
+                       ((config-attribute conf #:pre identity)
+                        value))
+                   (begin
+                     (set-value! conf it)
+                     ((config-attribute conf #:post identity) it))
+
                    (scm-error 'config-error 'define-config
                               "Config [~a]: ~a doesn't sattisfy predicate ~s~%\"~a\"~%"
                               (list (quote ,name)
                                     value
                                     (get-documentation conf))
                               (list value))
-                   (begin
-                     (set-value! conf value)
-                     ((config-attribute conf #:post identity) value))))]
+                   ))]
         [else (hashq-set! config-values key (make-unconfig value))]))
 
 ;; unique symbol here since #f is a valid configuration value.
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index e4a0141a..61168e70 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -16,8 +16,12 @@
 
 (re-export-modules (vcomponent base))
 
-(define-config calendar-files '() ""
-  pre: list?)
+(define-config calendar-files '()
+  "Which files to parse. Takes a list of paths or a single string which will be globbed."
+  pre: (lambda (v)
+         (cond [(list? v) v]
+               [(string? v) ((@ (glob) glob) v)]
+               [else #f])))
 
 (define-public (load-calendars calendar-files)
   (map parse-cal-path calendar-files))
-- 
cgit v1.2.3