#lang scheme/base 
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TEMPLATE.plt
;;
;; simple string template generator/interpolator.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; iqs.ss - inline quoted string.
;; yc 9/8/2009 - first version

(require (planet bzlib/base)
         )
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the design is simple.
;; iqs takes in a string and a set of key/value pairs.
;; key must be symbol, and the value can be anything that's printable.
;; (iqs "this is a $variable." `(variable . "book")) => "this is a book"
;;
;; the format $foo declares a placeholder.  All values for placeholders
;; are optional. If we do not provide value it'll print out the name of
;; the placeholder instead. e.g,
;; (iqs "this is a $variable") => "this is a $variable"
;; there are a few parameters that can be used to tune the behavior of iqs.

(define iqs-symbol-escape (make-parameter #\\))
(define iqs-symbol-start (make-parameter #\$))
(define iqs-symbol-allowed-chars (make-parameter '(#\- #\_)))

(define (is-symbol-start? in (acc '()))
  (equal? (peek-char in) (iqs-symbol-start)))
  
(define (read-symbol in)
  (define (return acc)
    (string->symbol (list->string (reverse acc))))
  (define (helper acc)
    (let ((c (peek-char in)))
      (cond ((eof-object? c)
             (if (null? acc) eof (return acc)))
            ((and (or (char-symbolic? c) (char-punctuation? c))
                  (not (member c (iqs-symbol-allowed-chars))))
             (return acc))
            ((char-whitespace? c)
             (return acc))
            (else
             (helper (cons (read-char in) acc))))))
  (read-char in) ;; skip the first char...
  (helper '()))

(define (read-string in)
  (define (return acc)
    (list->string (reverse acc)))
  (define (helper acc)
    (let ((c (peek-char in)))
      (cond ((eof-object? c)
             (if (null? acc) eof (return acc)))
            ((and (equal? c (iqs-symbol-escape))
                  (equal? (peek-char in 1) (iqs-symbol-start)))
             (read-char in) 
             (helper (cons (read-char in) acc)))
            ((is-symbol-start? in)
             (return acc))
            (else
             (helper (cons (read-char in) acc))))))
  (helper '()))

(define (read-iqs in (read-symbol read-symbol)) 
  (define (helper acc)
    (let ((c (peek-char in)))
      (cond ((eof-object? c)
             (reverse acc))
            ((equal? c (iqs-symbol-start))
             (helper (cons (read-symbol in) acc)))
            (else
             (helper (cons (read-string in) acc))))))
  (helper '()))
;; (trace read-iqs)

(define (assoc-converter args)
  (lambda (s)
    (assoc*/cdr s
                (map (lambda (kv)
                       (cons (if (number? (car kv))
                                 (string->symbol (number->string (car kv)))
                                 (car kv))
                             (cdr kv)))
                     args)
                (format "$~a" s))))

(define (iqs in #:converter (converter assoc-converter) . args)
  (define (helper in)
    (cond ((bytes? in) (open-input-bytes in))
          ((string? in) (open-input-string in))
          ((input-port? in) in)))
  (iqs-convert (read-iqs (helper in)) converter args))

(define (iqs-convert lst converter args)
  (let ((convert (converter args)))
    (stringify (map (lambda (s)
                      (if (symbol? s) (convert s) s))
                    lst))))

(provide/contract
 (iqs-symbol-start (parameter/c char?))
 (iqs-symbol-escape (parameter/c char?))
 (iqs-symbol-allowed-chars (parameter/c (listof char?)))
 (read-iqs (->* (input-port?)
                ((-> input-port? symbol?))
                (listof (or/c symbol? bytes? string?))))
 (iqs (->* ((or/c bytes? string? input-port?))
           (#:converter (-> (listof any/c) (-> any/c any)))
           #:rest (listof any/c)
           string?))
 (iqs-convert (-> (listof (or/c symbol? string?))
                  (-> (listof any/c) (-> any/c any))
                  (listof any/c)
                  string?))
 )