From 3903337fd701f60cec51014f6670c0ac06e2b247 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Tue, 26 Mar 2024 02:23:21 +0900 Subject: Add xexpr->text procedure. --- presenters/xexpr-to-text.rkt | 50 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 50 insertions(+) create mode 100644 presenters/xexpr-to-text.rkt (limited to 'presenters') diff --git a/presenters/xexpr-to-text.rkt b/presenters/xexpr-to-text.rkt new file mode 100644 index 0000000..28fa4bf --- /dev/null +++ b/presenters/xexpr-to-text.rkt @@ -0,0 +1,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 + '()))))) -- cgit v1.2.3