From 1cf8daa95e821fa6894a253287a4271897a99fc5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 11 Aug 2020 16:29:14 +0200
Subject: Add script for finding config entries.

---
 scripts/get-config.scm | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 69 insertions(+)
 create mode 100755 scripts/get-config.scm

(limited to 'scripts')

diff --git a/scripts/get-config.scm b/scripts/get-config.scm
new file mode 100755
index 00000000..6d9c3290
--- /dev/null
+++ b/scripts/get-config.scm
@@ -0,0 +1,69 @@
+#!/usr/bin/guile \
+-s
+!#
+
+;;; Commentary:
+;;; Script for finding all top level `config' forms. Run this from the
+;;; project root.
+;;; Code:
+
+
+(add-to-load-path "module")
+
+(use-modules 
+  (util) 
+  (ice-9 ftw) 
+  (ice-9 match)
+  (srfi srfi-1)
+  )
+
+(define (read-multiple)
+  (let loop ((done '()))
+    (let ((sexp (read)))
+      (if (eof-object? sexp)
+          (reverse done)
+          (loop (cons sexp done))))))
+
+(define remove-stat
+  (match-lambda
+    ((name state) name)
+    ((name stat children ...)
+     (cons name (map remove-stat children)))))
+
+(define (f tree)
+  (let loop ((rem tree) (path '()))
+    (cond [(string? rem)
+           (string-join (reverse (cons rem path)) "/" 'infix)]
+          [(null? rem)
+           '()]
+          [else
+           (map (lambda (branch)
+                  (loop branch (cons (car rem) path)))
+                (cdr rem))])))
+
+
+((@ (ice-9 pretty-print) pretty-print)
+ (filter
+  (lambda (form)
+    (and (list? form) (not (null? form))
+         (eq? 'define-config (car form))))
+  (concatenate
+   (map (lambda (filename) (with-input-from-file filename read-multiple))
+        (flatten (f (remove-stat (file-system-tree "module"))))))))
+
+;; expected result =>
+#;
+((config debug)
+ (config edit-mode)
+ (config summary-filter)
+ (config description-filter)
+ (config
+   tz-dir
+   "Directory in which zoneinfo files can be found")
+ (config
+   tz-list
+   "List of default zoneinfo files to be parsed")
+ (config default-week-start "First day of week")
+ (config
+   calendar-files
+   "Which files to parse. Takes a list of paths or a single string which will be globbed."))
-- 
cgit v1.2.3