add txexpr->html and validate-txexpr

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

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/match xml)
(require racket/match xml racket/string)
(module+ safe (require racket/contract))
@ -26,16 +26,27 @@
[(list (? symbol?) (? string?)) #t]
[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
[(list (? txexpr-attr?) ...) #t]
[else #f]))
[(list (? txexpr-attr?) ...) x]
[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?)
(or (string? x) (txexpr? x) (symbol? x)
(valid-char? x) (cdata? x)))
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr-attrs x) #t)))
(define+provide+safe (txexpr-elements? x)
(any/c . -> . boolean?)
@ -43,17 +54,43 @@
[(list elem ...) (andmap txexpr-element? elem)]
[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?
;; 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)
(any/c . -> . boolean?)
(and (xexpr? x) ; meets basic xexpr contract
(match x
[(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])))
(with-handlers ([exn:fail? (λ(exn) #f)])
(and (validate-txexpr x) #t)))
(define+provide+safe (make-txexpr tag [attrs null] [elements null])
;; todo?: use xexpr/c provides a nicer error message
@ -63,8 +100,7 @@
(define+provide+safe (txexpr->values x)
(txexpr? . -> .
(values symbol? txexpr-attrs? (listof txexpr-element?)))
(txexpr? . -> . (values symbol? txexpr-attrs? (listof txexpr-element?)))
(match
; txexpr may or may not have attr
; 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?)}.
@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[(
@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")))
]
@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[(
@defproc[
(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)
(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