;;; 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 "#(import chicken-scratch)")
                        (open-input-string 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 `(: (or "#<unspecified>"
                                     ,(%def/replacer))
                                 (* whitespace))
                             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))))