From b19d763621ae6b7b600b2696a04832b40af8f14e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 13 Mar 2014 11:59:33 -0700 Subject: [PATCH] updates --- scribblings/template.scrbl | 24 +++++++++++ template.rkt | 87 ++++++++++---------------------------- tests/test-template.rkt | 37 ++++++++++++++++ 3 files changed, 83 insertions(+), 65 deletions(-) create mode 100644 scribblings/template.scrbl create mode 100644 tests/test-template.rkt diff --git a/scribblings/template.scrbl b/scribblings/template.scrbl new file mode 100644 index 0000000..44c073a --- /dev/null +++ b/scribblings/template.scrbl @@ -0,0 +1,24 @@ +#lang scribble/manual + +@(require scribble/eval pollen/cache pollen/world (for-label racket (except-in pollen #%module-begin) pollen/template pollen/render xml)) + +@(define my-eval (make-base-eval)) +@(my-eval `(require pollen pollen/template xml)) + +@title{Template} + +@defmodule[pollen/template] + +Convenience functions for templates. These are automatically imported into the @racket[eval] environment when rendering with a template (see @racket[render]). + +@defproc[ +(->html +[tx txexpr?]) +string?] +Convert @racket[_tx] to an HTML string. Consistent with the HTML spec (and unlike @racket[xexpr->string]), text that appears within @code{script} or @code{style} blocks will not be escaped. + +@examples[#:eval my-eval +(define tx '(root (script "3 > 2") "Why is 3 > 2?")) +(xexpr->string tx) +(->html tx) +] diff --git a/template.rkt b/template.rkt index e1f6a17..2322362 100644 --- a/template.rkt +++ b/template.rkt @@ -1,73 +1,46 @@ #lang racket/base -(require racket/contract racket/string xml xml/path) -(require "tools.rkt" "ptree.rkt" "cache.rkt" sugar txexpr "world.rkt") +(require (for-syntax racket/base)) +(require racket/string xml xml/path sugar/define sugar/container) +(require "tools.rkt" txexpr "world.rkt" "cache.rkt") -;; setup for test cases -(module+ test (require rackunit racket/path)) -(provide (all-defined-out)) -(require sugar/scribble sugar/coerce/value) -(provide (all-from-out sugar/scribble sugar/coerce/value)) +(require sugar/coerce/value) +(provide (all-from-out sugar/coerce/value)) -;; todo: docstrings for this subsection - -(define/contract (puttable-item? x) +(define+provide/contract (puttable-item? x) (any/c . -> . boolean?) (or (txexpr? x) (has-markup-source? x))) -(module+ test - (check-false (puttable-item? #t)) - (check-false (puttable-item? #f))) -(define/contract (query-key? x) +(define+provide/contract (query-key? x) (any/c . -> . boolean?) (or (string? x) (symbol? x))) -(define/contract (put x) + +(define+provide/contract (put x) (puttable-item? . -> . txexpr?) (cond ;; Using put has no effect on txexprs. It's here to make the idiom smooth. [(txexpr? x) x] [(has-markup-source? x) (cached-require (->markup-source-path x) world:main-pollen-export)])) -#|(module+ test - (check-equal? (put '(foo "bar")) '(foo "bar")) - (check-equal? (put "tests/template/put.pd") - '(root "\n" "\n" (em "One") " paragraph" "\n" "\n" "Another " (em "paragraph") "\n" "\n"))) -|# - -(define/contract (find query px) +(define+provide/contract (find query px) (query-key? (or/c #f puttable-item?) . -> . (or/c #f txexpr-element?)) (define result (and px (or (find-in-metas px query) (find-in-doc px query)))) (and result (car result))) ;; return false or first element -#| -(module+ test - (parameterize ([current-directory "tests/template"]) - (check-false (find "nonexistent-key" "put")) - (check-equal? (find "foo" "put") "bar") - (check-equal? (find "em" "put") "One")) - (check-equal? (find "foo" #f) #f)) -|# -(define/contract (find-in-metas px key) +(define+provide/contract (find-in-metas px key) (puttable-item? query-key? . -> . (or/c #f txexpr-elements?)) (and (has-markup-source? px) (let ([metas (cached-require (->markup-source-path px) 'metas)] [key (->string key)]) (and (key . in? . metas ) (->list (get metas key)))))) -#|(module+ test - (parameterize ([current-directory "tests/template"]) - (check-equal? (find-in-metas "put" "foo") (list "bar")) - (let* ([metas (cached-require (->markup-source-path 'put) 'metas)] - [here (find-in-metas 'put 'here)]) - (check-equal? here (list "tests/template/put"))))) -|# -(define/contract (find-in-doc px query) +(define+provide/contract (find-in-doc px query) (puttable-item? (or/c query-key? (listof query-key?)) . -> . (or/c #f txexpr-elements?)) (let* ([px (put px)] @@ -77,46 +50,30 @@ ;; if results exist, send back xexpr as output (and (not (empty? results)) results))) -#| -(module+ test - (parameterize ([current-directory "tests/template"]) - (check-false (find-in-doc "put" "nonexistent-key")) - (check-equal? (find-in-doc "put" "em") (list "One" "paragraph")))) -|# ;; turns input into xexpr-elements so they can be spliced into template ;; (as opposed to dropped in as a full txexpr) ;; by returning a list, pollen rules will automatically merge into main flow ;; todo: explain why ;; todo: do I need this? -(define/contract (splice x) +(define+provide/contract (splice x) ((or/c txexpr? txexpr-elements? string?) . -> . txexpr-elements?) (cond [(txexpr? x) (get-elements x)] [(txexpr-elements? x) x] [(string? x) (->list x)])) -(module+ test - (check-equal? (splice '(p "foo" "bar")) (list "foo" "bar")) - (check-equal? (splice (list "foo" "bar")) (list "foo" "bar")) - (check-equal? (splice "foo") (list "foo"))) - - -(define/contract (make-html x) - ((or/c txexpr? txexpr-elements? txexpr-element?) . -> . string?) - (cond - [(txexpr? x) (xexpr->string x)] - [else (let ([x (->list x)]) - (string-join (map xexpr->string x) ""))])) - -; generate *-as-html versions of functions -(define-values (put-as-html splice-as-html) - (apply values (map (λ(proc) (λ(x) (make-html (proc x)))) (list put splice)))) - - -(define/contract (->html x) +(define+provide/contract (->html x) (txexpr? . -> . string?) (txexpr->html x)) +(provide when/block) +(define-syntax (when/block stx) + (syntax-case stx () + [(_ condition body ...) + #'(if condition (string-append* + (with-handlers ([exn:fail? (λ(exn) (error (format "when/block: ~a" (exn-message exn))))]) + (map ->string (list body ...)))) + "")])) diff --git a/tests/test-template.rkt b/tests/test-template.rkt new file mode 100644 index 0000000..a4c64d8 --- /dev/null +++ b/tests/test-template.rkt @@ -0,0 +1,37 @@ +#lang racket/base +(require rackunit racket/path pollen/cache pollen/file) +(require "../template.rkt") + + +(check-equal? (put '(foo "bar")) '(foo "bar")) +(check-equal? (put "tests/template/put.pd") + '(root "\n" "\n" (em "One") " paragraph" "\n" "\n" "Another " (em "paragraph") "\n" "\n")) + + +(module+ test + (check-false (puttable-item? #t)) + (check-false (puttable-item? #f))) + + + + +(parameterize ([current-directory "tests/template"]) + (check-false (find "nonexistent-key" "put")) + (check-equal? (find "foo" "put") "bar") + (check-equal? (find "em" "put") "One")) +(check-equal? (find "foo" #f) #f) + +(parameterize ([current-directory "tests/template"]) + (check-equal? (find-in-metas "put" "foo") (list "bar")) + (let* ([metas (cached-require (->markup-source-path 'put) 'metas)] + [here (find-in-metas 'put 'here)]) + (check-equal? here (list "tests/template/put")))) + + +(parameterize ([current-directory "tests/template"]) + (check-false (find-in-doc "put" "nonexistent-key")) + (check-equal? (find-in-doc "put" "em") (list "One" "paragraph"))) + +(check-equal? (splice '(p "foo" "bar")) (list "foo" "bar")) +(check-equal? (splice (list "foo" "bar")) (list "foo" "bar")) +(check-equal? (splice "foo") (list "foo")) \ No newline at end of file