From e3ef10b0ac8c00326e154223b806cfc172d46886 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 13 Mar 2014 11:42:54 -0700 Subject: [PATCH] add txexpr->html and validate-txexpr --- main.rkt | 70 ++++++++++++++++++++++++++++++---------- scribblings/txexpr.scrbl | 31 ++++++++++++++++++ tests.rkt | 2 ++ 3 files changed, 86 insertions(+), 17 deletions(-) diff --git a/main.rkt b/main.rkt index acddbbe..48ae6aa 100644 --- a/main.rkt +++ b/main.rkt @@ -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 diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl index e98b93b..4323bef 100644 --- a/scribblings/txexpr.scrbl +++ b/scribblings/txexpr.scrbl @@ -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 diff --git a/tests.rkt b/tests.rkt index b4bb2dc..d361327 100644 --- a/tests.rkt +++ b/tests.rkt @@ -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?")) + "Why is 3 > 2?") \ No newline at end of file