summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xjson-template.rkt229
1 files changed, 134 insertions, 95 deletions
diff --git a/json-template.rkt b/json-template.rkt
index ffb135d..6a2a049 100755
--- a/json-template.rkt
+++ b/json-template.rkt
@@ -1,14 +1,27 @@
+#lang typed/racket
;;; -*- mode: scheme; coding: utf-8 -*-
;;; Copyright 2011, Matthias Andreas Benkard.
-#lang typed/racket
-(provide read-template
+(require/typed racket
+ [regexp-split (Regexp String -> (Listof String))]
+ ;;[sequence->list (All (a) (Sequenceof a) -> (Listof a))]
+ [sequence->list (All (a) Any -> (Listof a))] ;FIXME
+ [regexp-replace (Regexp String String -> String)]
+ [sequence? (Any -> Boolean)]
+ [with-input-from-string (All (a) (String (-> a) -> a))]
+ [dict-ref (Any Any Any -> Any)]
+ [dict? (Any -> Boolean)])
+
+(provide make-template
formatters
meta-left
meta-right
default-formatter
format-char)
+#;
+(provide: ...)
+
(define meta-left (make-parameter "{"))
(define meta-right (make-parameter "}"))
(define default-formatter (make-parameter "raw"))
@@ -55,18 +68,22 @@
[format-char : String]) : directive
(match text
[(regexp #px"^\\.section\\s+(.*)$" (list _ x))
- (directive 'section (list x))]
+ (case x
+ [(#f) (error "Syntax error: Expected section name after \".section\"")]
+ [else (directive 'section (list x))])]
[(regexp #px"^\\.repeated\\s+section\\s+(.*)$" (list _ x))
- (directive 'repeated-section (list x))]
- [#".end"
+ (case x
+ [(#f) (error "Syntax error: Expected section name after \".repeated section\"")]
+ [else (directive 'repeated-section (list x))])]
+ [".end"
(directive 'end '())]
- [#".or"
+ [".or"
(directive 'or '())]
[(regexp #px"^\\.alternates\\s+with$")
(directive 'alternates-with '())]
[_
(directive 'substitute
- (regexp-split (regexp-quote format-char) text))]))
+ (regexp-split (regexp (regexp-quote format-char)) text))]))
(define: (remove-spurious-newlines-from-token-groups [groups : (Listof Group)])
: (Listof Group)
@@ -74,12 +91,12 @@
(for/list ([group groups])
(if last-was-directive?
(begin
- (set! last-was-directive? (pair? group))
+ (set! last-was-directive? (directive? group))
(if (or (string? group) (bytes? group))
(regexp-replace #rx"^\n" group "")
group))
(begin
- (set! last-was-directive? (pair? group))
+ (set! last-was-directive? (directive? group))
group)))))
(define-type Part (U section substitution String))
@@ -96,7 +113,7 @@
(struct: substitution
([name : String]
- [formatter : String]
+ [formatter : (U String #f)]
[arguments : (Listof String)])
#:transparent)
@@ -107,9 +124,13 @@
[clauses : (Listof Part) '()])
(if (or (null? parsed-groups)
(and (directive? (car parsed-groups))
- (memq (directive-type parsed-groups) '(end or alternates-with))))
+ (memq (directive-type (car parsed-groups))
+ '(end or alternates-with))))
(values (reverse clauses)
- (if (directive? parsed-groups) (caar parsed-groups) #f))
+ (if (null? parsed-groups)
+ #f
+ (let ([first-group (car parsed-groups)])
+ (if (directive? first-group) (directive-type first-group) #f)))
(if (pair? parsed-groups) (cdr parsed-groups) '()))
(match (car parsed-groups)
[(directive 'section (list x))
@@ -121,19 +142,27 @@
(parse-structure rest)])
(loop rest2 (cons (section x stuff stuff2) clauses)))]
[(end)
- (loop rest (cons (section x stuff #f) clauses))]))]
+ (loop rest (cons (section x stuff '()) clauses))]
+ [else (error "Values of beta will give rise to dom!" reason)]))]
[(directive 'repeated-section (list x))
- (let inner-loop ([subsections '()]
- [rest (cdr parsed-groups)])
+ (let: inner-loop : (values (Listof Part) (U Symbol False) (Listof Group))
+ ([subsections% : (Listof (Pairof (U Symbol False) (Listof Part))) '()]
+ [rest : (Listof Group)
+ (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 (list)]
- [alternates-with (list)])
+ (let: inner-inner-loop : (values (Listof Part) (U Symbol False) (Listof Group))
+ ([subsections : (Listof (Pairof (U Symbol False)
+ (Listof Part)))
+ (let: ([tmp : (Pairof (U Symbol False)
+ (Listof Part))
+ (cons 'end stuff)])
+ (cons tmp subsections%))]
+ [alternative : (Listof Part) (list)]
+ [alternates-with : (Listof Part) (list)])
(if (null? (cdr subsections))
(loop new-rest
(cons (repeated-section x
@@ -152,40 +181,47 @@
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))))]
+ (inner-loop (cons (ann (cons reason stuff)
+ (Pairof (U Symbol False) (Listof Part)))
+ subsections%)
+ new-rest))))]
[(directive 'substitute (list x))
(loop (cdr parsed-groups)
(cons (substitution x #f '()) clauses))]
[(directive 'substitute (list x y arg ...))
- (loop (cdr parsed-groups)
- (cons (substitution x y arg) clauses))]
+ (let ([d (car parsed-groups)])
+ (with-asserts ([d directive?])
+ (loop (cdr parsed-groups)
+ (cons (substitution x y (cddr (directive-arguments d)))
+ ;"arg" doesn't work because Typed Racket thinks it's a (Listof Any).
+ clauses))))]
[x
- (loop (cdr parsed-groups)
- (cons x clauses))])))
+ (if (string? x)
+ (loop (cdr parsed-groups)
+ (cons x clauses))
+ (error "Expected a string here."))]))))
(define: (parse-structure* [x : (Listof Group)]) : (Listof Part)
(let-values ([(stuff reason rest) (parse-structure x)])
stuff))
-(struct: template ([expander : (Any -> String)])
- #:property prop:procedure (struct-field-index expander))
+;;(struct: template ([expander : (Any -> Void)])
+;; #: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 "|"])
-(define: (read-template [input-string : String]) : template
+(define-type template (Any -> Void))
+
+(define: (make-template [input-string : String]) : template
(let ([template-data
(parse-structure*
(remove-spurious-newlines-from-token-groups
(classify-chunks (template-string->chunks input-string
- meta-left
- meta-right)
- format-char)))])
- (template
- (λ (context)
- (expand-template template-data (list context) default-formatter)))))
+ (meta-left)
+ (meta-right))
+ (format-char))))])
+ (let ([default-formatter% (default-formatter)])
+ (λ (context)
+ (expand-template template-data (list context) default-formatter%)))))
(define: (name->path [name : String]) : (Listof String)
(if (string=? name "@")
@@ -219,7 +255,10 @@
(values #f #f)])))
(define: (find-formatter [name : String]) : (String -> String)
- (cdr (assoc name (formatters))))
+ (let ([formatter (assoc name (formatters))])
+ (cdr (if formatter
+ formatter
+ (error "Formatter \"~a\" not found" name)))))
(define: (expand-template [template : (Listof Part)]
[stack : (Listof Any)]
@@ -229,13 +268,13 @@
[(repeated-section name body alternative alternates-with)
(let ([context (resolve-path stack (name->path name))])
(if (or (false? context)
- (null? (sequence->list context)))
+ (null? context))
(when alternative
(expand-template alternative
(cons context stack)
default-formatter))
- (let ([first-iteration? #t])
- (for ([value context])
+ (let: ([first-iteration? : Boolean #t])
+ (for ([value (in-list context)])
(when alternates-with
(if first-iteration?
(set! first-iteration? #f)
@@ -263,67 +302,68 @@
-(define: (make-escaper [replacements : List]) : (String -> String)
- (let* ([escapees (map car replacements)]
- [escapings (map cdr replacements)]
+(define: (make-escaper [replacements : (Listof (Pairof Char String))]) : (String -> String)
+ (let* ([escapees (map (inst car Char String) replacements)]
+ [escapings (map (inst cdr Char String) replacements)]
[re (regexp
(string-append "^(.*?)"
"(?:("
- (foldl (λ (x acc)
- (string-append acc
- ")|("
- (regexp-quote (string x))))
+ (foldl (λ: ([x : Char]
+ [acc : String])
+ (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 : Void ()
- (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)))))))))))
+ (with-output-to-string
+ (λ ()
+ (with-input-from-string
+ (if (string? thing)
+ thing
+ (format "~a" thing))
+ (λ ()
+ (let: loop : Void ()
+ (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 (in-list escapee-matches)]
+ [y (in-list escapings)])
+ (when x
+ (display y)))
+ (loop)))))))))))
(define: (escape-for-uri [thing : String]) : String
(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
+ (λ ()
+ (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 : (Parameterof (Listof (Pairof String (String -> String))))
(make-parameter
`(("html" . ,(make-escaper '((#\< . "&#60;")
(#\> . "&#62;")
@@ -334,12 +374,10 @@
(#\' . "&#39;")
(#\" . "&#34;"))))
("url-param-value" . ,escape-for-uri)
- ("raw" . ,(λ (x) x)))))
+ ("raw" . ,(λ: ([x : String]) x)))))
-#;
-(let ([template (with-input-from-string
- #<<EOF
+(let* ([template-string #<<EOF
<h1>{title|html}</h1>
{.section people}
<ul>
@@ -351,7 +389,8 @@
<p>No one's registered.</p>
{.end}
EOF
- (λ () (read-template)))])
+ ]
+ [template (make-template template-string)])
(template '((title . "<Registered People>")
(people .
(((name . "Nathalie") (age . 24))