diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-11 16:29:14 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-12 01:25:06 +0200 |
commit | 1cf8daa95e821fa6894a253287a4271897a99fc5 (patch) | |
tree | b0e660d7b7624f05bf428d26e11b55b72cf51abd | |
parent | fixups in (util config). (diff) | |
download | calp-1cf8daa95e821fa6894a253287a4271897a99fc5.tar.gz calp-1cf8daa95e821fa6894a253287a4271897a99fc5.tar.xz |
Add script for finding config entries.
-rwxr-xr-x | scripts/get-config.scm | 69 |
1 files changed, 69 insertions, 0 deletions
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.")) |