#lang scheme/base
(require (only-in html read-html-as-xml)
"depend.ss"
"xml.ss"
(rename-in "depend.ss" (srl:sxml->xml-noindent sxml->string))
)
(define xml? (tokens #"<?" #"xml" (return #t)))
(define (single-element? contents)
(= 1 (length (filter xexpr? contents))))
(define (html->xexpr contents)
(let ((contents (map xml->xexpr contents)))
(cond ((single-element? contents)
(car contents))
(else
`(*TOP* . ,contents)))))
(define (read-xexpr/html in)
(html->xexpr (read-html-as-xml in)))
(define (read-xexpr/xml in)
(xml->xexpr (document-element (read-xml in))))
(define (read-xexpr in (filter identity))
(define (helper in)
(let-values (((v IN)
(xml? (make-input in))))
(if (failed? v)
read-xexpr/html
read-xexpr/xml)))
(filter ((helper in) in)))
(define (read-sxml in (filter identity))
(xexpr->sxml (read-xexpr in filter)))
(define (write-xexpr xexpr (out (current-output-port)))
(write-string (xexpr->string xexpr) out))
(define (write-sxml sxml (out (current-output-port)))
(write-string (sxml->string sxml) out))
(define xexpr/c* any/c)
(define sxml/c any/c)
(define is-xml? (make-reader xml?))
(define (normalize-xml-bytes bytes)
(if (is-xml? bytes)
bytes
(bytes-append #"<?xml version=\"1.0\" ?>" bytes)))
(provide/contract
(read-xexpr (->* (input-port?)
(isa/c) any)) (read-sxml (->* (input-port?)
(isa/c) any))
(write-xexpr (->* (xexpr/c*)
(output-port?)
any))
(write-sxml (->* (sxml/c)
(output-port?)
any))
(is-xml? Reader/c)
(normalize-xml-bytes (-> bytes? bytes?))
)
(provide sxml->string)