blob: 28fa4bf221cba59025a009a6d911080f20b88981 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
#lang typed/racket
(provide xexpr->text)
(require typed/xml)
(: xexpr->text (-> XExpr String))
(define (xexpr->text xexpr)
(cond
[(string? xexpr) xexpr]
[(number? xexpr) (number->string xexpr)]
[(symbol? xexpr) (symbol->string xexpr)]
[(pair? xexpr)
(let* ([fst (car xexpr)]
[text (get-text xexpr->text xexpr)]
[_attrs (get-attrs xexpr)])
(case fst
[(br) "\n"]
[else text]))]
[(cdata? xexpr) (cdata-string xexpr)]
[(or (comment? xexpr) (p-i? xexpr)) ""]))
(define-predicate xexpr-attribute? XExpr-Attribute)
(: get-text (-> (-> XExpr String)
(U (Pair Symbol (Pair (Listof XExpr-Attribute) (Listof XExpr)))
(Pair Symbol (Listof XExpr)))
String))
(define (get-text f xexpr)
(let ([rst (cdr xexpr)])
(if (null? rst)
(string-append* (map f rst))
(let ([attrs (car rst)])
(if (and (or (null? attrs) (pair? attrs))
(andmap xexpr-attribute? attrs))
(string-append* (map f (cdr rst)))
(string-append* (map f rst)))))))
(: get-attrs (-> (U (Pair Symbol (Pair (Listof XExpr-Attribute) (Listof XExpr)))
(Pair Symbol (Listof XExpr)))
(Listof XExpr-Attribute)))
(define (get-attrs xexpr)
(let ([rst (cdr xexpr)])
(if (null? rst)
'()
(let ([attrs (car rst)])
(if (and (or (null? attrs) (pair? attrs))
(andmap xexpr-attribute? attrs))
attrs
'())))))
|
