diff --git a/txexpr/base.rkt b/txexpr/base.rkt index 43c10bb..b6ccbfc 100644 --- a/txexpr/base.rkt +++ b/txexpr/base.rkt @@ -4,7 +4,7 @@ xml "private/define-provide-safe-match.rkt" (for-syntax racket/base syntax/parse)) -(provide cdata? cdata valid-char? xexpr->string xexpr?) ; from xml +(provide cdata? cdata valid-char? xexpr->string xexpr? comment comment?) ; from xml (provide empty) ; from racket/list ;; Section 2.2 of XML 1.1 @@ -101,10 +101,10 @@ (andmap (lambda (e) (cond - [(or (string? e) (symbol? e) (my-valid-char? e) (cdata? e)) #t] + [(or (string? e) (symbol? e) (my-valid-char? e) (cdata? e) (comment? e)) #t] [(and (list? e) (symbol? (first e))) (validate-txexpr e)] - [else (txexpr-error "element" "not a valid element (= txexpr, string, symbol, XML char, or cdata)" e tx)])) + [else (txexpr-error "element" "not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)" e tx)])) elems)) (define (txexpr-error noun has-problem bad tx) @@ -306,15 +306,23 @@ (define (cdata-string? x) (and (string? x) (regexp-match #rx"^$" x) #true)) +(define comment-pattern #rx"^$") + +(define (string->comment x) + (match (regexp-match comment-pattern x) + [(list _ comment-payload) (comment comment-payload)] + [_ #false])) + (define+provide+safe (xexpr->html x) (xexpr? . -> . string?) (xexpr->string (let loop ([x x]) - (match x - [(? txexpr?) + (cond + [(txexpr? x) (define-values (tag attrs elements) (txexpr->values x)) (define proc (if (memq tag '(script style)) ->cdata loop)) ;; a little faster than `txexpr` since we know the pieces are valid (txexpr-unsafe tag attrs (map proc elements))] - [(? cdata-string?) (->cdata x)] - [_ x])))) + [(cdata-string? x) (->cdata x)] + [(and (string? x) (string->comment x))] + [else x])))) diff --git a/txexpr/test/tests.rkt b/txexpr/test/tests.rkt index 3e66fd3..48865af 100644 --- a/txexpr/test/tests.rkt +++ b/txexpr/test/tests.rkt @@ -94,7 +94,7 @@ ;; Invalid element (check-validate-exn-msg '(p "foo" "bar" ((key "value"))) - "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))") + "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))") ;; Malformed attribute list (check-validate-exn-msg @@ -114,17 +114,17 @@ ;; Invalid element type (check-validate-exn-msg `(root ,(void)) - "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: #\n in: '(root #)") + "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)\n element: #\n in: '(root #)") ;; (Deeply nested) No name: error should pinpoint element in 'div txexpr (check-validate-exn-msg '(fine-outer [[type "valid"]] (div (br) ("p" "foo" "bar"))) - "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '(\"p\" \"foo\" \"bar\")\n in: '(div (br) (\"p\" \"foo\" \"bar\"))") + "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)\n element: '(\"p\" \"foo\" \"bar\")\n in: '(div (br) (\"p\" \"foo\" \"bar\"))") ;; (Deeply nested) Invalid element: error should pinpoint element in 'p txexpr (check-validate-exn-msg '(fine-outer [[type "valid"]] (div (br) (p "foo" "bar" ((key "value"))))) - "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))") + "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)\n element: '((key \"value\"))\n in: '(p \"foo\" \"bar\" ((key \"value\")))") ;; (Deeply nested) Malformed attribute list: error should pinpoint attr in 'p txexpr (check-validate-exn-msg @@ -144,7 +144,7 @@ ;; (Deeply nested) Invalid element type: error should pinpoint element in 'p txexpr (check-validate-exn-msg `(fine-outer [[type "valid"]] (div (br) (p ,(void)))) - "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, or cdata)\n element: #\n in: '(p #)") + "validate-txexpr: element not a valid element (= txexpr, string, symbol, XML char, cdata, or comment)\n element: #\n in: '(p #)") (check-txexprs-equal? (make-txexpr 'p) '(p)) (check-txexprs-equal? (make-txexpr 'p '((key "value"))) '(p ((key "value")))) @@ -309,4 +309,16 @@ "Why is 3 > 2?") (check-equal? (xexpr->html '(root (div " 2]]>") "Why is 3 > 2?")) - "
2]]>
Why is 3 > 2?
")) \ No newline at end of file + "
2]]>
Why is 3 > 2?
") + + ;; comment + (check-equal? (xexpr->html '(root "" "Why is 3 > 2?")) + "Why is 3 > 2?") + + ;; malformed comment: merged with next string + (check-equal? (xexpr->html '(root "Why is 3 > 2?")) + "<!-- comment -->Why is 3 > 2?") + + ;; malformed comment: missing double hyphen at end + (check-equal? (xexpr->html '(root "