From b9a826c87be75ca5c59cde6dc6cd7503dad53f4d Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 22 Jun 2011 11:53:02 +0200 Subject: Begin translation to Typed Racket. --- json-template.rkt | 167 +++++++++++++++++++++++++++++++----------------------- 1 file changed, 97 insertions(+), 70 deletions(-) diff --git a/json-template.rkt b/json-template.rkt index fe596c4..ffb135d 100755 --- a/json-template.rkt +++ b/json-template.rkt @@ -1,54 +1,76 @@ ;;; -*- mode: scheme; coding: utf-8 -*- ;;; Copyright 2011, Matthias Andreas Benkard. -#lang racket +#lang typed/racket (provide read-template - formatters) + formatters + meta-left + meta-right + default-formatter + format-char) -(define (template-string->chunks input meta-left meta-right) +(define meta-left (make-parameter "{")) +(define meta-right (make-parameter "}")) +(define default-formatter (make-parameter "raw")) +(define format-char (make-parameter "|")) + +(define: (template-string->chunks [input : String] + [meta-left : String] + [meta-right : String]) : (Listof String) (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))) +(: flip-flop-map + (All (a b) + (a -> b) (a -> b) (Listof a) -> (Listof b))) (define (flip-flop-map f1 f2 lst) "Like map, but alternate between f1 and f2 as the function to apply." - (define (flip items) + (define: (flip [items : (Listof a)]) : (Listof b) (match items ['() '()] [(list* x xs) (cons (f1 x) (flop xs))])) - (define (flop items) + (define: (flop [items : (Listof a)]) : (Listof b) (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)) + +(struct: directive + ([type : Symbol] + [arguments : (Listof String)]) + #:transparent) +(define-type Group (U String directive)) + +(define: (classify-chunks [chunks : (Listof String)] + [format-char : String]) : (Listof Group) + (flip-flop-map (λ: ([x : String]) x) + (λ: ([x : String]) (parse-directive x format-char)) chunks)) -(define (parse-directive directive format-char) - (match directive - [(regexp #rx"^#") - #f] +(define: (parse-directive [text : String] + [format-char : String]) : directive + (match text [(regexp #px"^\\.section\\s+(.*)$" (list _ x)) - (list 'section x)] + (directive 'section (list x))] [(regexp #px"^\\.repeated\\s+section\\s+(.*)$" (list _ x)) - (list 'repeated-section x)] + (directive 'repeated-section (list x))] [#".end" - (list 'end)] + (directive 'end '())] [#".or" - (list 'or)] + (directive 'or '())] [(regexp #px"^\\.alternates\\s+with$") - (list 'alternates-with)] + (directive 'alternates-with '())] [_ - (list* 'substitute (regexp-split (regexp-quote format-char) - directive))])) - -(define (remove-spurious-newlines-from-token-groups groups) - (let ([last-was-directive? #f]) + (directive 'substitute + (regexp-split (regexp-quote format-char) text))])) + +(define: (remove-spurious-newlines-from-token-groups [groups : (Listof Group)]) + : (Listof Group) + (let: ([last-was-directive? : Boolean #f]) (for/list ([group groups]) (if last-was-directive? (begin @@ -60,33 +82,37 @@ (set! last-was-directive? (pair? group)) group))))) -(struct section - (name - body - alternative) +(define-type Part (U section substitution String)) + +(struct: section + ([name : String] + [body : (Listof Part)] + [alternative : (Listof Part)]) #:transparent) -(struct repeated-section section - (alternates-with) +(struct: repeated-section section + ([alternates-with : (Listof Part)]) #:transparent) -(struct substitution - (name - formatter - arguments) +(struct: substitution + ([name : String] + [formatter : String] + [arguments : (Listof String)]) #:transparent) -(define (parse-structure parsed-groups) - (let loop ([parsed-groups parsed-groups] - [clauses '()]) +(define: (parse-structure [parsed-groups : (Listof Group)]) + : (values (Listof Part) (U Symbol False) (Listof Group)) + (let: loop : (values (Listof Part) (U Symbol False) (Listof Group)) + ([parsed-groups : (Listof Group) parsed-groups] + [clauses : (Listof Part) '()]) (if (or (null? parsed-groups) - (and (pair? (car parsed-groups)) - (memq (caar parsed-groups) '(end or alternates-with)))) + (and (directive? (car parsed-groups)) + (memq (directive-type parsed-groups) '(end or alternates-with)))) (values (reverse clauses) - (and (pair? parsed-groups) (caar parsed-groups)) + (if (directive? parsed-groups) (caar parsed-groups) #f)) (if (pair? parsed-groups) (cdr parsed-groups) '())) (match (car parsed-groups) - [(list 'section x) + [(directive 'section (list x)) (let-values ([(stuff reason rest) (parse-structure (cdr parsed-groups))]) (case reason @@ -96,7 +122,7 @@ (loop rest2 (cons (section x stuff stuff2) clauses)))] [(end) (loop rest (cons (section x stuff #f) clauses))]))] - [(list 'repeated-section x) + [(directive 'repeated-section (list x)) (let inner-loop ([subsections '()] [rest (cdr parsed-groups)]) (let-values ([(stuff reason new-rest) @@ -106,8 +132,8 @@ (if (eq? reason 'end) (let inner-inner-loop ([subsections (cons (cons 'end stuff) subsections)] - [alternative #f] - [alternates-with #f]) + [alternative (list)] + [alternates-with (list)]) (if (null? (cdr subsections)) (loop new-rest (cons (repeated-section x @@ -127,44 +153,46 @@ [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) + [(directive 'substitute (list x)) (loop (cdr parsed-groups) (cons (substitution x #f '()) clauses))] - [(list 'substitute x y arg ...) + [(directive 'substitute (list x y arg ...)) (loop (cdr parsed-groups) (cons (substitution x y arg) clauses))] [x (loop (cdr parsed-groups) - (cons x clauses))])))) + (cons x clauses))]))) -(define (parse-structure* x) +(define: (parse-structure* [x : (Listof Group)]) : (Listof Part) (let-values ([(stuff reason rest) (parse-structure x)]) stuff)) -(struct template (expander) +(struct: template ([expander : (Any -> String)]) #: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 #:meta-left [meta-left "{"] +;; #:meta-right [meta-right "}"] +;; #:default-formatter [default-formatter "raw"] +;; #:format-char [format-char "|"]) +(define: (read-template [input-string : String]) : template (let ([template-data (parse-structure* (remove-spurious-newlines-from-token-groups - (classify-chunks (template-string->chunks (current-input-port) - meta-left meta-right) + (classify-chunks (template-string->chunks input-string + 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: (name->path [name : String]) : (Listof String) + (if (string=? name "@") + '() + (regexp-split #rx"\\." name))) -(define (resolve-path stack path) +(define: (resolve-path [stack : (Listof Any)] [path : (Listof String)]) : Any (if (null? stack) #f (let-values ([(value success?) @@ -173,7 +201,7 @@ value (resolve-path (cdr stack) path))))) -(define (resolve-path-in-object context path) +(define: (resolve-path-in-object [context : Any] [path : (Listof String)]) : (values Any Boolean) (let ([nothing (gensym)]) (cond [(null? path) (values context #t)] @@ -190,13 +218,12 @@ [else (values #f #f)]))) -(define (find-formatter name) - (cdr (assoc (if (string? name) - name - (bytes->string/utf-8 name)) - (formatters)))) +(define: (find-formatter [name : String]) : (String -> String) + (cdr (assoc name (formatters)))) -(define (expand-template template stack default-formatter) +(define: (expand-template [template : (Listof Part)] + [stack : (Listof Any)] + [default-formatter : String]) : Void (for ([thing template]) (match thing [(repeated-section name body alternative alternates-with) @@ -230,13 +257,13 @@ default-formatter))))] [(substitution name formatter args) (display ((find-formatter (or formatter default-formatter)) - (resolve-path stack (name->path name))))] + (format "~a" (resolve-path stack (name->path name)))))] [_ (display thing)]))) -(define (make-escaper replacements) +(define: (make-escaper [replacements : List]) : (String -> String) (let* ([escapees (map car replacements)] [escapings (map cdr replacements)] [re (regexp @@ -258,7 +285,7 @@ thing (format "~a" thing)) (λ () - (let loop () + (let: loop : Void () (unless (eof-object? (peek-byte)) (match-let ([(list* _ raw-text escapee-matches) (regexp-match re (current-input-port))]) @@ -271,7 +298,7 @@ (loop))))))))))) -(define (escape-for-uri thing) +(define: (escape-for-uri [thing : String]) : String (with-output-to-string (λ () (for ([char (in-string (if (string? thing) -- cgit v1.2.3 From d5266513238a4360e95732271eff8af510f626a5 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 22 Jun 2011 20:46:07 +0200 Subject: Finish Typed Racket implementation. --- json-template.rkt | 229 ++++++++++++++++++++++++++++++++---------------------- 1 file 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 '((#\< . "<") (#\> . ">") @@ -334,12 +374,10 @@ (#\' . "'") (#\" . """)))) ("url-param-value" . ,escape-for-uri) - ("raw" . ,(λ (x) x))))) + ("raw" . ,(λ: ([x : String]) x))))) -#; -(let ([template (with-input-from-string - #<{title|html} {.section people}
    @@ -351,7 +389,8 @@

    No one's registered.

    {.end} EOF - (λ () (read-template)))]) + ] + [template (make-template template-string)]) (template '((title . "") (people . (((name . "Nathalie") (age . 24)) -- cgit v1.2.3 From 619cc7ed168d47f942b7d4c2190562ac6eafea8b Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Wed, 22 Jun 2011 20:47:22 +0200 Subject: Comment the example code snippet out again. --- json-template.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/json-template.rkt b/json-template.rkt index 6a2a049..9729159 100755 --- a/json-template.rkt +++ b/json-template.rkt @@ -377,6 +377,7 @@ ("raw" . ,(λ: ([x : String]) x))))) +#; (let* ([template-string #<{title|html} {.section people} -- cgit v1.2.3 From 46e931cf02951d23ab208ae92c2516764db6d914 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 24 Jun 2011 18:35:48 +0200 Subject: Move public type declarations and definitions to the top of the file. --- json-template.rkt | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/json-template.rkt b/json-template.rkt index 9729159..f1a1b54 100755 --- a/json-template.rkt +++ b/json-template.rkt @@ -12,15 +12,16 @@ [dict-ref (Any Any Any -> Any)] [dict? (Any -> Boolean)]) -(provide make-template - formatters - meta-left - meta-right - default-formatter - format-char) +(provide: [make-template (String -> Template)] + [formatters (Parameterof (Listof (Pairof String (String -> String))))] + [meta-left (Parameterof String)] + [meta-right (Parameterof String)] + [default-formatter (Parameterof String)] + [format-char (Parameterof String)]) +(provide Template) -#; -(provide: ...) + +(define-type Template (Any -> Void)) (define meta-left (make-parameter "{")) (define meta-right (make-parameter "}")) @@ -209,9 +210,7 @@ ;; #:property prop:procedure (struct-field-index expander)) -(define-type template (Any -> Void)) - -(define: (make-template [input-string : String]) : template +(define (make-template input-string) (let ([template-data (parse-structure* (remove-spurious-newlines-from-token-groups @@ -363,7 +362,7 @@ (printf "%~x" cnum)))))))) -(define: formatters : (Parameterof (Listof (Pairof String (String -> String)))) +(define formatters (make-parameter `(("html" . ,(make-escaper '((#\< . "<") (#\> . ">") -- cgit v1.2.3 From 6d17cfbd3b77ef29a0926195f3addf3fe24f4b33 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Thu, 23 Jun 2011 14:54:09 +0200 Subject: Add some documentation. --- info.rkt | 2 ++ manual.scrbl | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 info.rkt create mode 100644 manual.scrbl 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/manual.scrbl b/manual.scrbl new file mode 100644 index 0000000..e372e34 --- /dev/null +++ b/manual.scrbl @@ -0,0 +1,110 @@ +#lang scribble/manual +@(require scribble/eval) +@(require racket/sandbox) +@(require (for-label r6rs)) +@;@(require (for-label "json-template.s6l")) +@(require "json-template.s6l") + +@;@defmodule/this-package[json-template] + +@(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 " +

    {title|html}

    +{.section people} +
      +{.repeated section @} +
    • {name} ({age} years)
      • +{.end} +
    +{.or} +

    No one's registered.

    +{.end} +")) +(template '((title . "") + (people . + (((name . "Nathalie") (age . 24)) + ((name . "Heinrich") (age . 28)) + ((name . "Hans") (age . 25)))))) +(template '((title . "") + (people))) +(template '((title . ""))) +] -- cgit v1.2.3 From 83d95a6203fd987a2496429ebe58608ee3596cf7 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Thu, 23 Jun 2011 18:24:53 +0200 Subject: Minor cleanups. --- manual.scrbl | 3 --- 1 file changed, 3 deletions(-) diff --git a/manual.scrbl b/manual.scrbl index e372e34..109ea24 100644 --- a/manual.scrbl +++ b/manual.scrbl @@ -3,9 +3,6 @@ @(require racket/sandbox) @(require (for-label r6rs)) @;@(require (for-label "json-template.s6l")) -@(require "json-template.s6l") - -@;@defmodule/this-package[json-template] @(define r6rs-evaluator (call-with-trusted-sandbox-configuration -- cgit v1.2.3 From d26a62ae614ae05aaa86962ae032a7d1b068f96e Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 24 Jun 2011 19:42:08 +0200 Subject: Adapt the manual to the Typed Racket implementation. --- manual.scrbl | 53 +++++++++++++++++------------------------------------ 1 file changed, 17 insertions(+), 36 deletions(-) diff --git a/manual.scrbl b/manual.scrbl index 109ea24..9f8b6b5 100644 --- a/manual.scrbl +++ b/manual.scrbl @@ -1,8 +1,10 @@ #lang scribble/manual +@;@(require planet/scribble) @(require scribble/eval) @(require racket/sandbox) -@(require (for-label r6rs)) -@;@(require (for-label "json-template.s6l")) +@(require (for-label racket)) +@(require (for-label "json-template.rkt")) +@;@(require (for-label (this-package-in json-template))) @(define r6rs-evaluator (call-with-trusted-sandbox-configuration @@ -19,45 +21,24 @@ [sandbox-error-output 'string]) (make-evaluator 'racket/base - #:requires (list 'json-template)))))) + #:requires (list "json-template.rkt")))))) +@(define typed-racket-evaluator + (call-with-trusted-sandbox-configuration + (lambda () + (parameterize ([sandbox-output 'string] + [sandbox-error-output 'string]) + (make-evaluator + 'typed/racket/base + #:requires (list "json-template.rkt")))))) -@title{JSON Template for R6RS} +@title{JSON Template for Racket (and Typed Racket)} @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. +JSON Template for Racket is published as a PLaneT module. Simply @racket[(require (planet mbenkard/json-template))] to get started. @section{Usage} @@ -72,7 +53,7 @@ On Racket, @codeblock[@"plt-r6rs --install json-template.s6l"] ought to work jus @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.} + @item{@bold{Maps.} These may be any kinds of objects; in particular, association lists and hash tables are fine choices. 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]. @@ -83,7 +64,7 @@ On Racket, @codeblock[@"plt-r6rs --install json-template.s6l"] ought to work jus @subsection{Examples} -@interaction[#:eval r6rs-evaluator +@interaction[#:eval racket-evaluator (define template (make-template "

    {title|html}

    {.section people} -- cgit v1.2.3 From 636bca26b171649af1e48f74e725b7a2157f5d49 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 24 Jun 2011 19:42:26 +0200 Subject: Add more metainformation to info.rkt. --- info.rkt | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/info.rkt b/info.rkt index 017c55c..5e17197 100644 --- a/info.rkt +++ b/info.rkt @@ -1,2 +1,22 @@ #lang setup/infotab +(define name "JSON Template for Racket") +(define blurb + '(p () + "A Typed Racket implementation of " + (a ((href "http://json-template.googlecode.com/svn/trunk/doc/Introducing-JSON-Template.html")) + "JSON Template") + ", a minimalistic, yet powerful, template language.")) +(define categories '(misc)) +(define version "1.0") +(define can-be-loadded-with 'all) +(define primary-file "json-template.rkt") +(define homepage "http://matthias.benkard.de/software/json-template-for-racket") (define scribblings '(("manual.scrbl" ()))) + +#; +(define release-notes + ...) + +#; +(define required-core-version + ...) -- cgit v1.2.3