add txexpr->html and validate-txexpr

dev-53
Matthew Butterick 11 years ago
parent 060f2198ef
commit e3ef10b0ac

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require racket/match xml) (require racket/match xml racket/string)
(module+ safe (require racket/contract)) (module+ safe (require racket/contract))
@ -26,16 +26,27 @@
[(list (? symbol?) (? string?)) #t] [(list (? symbol?) (? string?)) #t]
[else #f])) [else #f]))
(define+provide+safe (txexpr-attrs? x)
(any/c . -> . boolean?) (define (validate-txexpr-attrs x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-attrs?)
(define (make-reason)
(if (not (list? x))
(format "because ~v is not a list" x)
(let ([bad-attrs (filter (λ(i) (not (txexpr-attr? i))) x)])
(format "because ~a ~a" (string-join (map (λ(ba) (format "~v" ba)) bad-attrs) " and ") (if (> (length bad-attrs) 1)
"are not valid attributes"
"is not in the form '(symbol \"string\")")))))
(match x (match x
[(list (? txexpr-attr?) ...) #t] [(list (? txexpr-attr?) ...) x]
[else #f])) [else [else (error (string-append "validate-txexpr-attrs: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid list of attributes ~a" x (make-reason))))]]))
(define+provide+safe (txexpr-element? x) (define+provide+safe (txexpr-attrs? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(or (string? x) (txexpr? x) (symbol? x) (with-handlers ([exn:fail? (λ(exn) #f)])
(valid-char? x) (cdata? x))) (and (validate-txexpr-attrs x) #t)))
(define+provide+safe (txexpr-elements? x) (define+provide+safe (txexpr-elements? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
@ -43,17 +54,43 @@
[(list elem ...) (andmap txexpr-element? elem)] [(list elem ...) (andmap txexpr-element? elem)]
[else #f])) [else #f]))
(define (validate-txexpr-element x #:context [txexpr-context #f])
; ((any/c) (#:context (or/c #f txexpr?)) . ->* . txexpr-element?)
(cond
[(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)) x]
[else (error (string-append "validate-txexpr-element: "
(if txexpr-context (format "in ~v, " txexpr-context) "")
(format "~v is not a valid element (must be txexpr, string, symbol, XML char, or cdata)" x)))]))
(define+provide+safe (txexpr-element? x)
(any/c . -> . boolean?)
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr-element x) #t)))
;; is it a named x-expression? ;; is it a named x-expression?
;; todo: rewrite this recurively so errors can be pinpointed (for debugging) ;; todo: rewrite this recurively so errors can be pinpointed (for debugging)
(define+provide+safe (validate-txexpr x)
(any/c . -> . txexpr?)
(define (validate-txexpr-element-with-context e) (validate-txexpr-element e #:context x))
(define (validate-txexpr-attrs-with-context e) (validate-txexpr-attrs e #:context x))
(when (match x
[(list (? symbol?)) #t]
[(list (? symbol? name) (and attr-list (list (list k v ...) ...)) rest ...)
(and (validate-txexpr-attrs-with-context attr-list)
(andmap validate-txexpr-element-with-context rest))]
[(list (? symbol? name) rest ...)(andmap validate-txexpr-element-with-context rest)]
[else (error (format "validate-txexpr: ~v is not a list starting with a symbol" x))])
x))
(define+provide+safe (txexpr? x) (define+provide+safe (txexpr? x)
(any/c . -> . boolean?) (any/c . -> . boolean?)
(and (xexpr? x) ; meets basic xexpr contract (with-handlers ([exn:fail? (λ(exn) #f)])
(match x (and (validate-txexpr x) #t)))
[(list (? symbol? name) rest ...) ;; is a list starting with a symbol
(or (null? rest)
(andmap txexpr-element? rest) ;; the rest is content or ...
(and (txexpr-attrs? (car rest)) (andmap txexpr-element? (cdr rest))))] ;; attr + content
[else #f])))
(define+provide+safe (make-txexpr tag [attrs null] [elements null]) (define+provide+safe (make-txexpr tag [attrs null] [elements null])
;; todo?: use xexpr/c provides a nicer error message ;; todo?: use xexpr/c provides a nicer error message
@ -63,8 +100,7 @@
(define+provide+safe (txexpr->values x) (define+provide+safe (txexpr->values x)
(txexpr? . -> . (txexpr? . -> . (values symbol? txexpr-attrs? (listof txexpr-element?)))
(values symbol? txexpr-attrs? (listof txexpr-element?)))
(match (match
; txexpr may or may not have attr ; txexpr may or may not have attr
; if not, add null attr so that decomposition only handles one case ; if not, add null attr so that decomposition only handles one case

@ -146,6 +146,24 @@ boolean?]
Shorthand for @code{(listof txexpr-attr?)} and @code{(listof txexpr-element?)}. Shorthand for @code{(listof txexpr-attr?)} and @code{(listof txexpr-element?)}.
@defproc[
(validate-txexpr
[possible-txexpr any/c])
txexpr?]
Like @racket[txexpr?], but raises a descriptive error if @racket[_possible-txexpr] is invalid, and otherwise returns @racket[_possible-txexpr] itself.
@examples[#:eval my-eval
(validate-txexpr 'root)
(validate-txexpr '(root))
(validate-txexpr '(root ((id "top")(class 42))))
(validate-txexpr '(root ((id "top")(class "42"))))
(validate-txexpr '(root ((id "top")(class "42")) ("hi")))
(validate-txexpr '(root ((id "top")(class "42")) "hi"))
]
@deftogether[( @deftogether[(
@defproc[ @defproc[
@ -203,6 +221,19 @@ Like @racket[txexpr->values], but returns the three components in a list.
(txexpr->list '(div [[id "top"]] "Hello" (p "World"))) (txexpr->list '(div [[id "top"]] "Hello" (p "World")))
] ]
@defproc[
(txexpr->html
[tx txexpr?])
string?]
Convert @racket[_tx] to an HTML string. Better than @racket[xexpr->string] because consistent with the HTML spec, it will not escape text that appears within @code{script} or @code{style} blocks.
@examples[#:eval my-eval
(define tx '(root (script "3 > 2") "Why is 3 > 2?"))
(xexpr->string tx)
(txexpr->html tx)
]
@deftogether[( @deftogether[(
@defproc[ @defproc[
(get-tag (get-tag

@ -118,3 +118,5 @@
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))) list) (check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))) list)
(list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))) (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(check-equal? (txexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
"<root><script>3 > 2</script>Why is 3 &gt; 2?</root>")
Loading…
Cancel
Save