diff options
-rwxr-xr-x | chicken-heredoc.scm | 60 |
1 files changed, 60 insertions, 0 deletions
diff --git a/chicken-heredoc.scm b/chicken-heredoc.scm new file mode 100755 index 0000000..e0e55ad --- /dev/null +++ b/chicken-heredoc.scm | |||
@@ -0,0 +1,60 @@ | |||
1 | #!/bin/sh | ||
2 | #| -*- scheme -*- | ||
3 | exec csi -ss "$0" "$@" | ||
4 | heredocs for chicken | ||
5 | idea-https://git.sr.ht/~evhan/beaker/tree/master/item/aux/generate-wiki-page.scm | ||
6 | |# | ||
7 | |||
8 | (import (only (chicken irregex) | ||
9 | irregex-replace/all | ||
10 | irregex-search) | ||
11 | (only (chicken io) | ||
12 | read-string) | ||
13 | (only (chicken port) | ||
14 | make-concatenated-port) | ||
15 | (only (chicken random) | ||
16 | pseudo-random-real) | ||
17 | (only (chicken time) | ||
18 | current-seconds)) | ||
19 | |||
20 | (define filestr | ||
21 | (make-parameter #f)) | ||
22 | |||
23 | (define def-end | ||
24 | (make-parameter "&def-end")) | ||
25 | |||
26 | (define (randomizer #!optional str) | ||
27 | (let ((base (number->string (+ (current-seconds) | ||
28 | (pseudo-random-real))))) | ||
29 | (if (and str (irregex-search base str)) | ||
30 | (randomizer str) | ||
31 | base))) | ||
32 | |||
33 | (define-syntax def | ||
34 | (syntax-rules () | ||
35 | ((def var val) | ||
36 | ;; I'm pretty sure this only works in CHICKEN. | ||
37 | (begin (set! var val) | ||
38 | (def-end))))) | ||
39 | |||
40 | (define (heredoc-expand file) | ||
41 | (let* ((delim (string-append "END-" (randomizer))) | ||
42 | (template (make-concatenated-port | ||
43 | (open-input-string (string-append "#<#" delim "\n")) | ||
44 | (open-input-file file) | ||
45 | (open-input-string (string-append "\n" delim "\n")))) | ||
46 | (expanded (open-output-string)) | ||
47 | (str (begin | ||
48 | (display (eval (read template)) expanded) | ||
49 | (get-output-string expanded)))) | ||
50 | (irregex-replace/all `(seq ,(def-end) (* "\n")) | ||
51 | str | ||
52 | ""))) | ||
53 | |||
54 | (define (main args) | ||
55 | (for-each (lambda (f) | ||
56 | ;; Is this overkill? Maybe.... | ||
57 | (parameterize ((filestr (with-input-from-file f read-string))) | ||
58 | (parameterize ((def-end (randomizer (filestr)))) | ||
59 | (display (heredoc-expand f))))) | ||
60 | args)) | ||