fix converter

pull/178/head
Matthew Butterick 6 years ago
parent fcc7c3cb3e
commit 09df7982a7

@ -1 +1 @@
1525128463
1527899366

@ -58,18 +58,18 @@ You are kitty}")
(define/contract+provide (html->xexpr html-string)
(string? . -> . xexpr?)
(use-html-spec #f)
(define xexpr-results
(let loop ([elem (read-html-as-xml (open-input-string html-string))])
(match elem
[(struct pcdata (start stop string)) string]
[(struct entity (start stop entity)) entity]
[(struct attribute (start stop key value)) (list key value)]
[(struct element (start stop name attributes content)) `(,name ,@(if (empty? attributes) empty (list (map loop attributes))) ,@(map loop content))]
[(list elements ...) (map loop elements)]
[else (format "unknown item: ~a" elem)])))
; xexpr-results will be a list with whitespace elements, so strip those out
(car (filter-not (conjoin string? whitespace?) xexpr-results)))
(define xexpr-results
; loop result will be a list with whitespace elements, so strip those out
(filter-not (conjoin string? whitespace?)
(let loop ([elem (read-html-as-xml (open-input-string html-string))])
(match elem
[(struct pcdata (start stop string)) string]
[(struct entity (start stop entity)) entity]
[(struct attribute (start stop key value)) (list key value)]
[(struct element (start stop name attributes content)) `(,name ,@(if (empty? attributes) empty (list (map loop attributes))) ,@(map loop content))]
[(list elements ...) (map loop elements)]
[else (format "unknown item: ~a" elem)]))))
(if (pair? xexpr-results) (car xexpr-results) ""))
(module+ test
(define (hx-identity xexpr)
@ -77,7 +77,8 @@ You are kitty}")
(check-true (hx-identity '(p "You are puppy")))
(check-true (hx-identity '(p ((class "foo")) "You are puppy")))
(check-true (hx-identity '(p)))
(check-true (hx-identity '(p ((class "foo")) "You are " (em "so") " puppy"))))
(check-true (hx-identity '(p ((class "foo")) "You are " (em "so") " puppy")))
(check-equal? (html->xexpr "\n") ""))
(define/contract+provide (html->pollen html-string #:white-p? [white-p? #f])

Loading…
Cancel
Save