3 files changed, 104 insertions, 60 deletions

@@ -0,0 +1,26 @@
+Copyright 2023 Case Duckworth
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its contributors
+   may be used to endorse or promote products derived from this software without
+   specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file
@@ -1,60 +0,0 @@
-#!/bin/sh
-#| -*- scheme -*-
-exec csi -ss "$0" "$@"
-heredocs for chicken
-idea-https://git.sr.ht/~evhan/beaker/tree/master/item/aux/generate-wiki-page.scm
-|#
-
-(import (only (chicken irregex)
-              irregex-replace/all
-              irregex-search)
-        (only (chicken io)
-              read-string)
-        (only (chicken port)
-              make-concatenated-port)
-        (only (chicken random)
-              pseudo-random-real)
-        (only (chicken time)
-              current-seconds))
-
-(define filestr
-  (make-parameter #f))
-
-(define def-end
-  (make-parameter "&def-end"))
-
-(define (randomizer #!optional str)
-  (let ((base (number->string (+ (current-seconds)
-                                 (pseudo-random-real)))))
-    (if (and str (irregex-search base str))
-        (randomizer str)
-        base)))
-
-(define-syntax def
-  (syntax-rules ()
-    ((def var val)
-     ;; I'm pretty sure this only works in CHICKEN.
-     (begin (set! var val)
-            (def-end)))))
-
-(define (heredoc-expand file)
-  (let* ((delim (string-append "END-" (randomizer)))
-         (template (make-concatenated-port
-                    (open-input-string (string-append "#<#" delim "\n"))
-                    (open-input-file file)
-                    (open-input-string (string-append "\n" delim "\n"))))
-         (expanded (open-output-string))
-         (str (begin
-                (display (eval (read template)) expanded)
-                (get-output-string expanded))))
-    (irregex-replace/all `(seq ,(def-end) (* "\n"))
-                         str
-                         "")))
-
-(define (main args)
-  (for-each (lambda (f)
-              ;; Is this overkill? Maybe....
-              (parameterize ((filestr (with-input-from-file f read-string)))
-                (parameterize ((def-end (randomizer (filestr))))
-                  (display (heredoc-expand f)))))
-            args))
@@ -0,0 +1,78 @@
+;;; CHICKEN-SCRATCH --- heredocs for CHICKEN
+;; written by Case Duckworth <acdw@acdw.net> off an idea by evhan
+;; Licensed under BSD-3.  See COPYING for details.
+
+;; CHICKEN has "Multiline string constants with embedded expressions" syntax,
+;; which is basically shell here-doc syntax but schemier and with a real
+;; programming langugage to embed. evhan's beaker tool (which is great, btw)
+;; uses this facility to do a quick-and-dirty templating for wiki generation. I
+;; realized that I could use the same facility for the same kind of
+;; heredoc-style templating I have done in various other SSGs like unk and
+;; vienna, but with scheme. Thus, CHICKEN-SCRATCH was born.
+
+;; USAGE
+
+;; `expand-string' is the main entry point to this module. It takes a string and
+;; returns a string with all #( ... ) forms expanded according to the CHICKEN
+;; rules. `expand-port' is a port version of `expand-string'.
+
+;; To enable truly invisible definitions within the expanded string, the `def'
+;; macro is provided which performs a `set!' on its variables, then returns a
+;; string guaranteed not to be in the input string, which is then filtered out
+;; in the expanded string.
+
+;; Finally, to enable CHICKEN-SCRATCH to be used in a shebang, if the first line
+;; of the input string begins with #!, it's deleted from the input.
+
+(module chicken-scratch
+    (expand-string
+     expand-port
+     def
+     %def/replacer)
+
+  (import scheme
+          (chicken base)
+          (only (chicken io)
+                read-string)
+          (only (chicken irregex)
+                irregex-replace
+                irregex-replace/all
+                irregex-search)
+          (only (chicken port)
+                make-concatenated-port)
+          (only (chicken random)
+                pseudo-random-real))
+
+  (define %def/replacer (make-parameter #f))
+
+  (define (expand-string str)
+    (parameterize ((%def/replacer (random-string-not-in str)))
+      (let* ((delim (random-string-not-in str))
+             (template (make-concatenated-port
+                        (open-input-string (string-append "#<#" delim "\n"))
+                        (open-input-string (irregex-replace "^#!.*\n" str ""))
+                        (open-input-string (string-append "\n" delim "\n"))))
+             (expanded (open-output-string))
+             (output (begin
+                       (display (eval (read template)) expanded)
+                       (get-output-string expanded))))
+        (irregex-replace/all `(seq ,(%def/replacer) (* "\n"))
+                             output
+                             ""))))
+
+  (define (expand-port #!optional port)
+    (let ((port (or port (current-input-port))))
+      (expand-string (read-string #f port))))
+
+  (define-syntax def
+    (syntax-rules ()
+      ((def var val)
+       ;; I think this only works in CHICKEN.
+       (begin (set! var val)
+              (%def/replacer)))))
+
+  (define (random-string-not-in str)
+    (let ((attempt (number->string (pseudo-random-real))))
+      (if (irregex-search attempt str)
+          (random-string-not-in str)
+          attempt))))