summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--info.rkt2
-rwxr-xr-xjson-template.rkt332
-rw-r--r--json-template.s6l370
-rw-r--r--manual.scrbl107
4 files changed, 479 insertions, 332 deletions
diff --git a/info.rkt b/info.rkt
new file mode 100644
index 0000000..017c55c
--- /dev/null
+++ b/info.rkt
@@ -0,0 +1,2 @@
+#lang setup/infotab
+(define scribblings '(("manual.scrbl" ())))
diff --git a/json-template.rkt b/json-template.rkt
deleted file mode 100755
index fe596c4..0000000
--- a/json-template.rkt
+++ /dev/null
@@ -1,332 +0,0 @@
-;;; -*- mode: scheme; coding: utf-8 -*-
-;;; Copyright 2011, Matthias Andreas Benkard.
-#lang racket
-
-(provide read-template
- formatters)
-
-(define (template-string->chunks input meta-left meta-right)
- (let* ([meta-left-re (regexp-quote meta-left)]
- [meta-right-re (regexp-quote meta-right)]
- [re (regexp
- (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
- (regexp-split re input)))
-
-(define (flip-flop-map f1 f2 lst)
- "Like map, but alternate between f1 and f2 as the function to apply."
- (define (flip items)
- (match items
- ['() '()]
- [(list* x xs) (cons (f1 x) (flop xs))]))
- (define (flop items)
- (match items
- ['() '()]
- [(list* x xs) (cons (f2 x) (flip xs))]))
- (flip lst))
-
-(define (classify-chunks chunks format-char)
- (flip-flop-map (λ (x) x)
- (λ (x) (parse-directive x format-char))
- chunks))
-
-(define (parse-directive directive format-char)
- (match directive
- [(regexp #rx"^#")
- #f]
- [(regexp #px"^\\.section\\s+(.*)$" (list _ x))
- (list 'section x)]
- [(regexp #px"^\\.repeated\\s+section\\s+(.*)$" (list _ x))
- (list 'repeated-section x)]
- [#".end"
- (list 'end)]
- [#".or"
- (list 'or)]
- [(regexp #px"^\\.alternates\\s+with$")
- (list 'alternates-with)]
- [_
- (list* 'substitute (regexp-split (regexp-quote format-char)
- directive))]))
-
-(define (remove-spurious-newlines-from-token-groups groups)
- (let ([last-was-directive? #f])
- (for/list ([group groups])
- (if last-was-directive?
- (begin
- (set! last-was-directive? (pair? group))
- (if (or (string? group) (bytes? group))
- (regexp-replace #rx"^\n" group "")
- group))
- (begin
- (set! last-was-directive? (pair? group))
- group)))))
-
-(struct section
- (name
- body
- alternative)
- #:transparent)
-
-(struct repeated-section section
- (alternates-with)
- #:transparent)
-
-(struct substitution
- (name
- formatter
- arguments)
- #:transparent)
-
-(define (parse-structure parsed-groups)
- (let loop ([parsed-groups parsed-groups]
- [clauses '()])
- (if (or (null? parsed-groups)
- (and (pair? (car parsed-groups))
- (memq (caar parsed-groups) '(end or alternates-with))))
- (values (reverse clauses)
- (and (pair? parsed-groups) (caar parsed-groups))
- (if (pair? parsed-groups) (cdr parsed-groups) '()))
- (match (car parsed-groups)
- [(list 'section x)
- (let-values ([(stuff reason rest)
- (parse-structure (cdr parsed-groups))])
- (case reason
- [(or)
- (let-values ([(stuff2 _ rest2)
- (parse-structure rest)])
- (loop rest2 (cons (section x stuff stuff2) clauses)))]
- [(end)
- (loop rest (cons (section x stuff #f) clauses))]))]
- [(list 'repeated-section x)
- (let inner-loop ([subsections '()]
- [rest (cdr parsed-groups)])
- (let-values ([(stuff reason new-rest)
- (parse-structure rest)])
- (when (false? reason)
- (error "Premature end of file."))
- (if (eq? reason 'end)
- (let inner-inner-loop
- ([subsections (cons (cons 'end stuff) subsections)]
- [alternative #f]
- [alternates-with #f])
- (if (null? (cdr subsections))
- (loop new-rest
- (cons (repeated-section x
- (cdar subsections)
- alternative
- alternates-with)
- clauses))
- (case (caadr subsections)
- [(alternates-with)
- (inner-inner-loop (cdr subsections)
- alternative
- (cdar subsections))]
- [(or)
- (inner-inner-loop (cdr subsections)
- (cdar subsections)
- alternates-with)]
- [else
- (error "Oh no, I don't know what I'm doing here! Subsections:" subsections)])))
- (inner-loop (cons (cons reason stuff) subsections) new-rest))))]
- [(list 'substitute x)
- (loop (cdr parsed-groups)
- (cons (substitution x #f '()) clauses))]
- [(list 'substitute x y arg ...)
- (loop (cdr parsed-groups)
- (cons (substitution x y arg) clauses))]
- [x
- (loop (cdr parsed-groups)
- (cons x clauses))]))))
-
-(define (parse-structure* x)
- (let-values ([(stuff reason rest) (parse-structure x)])
- stuff))
-
-(struct template (expander)
- #:property prop:procedure (struct-field-index expander))
-
-(define (read-template #:meta-left [meta-left "{"]
- #:meta-right [meta-right "}"]
- #:default-formatter [default-formatter "raw"]
- #:format-char [format-char "|"])
- (let ([template-data
- (parse-structure*
- (remove-spurious-newlines-from-token-groups
- (classify-chunks (template-string->chunks (current-input-port)
- meta-left meta-right)
- format-char)))])
- (template
- (λ (context)
- (expand-template template-data (list context) default-formatter)))))
-
-(define (name->path bytename)
- (let ([name (bytes->string/utf-8 bytename)])
- (if (string=? name "@")
- '()
- (regexp-split #rx"\\." name))))
-
-(define (resolve-path stack path)
- (if (null? stack)
- #f
- (let-values ([(value success?)
- (resolve-path-in-object (car stack) path)])
- (if success?
- value
- (resolve-path (cdr stack) path)))))
-
-(define (resolve-path-in-object context path)
- (let ([nothing (gensym)])
- (cond [(null? path)
- (values context #t)]
- [(dict? context)
- (let ([y (dict-ref context
- (car path)
- (λ ()
- (dict-ref context
- (string->symbol (car path))
- nothing)))])
- (if (eq? y nothing)
- (values #f #f)
- (resolve-path-in-object y (cdr path))))]
- [else
- (values #f #f)])))
-
-(define (find-formatter name)
- (cdr (assoc (if (string? name)
- name
- (bytes->string/utf-8 name))
- (formatters))))
-
-(define (expand-template template stack default-formatter)
- (for ([thing template])
- (match thing
- [(repeated-section name body alternative alternates-with)
- (let ([context (resolve-path stack (name->path name))])
- (if (or (false? context)
- (null? (sequence->list context)))
- (when alternative
- (expand-template alternative
- (cons context stack)
- default-formatter))
- (let ([first-iteration? #t])
- (for ([value context])
- (when alternates-with
- (if first-iteration?
- (set! first-iteration? #f)
- (expand-template alternates-with
- stack
- default-formatter)))
- (expand-template body
- (cons value stack)
- default-formatter)))))]
- [(section name body alternative)
- (let ([context (resolve-path stack (name->path name))])
- (if context
- (expand-template body
- (cons context stack)
- default-formatter)
- (when alternative
- (expand-template alternative
- (cons context stack)
- default-formatter))))]
- [(substitution name formatter args)
- (display ((find-formatter (or formatter default-formatter))
- (resolve-path stack (name->path name))))]
- [_
- (display thing)])))
-
-
-
-(define (make-escaper replacements)
- (let* ([escapees (map car replacements)]
- [escapings (map cdr replacements)]
- [re (regexp
- (string-append "^(.*?)"
- "(?:("
- (foldl (λ (x acc)
- (string-append acc
- ")|("
- (regexp-quote (string x))))
- (regexp-quote (string (car escapees)))
- (cdr escapees))
- "))"
- "|$"))])
- (λ (thing)
- (with-output-to-string
- (λ ()
- (with-input-from-string
- (if (string? thing)
- thing
- (format "~a" thing))
- (λ ()
- (let loop ()
- (unless (eof-object? (peek-byte))
- (match-let ([(list* _ raw-text escapee-matches)
- (regexp-match re (current-input-port))])
- (when raw-text
- (display raw-text))
- (for ([x escapee-matches]
- [y escapings])
- (when x
- (display y)))
- (loop)))))))))))
-
-
-(define (escape-for-uri thing)
- (with-output-to-string
- (λ ()
- (for ([char (in-string (if (string? thing)
- thing
- (format "~a" thing)))])
- (let ((cnum (char->integer char)))
- (if (or (<= (char->integer #\A) cnum (char->integer #\Z))
- (<= (char->integer #\a) cnum (char->integer #\z))
- (<= (char->integer #\0) cnum (char->integer #\9))
- (member char
- '(#\$ #\- #\_ #\. #\+ #\! #\* #\( #\) #\')))
- (display char)
- ;; FIXME: This assumes that (< cnum 256).
- ;; Maybe we should interpret the data as a byte string
- ;; rather than as a string. W3C says we ought to use
- ;; UTF-8 encoding, which is consistent with the Racket
- ;; default encoding:
- ;;
- ;; http://www.w3.org/International/O-URL-code.html
- (if (< cnum 16)
- (printf "%0~x" cnum)
- (printf "%~x" cnum))))))))
-
-
-(define formatters
- (make-parameter
- `(("html" . ,(make-escaper '((#\< . "&#60;")
- (#\> . "&#62;")
- (#\& . "&#38;"))))
- ("html-attr-value" . ,(make-escaper '((#\< . "&#60;")
- (#\> . "&#62;")
- (#\& . "&#38;")
- (#\' . "&#39;")
- (#\" . "&#34;"))))
- ("url-param-value" . ,escape-for-uri)
- ("raw" . ,(λ (x) x)))))
-
-
-#;
-(let ([template (with-input-from-string
- #<<EOF
-<h1>{title|html}</h1>
-{.section people}
-<ul>
-{.repeated section @}
- <li>{name} ({age} years)</li>
-{.end}
-</ul>
-{.or}
-<p>No one's registered.</p>
-{.end}
-EOF
- (λ () (read-template)))])
- (template '((title . "<Registered People>")
- (people .
- (((name . "Nathalie") (age . 24))
- ((name . "Heinrich") (age . 28))
- ((name . "Hans") (age . 25)))))))
diff --git a/json-template.s6l b/json-template.s6l
new file mode 100644
index 0000000..06a591b
--- /dev/null
+++ b/json-template.s6l
@@ -0,0 +1,370 @@
+#!r6rs
+;;; -*- mode: scheme; coding: utf-8 -*-
+;;; Copyright 2011, Matthias Andreas Benkard.
+
+(library (json-template)
+ (export make-template
+ formatters
+ meta-left
+ meta-right
+ default-formatter
+ format-char)
+ (import (rnrs base) (rnrs programs) (rnrs unicode) (rnrs lists) (rnrs control)
+ (rnrs records syntactic) (rnrs records procedural) (rnrs records inspection)
+ (rnrs exceptions) (rnrs conditions) (rnrs io simple) (rnrs io ports) (rnrs hashtables)
+ (rnrs r5rs)
+ (srfi :39) (srfi :28)
+ (pregexp))
+
+
+(define meta-left (make-parameter "{"))
+(define meta-right (make-parameter "}"))
+(define default-formatter (make-parameter "raw"))
+(define format-char (make-parameter "|"))
+
+(define-syntax λ
+ (syntax-rules ()
+ [(_ forms ...)
+ (lambda forms ...)]))
+
+(define (dict? x)
+ (or (list? x)
+ (hashtable? x)))
+
+(define (dict-ref dict key default)
+ (let* ([default-default (cons #f #f)]
+ [result
+ (cond
+ [(list? dict)
+ (let ([result-cons (assoc key dict)])
+ (if result-cons
+ (cdr result-cons)
+ default-default))]
+ [(hashtable? dict)
+ (hashtable-ref dict key default-default)])])
+ (if (eq? result default-default)
+ (if (procedure? default)
+ (default)
+ default)
+ result)))
+
+(define (template-string->chunks input meta-left meta-right)
+ (let* ([meta-left-re (pregexp-quote meta-left)]
+ [meta-right-re (pregexp-quote meta-right)]
+ [re (pregexp
+ (string-append "(" meta-left-re ")|(" meta-right-re ")"))])
+ (pregexp-split re input)))
+
+(define (flip-flop-map f1 f2 lst)
+ "Like map, but alternate between f1 and f2 as the function to apply."
+ (letrec ((flip (λ (items)
+ (cond
+ [(null? items)'()]
+ [else (cons (f1 (car items)) (flop (cdr items)))])))
+ (flop (λ (items)
+ (cond
+ [(null? items)'()]
+ [else (cons (f2 (car items)) (flip (cdr items)))]))))
+ (flip lst)))
+
+(define (classify-chunks chunks format-char)
+ (flip-flop-map (λ (x) x)
+ (λ (x) (parse-directive x format-char))
+ chunks))
+
+(define (parse-directive directive format-char)
+ (cond
+ [(pregexp-match "^#" directive)
+ #f]
+ [(pregexp-match "^\\.section[ \t]+(.*)$" directive)
+ => (λ (x) (list 'section (cadr x)))]
+ [(pregexp-match "^\\.repeated[ \t]+section[ \t]+(.*)$" directive)
+ => (λ (x) (list 'repeated-section (cadr x)))]
+ [(string=? ".end" directive)
+ (list 'end)]
+ [(string=? ".or" directive)
+ (list 'or)]
+ [(pregexp-match "^\\.alternates\\s+with$" directive)
+ (list 'alternates-with)]
+ [else
+ (cons 'substitute (pregexp-split (pregexp-quote format-char)
+ directive))]))
+
+(define (remove-spurious-newlines-from-token-groups groups)
+ (let ([last-was-directive? #f])
+ (map
+ (λ (group)
+ (if last-was-directive?
+ (begin
+ (set! last-was-directive? (pair? group))
+ (if (string? group)
+ (pregexp-replace "^\n" group "")
+ group))
+ (begin
+ (set! last-was-directive? (pair? group))
+ group)))
+ groups)))
+
+(define-record-type section
+ (fields (immutable name)
+ (immutable body)
+ (immutable alternative)))
+
+(define-record-type repeated-section
+ (parent section)
+ (fields (immutable alternates-with)))
+
+(define-record-type substitution
+ (fields (immutable name)
+ (immutable formatter)
+ (immutable arguments)))
+
+(define (parse-structure parsed-groups)
+ (let loop ([parsed-groups parsed-groups]
+ [clauses '()])
+ (if (or (null? parsed-groups)
+ (and (pair? (car parsed-groups))
+ (memq (caar parsed-groups) '(end or alternates-with))))
+ (values (reverse clauses)
+ (and (pair? parsed-groups) (caar parsed-groups))
+ (if (pair? parsed-groups) (cdr parsed-groups) '()))
+ (let ([grp (car parsed-groups)])
+ (cond
+ [(string? grp)
+ (loop (cdr parsed-groups)
+ (cons grp clauses))]
+ [(eq? (car grp) 'section)
+ (let-values ([(stuff reason rest)
+ (parse-structure (cdr parsed-groups))])
+ (case reason
+ [(or)
+ (let-values ([(stuff2 _ rest2)
+ (parse-structure rest)])
+ (loop rest2 (cons (make-section (cadr grp) stuff stuff2) clauses)))]
+ [(end)
+ (loop rest (cons (make-section (cadr grp) stuff #f) clauses))]))]
+ [(eq? (car grp) 'repeated-section)
+ (let inner-loop ([subsections '()]
+ [rest (cdr parsed-groups)])
+ (let-values ([(stuff reason new-rest)
+ (parse-structure rest)])
+ (when (not reason)
+ (error "Premature end of file."))
+ (if (eq? reason 'end)
+ (let inner-inner-loop
+ ([subsections (cons (cons 'end stuff) subsections)]
+ [alternative #f]
+ [alternates-with #f])
+ (if (null? (cdr subsections))
+ (loop new-rest
+ (cons (make-repeated-section (cadr grp)
+ (cdar subsections)
+ alternative
+ alternates-with)
+ clauses))
+ (case (caadr subsections)
+ [(alternates-with)
+ (inner-inner-loop (cdr subsections)
+ alternative
+ (cdar subsections))]
+ [(or)
+ (inner-inner-loop (cdr subsections)
+ (cdar subsections)
+ alternates-with)]
+ [else
+ (error "Oh no, I don't know what I'm doing here! Subsections:" subsections)])))
+ (inner-loop (cons (cons reason stuff) subsections) new-rest))))]
+ [(eq? (car grp) 'substitute)
+ (loop (cdr parsed-groups)
+ (if (null? (cddr grp))
+ (cons (make-substitution (cadr grp) #f '()) clauses)
+ (cons (make-substitution (cadr grp) (caddr grp) (cdddr grp)) clauses)))])))))
+
+(define (parse-structure* x)
+ (let-values ([(stuff reason rest) (parse-structure x)])
+ stuff))
+
+(define (make-template template-string)
+ (let ([template-data
+ (parse-structure*
+ (remove-spurious-newlines-from-token-groups
+ (classify-chunks (template-string->chunks template-string
+ (meta-left) (meta-right))
+ (format-char))))])
+ (let ([default-formatter (default-formatter)])
+ (λ (context)
+ (expand-template template-data (list context) default-formatter)))))
+
+(define (name->path name)
+ (if (string=? name "@")
+ '()
+ (pregexp-split "\\." name)))
+
+(define (resolve-path stack path)
+ (if (null? stack)
+ #f
+ (let-values ([(value success?)
+ (resolve-path-in-object (car stack) path)])
+ (if success?
+ value
+ (resolve-path (cdr stack) path)))))
+
+(define (resolve-path-in-object context path)
+ (let ([nothing (cons #f #f)])
+ (cond [(null? path)
+ (values context #t)]
+ [(dict? context)
+ (let ([y (dict-ref context
+ (car path)
+ (λ ()
+ (dict-ref context
+ (string->symbol (car path))
+ nothing)))])
+ (if (eq? y nothing)
+ (values #f #f)
+ (resolve-path-in-object y (cdr path))))]
+ [else
+ (values #f #f)])))
+
+(define (find-formatter name)
+ (cdr (assoc name (formatters))))
+
+(define (expand-template template stack default-formatter)
+ (for-each
+ (λ (thing)
+ (cond
+ [(repeated-section? thing)
+ (let ([context (resolve-path stack (name->path (section-name thing)))])
+ (if (or (not context)
+ (null? context))
+ (when (section-alternative thing)
+ (expand-template (section-alternative thing)
+ (cons context stack)
+ default-formatter))
+ (let ([first-iteration? #t])
+ (for-each
+ (λ (value)
+ (when (repeated-section-alternates-with thing)
+ (if first-iteration?
+ (set! first-iteration? #f)
+ (expand-template (repeated-section-alternates-with thing)
+ stack
+ default-formatter)))
+ (expand-template (section-body thing)
+ (cons value stack)
+ default-formatter))
+ context))))]
+ [(section? thing)
+ (let ([context (resolve-path stack (name->path (section-name thing)))])
+ (if (and context (not (null? context)))
+ (expand-template (section-body thing)
+ (cons context stack)
+ default-formatter)
+ (when (section-alternative thing)
+ (expand-template (section-alternative thing)
+ (cons context stack)
+ default-formatter))))]
+ [(substitution? thing)
+ (display ((find-formatter (or (substitution-formatter thing) default-formatter))
+ (resolve-path stack (name->path (substitution-name thing)))))]
+ [else
+ (display thing)]))
+ template))
+
+(define (make-escaper replacements)
+ (let* ([escapees (map car replacements)]
+ [escapings (map cdr replacements)]
+ [re (pregexp
+ (string-append "^(.*?)"
+ "(?:("
+ (fold-left (λ (acc x)
+ (string-append acc
+ ")|("
+ (pregexp-quote (string x))))
+ (pregexp-quote (string (car escapees)))
+ (cdr escapees))
+ "))"
+ "|$"))])
+ (λ (thing)
+ (call-with-string-output-port
+ (λ (out)
+ (let ([input (if (string? thing)
+ thing
+ (format "~a" thing))])
+ (let loop ([position 0])
+ (if (>= position (string-length input))
+ (values)
+ (let* ([m (pregexp-match re input position)]
+ [positions (pregexp-match-positions re input position)]
+ [raw-text (and m (cadr m))]
+ [escapee-matches (and m (cddr m))])
+ (when raw-text
+ (display raw-text out))
+ (for-each (λ (x y)
+ (when x
+ (display y out)))
+ escapee-matches
+ escapings)
+ (loop (cdar positions)))))))))))
+
+
+(define (escape-for-uri thing)
+ (call-with-string-output-port
+ (λ (out)
+ (for-each
+ (λ (char)
+ (let ((cnum (char->integer char)))
+ (if (or (<= (char->integer #\A) cnum (char->integer #\Z))
+ (<= (char->integer #\a) cnum (char->integer #\z))
+ (<= (char->integer #\0) cnum (char->integer #\9))
+ (member char
+ '(#\$ #\- #\_ #\. #\+ #\! #\* #\( #\) #\')))
+ (display char out)
+ ;; FIXME: This assumes that (< cnum 256).
+ ;; Maybe we should interpret the data as a byte string
+ ;; rather than as a string. W3C says we ought to use
+ ;; UTF-8 encoding, which is consistent with the Racket
+ ;; default encoding:
+ ;;
+ ;; http://www.w3.org/International/O-URL-code.html
+ (if (< cnum 16)
+ (display (format "%0~x" cnum) out)
+ (display (format "%~x" cnum) out)))))
+ (if (string? thing)
+ thing
+ (format "~a" thing))))))
+
+
+(define formatters
+ (make-parameter
+ `(("html" . ,(make-escaper '((#\< . "&#60;")
+ (#\> . "&#62;")
+ (#\& . "&#38;"))))
+ ("html-attr-value" . ,(make-escaper '((#\< . "&#60;")
+ (#\> . "&#62;")
+ (#\& . "&#38;")
+ (#\' . "&#39;")
+ (#\" . "&#34;"))))
+ ("url-param-value" . ,escape-for-uri)
+ ("raw" . ,(λ (x) x)))))
+
+
+#;
+(let ([template (make-template "
+<h1>{title|html}</h1>
+{.section people}
+<ul>
+{.repeated section @}
+ <li>{name} ({age} years)</li>
+{.end}
+</ul>
+{.or}
+<p>No one's registered.</p>
+{.end}
+")])
+ (template '((title . "<Registered People>")
+ (people .
+ (((name . "Nathalie") (age . 24))
+ ((name . "Heinrich") (age . 28))
+ ((name . "Hans") (age . 25)))))))
+)
diff --git a/manual.scrbl b/manual.scrbl
new file mode 100644
index 0000000..109ea24
--- /dev/null
+++ b/manual.scrbl
@@ -0,0 +1,107 @@
+#lang scribble/manual
+@(require scribble/eval)
+@(require racket/sandbox)
+@(require (for-label r6rs))
+@;@(require (for-label "json-template.s6l"))
+
+@(define r6rs-evaluator
+ (call-with-trusted-sandbox-configuration
+ (lambda ()
+ (parameterize ([sandbox-output 'string]
+ [sandbox-error-output 'string])
+ (make-evaluator
+ 'r6rs
+ '(import (rnrs) (json-template)))))))
+@(define racket-evaluator
+ (call-with-trusted-sandbox-configuration
+ (lambda ()
+ (parameterize ([sandbox-output 'string]
+ [sandbox-error-output 'string])
+ (make-evaluator
+ 'racket/base
+ #:requires (list 'json-template))))))
+
+
+@title{JSON Template for R6RS}
+@author{Matthias A. Benkard}
+
+
+@section{Installation}
+
+@subsection{Installing pregexp}
+
+Download the pregexp library from @url{http://evalwhen.com/pregexp/}. Wrap @filepath{pregexp.scm} in the following form (replacing ``....'' with the file's original content):
+
+@schemeblock[
+(library (pregexp)
+ (export pregexp
+ pregexp-match
+ pregexp-match-positions
+ pregexp-split
+ pregexp-replace
+ pregexp-replace*
+ pregexp-quote)
+ (import (rnrs) (rnrs mutable-pairs))
+
+ ....
+
+)
+]
+
+You can then install @filepath{pregexp.scm} as an R6RS library. For details on how to do this, consult the manual of your Scheme implementation.
+
+As an example, @codeblock[@"plt-r6rs --install pregexp.scm"] will work on @hyperlink["http://racket-lang.org/"]{Racket}.
+
+
+@subsection{Installing JSON Template for R6RS}
+
+JSON Template for R6RS is provided as a ready-to-use R6RS library file. Simply install @filepath{json-template.s6l} as per the manual of the Scheme implementation of your choice.
+
+On Racket, @codeblock[@"plt-r6rs --install json-template.s6l"] ought to work just fine.
+
+
+@section{Usage}
+
+@subsection{API}
+
+@defproc[(make-template [template-data string?]) procedure?]{
+ Create a template from @scheme[template-data], which must be in JSON Template syntax.
+
+ The returned procedure expects a single argument, the @italic{subtitution context}, and returns the expanded template as a string. Three types of contexts are supported:
+
+ @itemlist[
+ @item{@bold{Primitive contexts.} These may be of any form whatever (valid primitive contexts are lists, numbers, symbols, strings, etc.) and are not treated specially. Their only purpose is being printed into the template expansion as plain text. Note that a primitive context does not make a whole lot of sense when used as an argument to @scheme{make-template} (although it can be used as such and referenced as @scheme["@"]); it is much more commonly encountered as a nested context in a map.}
+ @item{@bold{Sequences.} At present, these may only be lists. They can be iterated over by the use of repeated sections.}
+ @item{@bold{Maps.} These may be either hash tables or association lists. They can be indexed into by substitutions.}
+ ]
+
+ @scheme[make-template]'s behavior can be customized by the parameters @scheme[formatters], @scheme[meta-left], @scheme[meta-right], @scheme[default-formatter], and @scheme[format-char].
+
+ For general information about JSON Template, see @url{http://json-template.googlecode.com/svn/trunk/doc/Introducing-JSON-Template.html} and @url{http://code.google.com/p/json-template/wiki/Reference}.
+}
+
+
+@subsection{Examples}
+
+@interaction[#:eval r6rs-evaluator
+(define template (make-template "
+<h1>{title|html}</h1>
+{.section people}
+<ul>
+{.repeated section @}
+ <li>{name} ({age} years)</li>
+{.end}
+</ul>
+{.or}
+<p>No one's registered.</p>
+{.end}
+"))
+(template '((title . "<Registered People>")
+ (people .
+ (((name . "Nathalie") (age . 24))
+ ((name . "Heinrich") (age . 28))
+ ((name . "Hans") (age . 25))))))
+(template '((title . "<Registered People>")
+ (people)))
+(template '((title . "<Registered People>")))
+]