(define-module (rss-filter feed-handler)
  :use-module (rnrs records syntactic)
  :use-module (sxml simple)
  :use-module (sxml transform)
  :use-module (sxml xpath)
  :export (make-feed feed-url feed-transformer
                     parse-rss filter-tree))

(define-record-type feed
  (fields url transformer))


(define rss-namespaces
  '((rdf . "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
    (dc . "http://purl.org/dc/elements/1.1/")
    (syn . "http://purl.org/rss/1.0/modules/syndication/")
    (rss . "http://purl.org/rss/1.0/")
    (atom . "http://www.w3.org/2005/Atom")
    (#f . "http://purl.org/rss/1.0/")
    ))

(define (parse-rss port)
  (xml->sxml port #:namespaces rss-namespaces))

(define (namespaces->sxml namespaces)
  (map (lambda (namespace)
         (list (string->symbol
                (if (not (car namespace))
                    "xmlns"
                    (string-append "xmlns:" (symbol->string (car namespace)))))
               (cdr namespace)))
       namespaces))


(define (filter-tree transformers tree)
  (pre-post-order
   tree
   `(,@transformers
     (rdf:RDF . ,(lambda (tag . children)
                   (cond (((sxpath '(@)) (cons tag children))
                          (negate null?)
                          => (lambda (attributes)
                               (write attributes (current-error-port)) (newline (current-error-port))
                               `(,tag
                                 (@ ,@(namespaces->sxml rss-namespaces)
                                    ,@(cdar attributes))
                                 ,@(cdr children))))
                         (else
                          `(,tag (@ ,@(namespaces->sxml rss-namespaces))
                                 ,@(cdr children))))))
     (*text* . ,(lambda (_ x . xs) x))
     (*default* . ,(lambda (item  . children)
                     (cons item children))))) )