#lang racket/base
(require sugar/define sugar/test txexpr/base pollen/private/splice pollen/setup)
(define (trim-outer-tag html)
(define matches (regexp-match #px"^<.*?>(.*)$" html))
(define paren-match (cadr matches))
paren-match)
(define splicing-tag (setup:splicing-tag))
(define (has-outer-splice-tag? x)
(and (pair? x) (eq? (get-tag x) splicing-tag)))
(define+provide/contract (->html x-arg-maybe-spliced
#:tag [tag #f]
#:attrs [attrs #f]
#:splice? [new-splice-arg? #f]
#:splice [backward-compatible-splice-arg? #f])
(((or/c txexpr-element? txexpr-elements?))
(#:tag (or/c #f txexpr-tag?)
#:attrs (or/c #f txexpr-attrs?)
#:splice? boolean?
#:splice boolean?) . ->* . string?)
;; handle an outer splice tag specially, because `splice` will leave it
(define x-arg (if (has-outer-splice-tag? x-arg-maybe-spliced)
(cdr x-arg-maybe-spliced)
x-arg-maybe-spliced))
;; x is an X-expression
(define x (if (list? x-arg)
(splice (if (txexpr? x-arg)
x-arg
(cons 'html x-arg)) splicing-tag) ; list of txexpr-elements
x-arg))
(when (and (not (txexpr? x)) attrs (not tag))
(raise-argument-error '->html "can't use attribute list without a #:tag argument" tag))
(define splice? (or new-splice-arg? backward-compatible-splice-arg?))
(cond
[(or tag (txexpr? x))
(define html-tag (or tag (get-tag x)))
(define html-attrs (or attrs (and (txexpr? x) (get-attrs x)) null))
(define html-elements (or (and (txexpr? x) (get-elements x)) (list x)))
(define html (xexpr->html (txexpr html-tag html-attrs html-elements)))
(if (or splice? (and (list? x-arg) (not (txexpr? x-arg)) (not tag)))
(trim-outer-tag html)
html)]
[else (xexpr->html x)]))
(module-test-external
(require txexpr)
(define tx '(root (p "hello")))
(check-equal? (->html tx) " hello hello hello
hello
") (check-equal? (->html #:tag 'brennan #:attrs '((id "dale")) tx) "hello
hello
") (define x "hello") (check-equal? (->html x) "hello") (check-equal? (->html #:tag 'brennan x) "