#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
              '())))))