sxml-transforms identity pasted by wasamasa on Fri May 6 12:11:37 2016

(define xml '(*TOP* (*PI* (xml "version=\"1.0\"") (foo (@ (bar "baz")) (qux "quux")))))

(define (xml-identity xml)
  (pre-post-order*
   xml
   `((*default* . ,(lambda x x))
     (*text* . ,(lambda (_ text) text)))))

(xml-identity xml)
;; (*TOP* ((*PI* ((xml ("version=\"1.0\"")) (foo ((@ ((bar ("baz")))) (qux ("quux"))))))))

fixed sxml-transforms identity pasted by wasamasa on Fri May 6 12:32:19 2016

(define (xml-identity xml)
  (pre-post-order-splice*
   xml
   `((*default* . ,(lambda (tag elements) (cons tag elements)))
     (*text* . ,(lambda (_ text) text)))))

xml namespace stripping added by wasamasa on Fri May 6 12:33:54 2016

(define (namespaced-tag? tag)
  (let ((name (symbol->string tag)))
    (substring-index ":" name)))

(define (strip-namespace tag)
  (let ((name (symbol->string tag)))
    (string->symbol (last (string-split name ":")))))

(define (strip-namespaces xml)
  (pre-post-order*
   xml
   `((*text* . ,(lambda (_ str) str))
     (*default* . ,(lambda (tag elements)
                     (if (namespaced-tag? tag)
                         (cons (strip-namespace tag) elements)
                         (cons tag elements)))))))