add options for ->html function

scribblings/template.scrbl

@@ -15,7 +15,10 @@ This module also provides everything from @racket[sugar/coerce/value].
 
 @defproc[
 (->html
-[xexpr xexpr?])
+[xexpr xexpr?]
+[#:tag html-tag (or/c #f txexpr-tag?) #f]
+[#:attrs html-attrs (or/c #f txexpr-attrs?) #f]
+[#:splice splice-html? boolean? #f])
 string?]
 Convert @racket[_xexpr] to an HTML string. Similar to @racket[xexpr->string], but consistent with the HTML spec, text that appears within @code{script} or @code{style} blocks will not be escaped.
 
@@ -25,6 +28,26 @@ Convert @racket[_xexpr] to an HTML string. Similar to @racket[xexpr->string], bu
 (->html tx)
 ]
 
+The optional keyword arguments @racket[_html-tag] and @racket[_html-attrs] let you replace the tag and attributes in the generated HTML.
+
+@examples[#:eval my-eval
+(define tx '(root ((id "huff")) "Bunk beds"))
+(->html tx)
+(->html tx #:tag 'div)
+(->html tx #:attrs '((id "doback")))
+(->html tx #:tag 'div #:attrs '((id "doback")))
+]
+
+The @racket[_splice-html?] option will strip the outer tag from the generated HTML.
+
+@examples[#:eval my-eval
+(define tx '(root (p "Orange marmalade")))
+(->html tx)
+(->html tx #:splice #t)
+]
+
+
+
 Be careful not to pass existing HTML strings into this function, because the angle brackets will be escaped. Fine if that's what you want, but you probably don't.
 
 @examples[#:eval my-eval

template.rkt

@@ -70,11 +70,19 @@
       (error (format "get-doc: no source found for '~a' in directory ~a" pagenode-or-path (current-directory)))))
 
 
-
+(define (trim-outer-tag html)
-
+  (define matches (regexp-match #px"<.*?>(.*)</.*?>" html))
-(define+provide/contract (->html x)
+  (define paren-match (cadr matches))
-  (xexpr? . -> . string?)  
+  paren-match)
-  (xexpr->html x))
+
+(define+provide/contract (->html x #:tag [tag #f] #:attrs [attrs #f] #:splice [splice? #f])
+  ((xexpr?) (#:tag (or/c #f txexpr-tag?) #:attrs (or/c #f txexpr-attrs?) #:splice boolean?) . ->* . string?)
+  (define html-tag (or tag (get-tag x)))
+  (define html-attrs (or attrs (get-attrs x)))
+  (define html (xexpr->html (make-txexpr html-tag html-attrs (get-elements x))))
+  (if splice?
+      (trim-outer-tag html)
+      html))
 
 
 (provide when/block)

tests/test-template.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+(require rackunit)
+(require "../template.rkt")
+
+(define x '(root (p "hello")))
+
+(check-equal? (->html x) "<root><p>hello</p></root>")
+(check-equal? (->html #:tag 'brennan x) "<brennan><p>hello</p></brennan>")
+(check-equal? (->html #:attrs '((id "dale")) x) "<root id=\"dale\"><p>hello</p></root>")
+(check-equal? (->html #:splice #t x) "<p>hello</p>")
+(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) x) "<brennan id=\"dale\"><p>hello</p></brennan>")
+(check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) #:splice #t x) "<p>hello</p>")