(define-module (rss-filter)
  :export (handle-feed)
  :use-module (ice-9 curried-definitions)
  :use-module (ice-9 match)
  :use-module (rss-filter feed-handler)
  :use-module (web client)
  :use-module (web response)
  :use-module (sxml simple)
  :use-module (sxml xpath)
  :use-module (sxml namespace)

  :use-module ((hnh util path) :select (path-append))
  :use-module (datetime)
  )

(define (make-debug-item call-stack)
  `(item
    (title "RSS-FILTER ERROR")
    (link "https://git.hornquist.se/rss-filter/")
    (guid "RSS-FILTER-ERROR")
    (description
     ,(with-output-to-string
        (lambda ()
          (sxml->xml
           `(div
             (div (@ (style "background-color: pink"))
                  "Something went wrong when filtering this item")
             (pre
              ,(with-output-to-string
                 (lambda ()
                   ((@ (system repl debug) terminal-width) #e1e10)
                   (display-backtrace
                    call-stack (current-output-port))))))))))
    (author "rss-filter VERSION HERE")
    (pubDate ,(datetime->string (current-datetime)))))


(define ((handle-feed output-directory quiet?) feed)
  (define response
    (begin
      (when (not quiet?)
       (format (current-error-port) "Fetching ~a~%" (feed-url feed)))
      ;; TODO follow redirects
      (http-get (feed-url feed)
                #:streaming? #t)))

  (unless (= 200 (response-code response))
    (format (current-error-port) "HTTP error ~a"
            (response-code response))
    (exit 1))

  (let* ((feed-content (move-to-namespace (parse-rss (response-body-port response))
                                          '((#f . rss))))
         (feed-title (car ((sxpath '(// rss:channel rss:title *text*)) feed-content)))
         (safe-title (string-map (lambda (c) (if (char-set-contains? char-set:letter+digit c)
                                            c #\_))
                                 feed-title)))


    (let ((output
           (let ((call-stack #f))
             (catch
               #t (lambda () (filter-tree (feed-transformer feed)
                                     feed-content))
               ;; error handler
               (lambda _
                 (filter-tree
                  `((rss:channel . ,(match-lambda*
                                  ((tag . (('@ args ...) body ...))
                                   `(,tag (@ ,@args)
                                          ,(make-debug-item call-stack)
                                          ,@body))
                                  ((tag body ...)
                                   `(,tag ,(make-debug-item call-stack)
                                          ,@body)))))
                  feed-content))
               ;; pre unwind hadler
               (lambda _ (set! call-stack (make-stack #t))))))
          (filename (string-append
                     (path-append output-directory safe-title)
                     ".rss")))
      (with-output-to-file filename
        (lambda ()
          (sxml->xml
           ;; Removing the rss prefix should be fine, but at least NewNewsWire
           ;; (for iPad) expects all rss elements to be un-namespaced.
           (move-to-namespace output '((rss . #f)))))))))