#! /usr/local/bin/mzscheme
#lang scheme/base

(require xml
         (lib "match.ss")
         scheme/pretty)

(define (string-whitespace? str)
  (and (string? str)
       (let rest?
           ((l (string->list str)))
         (or (null? l)
             (and (char-whitespace? (car l))
                  (rest? (cdr l)))))))


(define (cleanup xexpr)
  (if (pair? xexpr)
      (if (string-whitespace? (car xexpr))
          (cleanup (cdr xexpr))
          (cons (cleanup (car xexpr))
                (cleanup (cdr xexpr))))
      xexpr))


(define (xml2xexpr)
  (pretty-print
   (cleanup
    (xml->xexpr        
     (document-element         
      (read-xml))))))


(xml2xexpr)