(module string-template mzscheme
(require (lib "plt-match.ss")
"parsing.ss"
(prefix s: "structs.ss")
(lib "list.ss"))
(provide (rename -make-template make-template)
struct:template template
(struct exn:template:missing-attribute (attribute-name))
template->string
display-template)
(define-struct template (text document))
(define-struct (exn:template:missing-attribute exn:fail) (attribute-name))
(define (-make-template tmpl-string)
(let ([inp (open-input-string tmpl-string)])
(port-count-lines! inp)
(make-template tmpl-string (parse inp))))
(define (template->string a-template a-hash-table)
(let ([outp (open-output-string)])
(display-template a-template a-hash-table outp)
(get-output-string outp)))
(define (display-template a-template a-hash-table out-p)
(display-template-document (template-document a-template) a-hash-table out-p))
(define (lookup id a-hash-table)
(hash-table-get
a-hash-table id
(lambda ()
(raise (make-exn:template:missing-attribute
(format "missing attribute ~s" id)
(current-continuation-marks)
id)))))
(define (display-template-document a-document a-hash-table out-p)
(match a-document
[(struct s:document (elts))
(for-each (lambda (elt)
(display-element elt a-hash-table out-p))
elts)]))
(define (display-element an-element a-hash-table out-p)
(match an-element
[(struct s:normal-text (t))
(display t out-p)]
[(struct s:variable-reference (id))
(display (lookup id a-hash-table) out-p)]
[(struct s:variable-reference/separator (id sep))
(let ([elts (lookup id a-hash-table)])
(cond
[(empty? elts) (void)]
[else
(display (first elts) out-p)
(for-each (lambda (elt)
(display-element sep a-hash-table out-p)
(display elt out-p))
(rest elts))]))])))