#!/usr/bin/guile \
-e main -s
!#

;; (add-to-load-path ".")
(add-to-load-path (dirname (current-filename)))
(add-to-load-path "/home/hugo/code/calp/module")

(use-modules
 (web client)
 (web response)
 (sxml simple)
 (sxml xpath)

 (ice-9 getopt-long)
 (ice-9 curried-definitions)
 (ice-9 format)

 ;; following are from calp
 (sxml namespace)
 ((calp util) :select (path-append))

 (feed-handler)

 ((xdg basedir) :prefix xdg-)
 )


(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 (filter-tree (feed-transformer feed)
                               feed-content))
          (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)))))))))


(define option-spec
  `((output (single-char #\o)
            (required? #f)
            (value #t)
            (description "Target directory for output files" (br)
                         "Defaults to " (i "$PWD") "."))
    (help (single-char #\h)
          (description "Print this help"))
    (config-dir (required? #f)
                (value #t)
                (description "Defaults to " (i "$XDG_CONFIG_DIR/rss-filter")))
    (quiet (value #f)
           (description "Supress info output"))))


(define (display-no-config config-dir)
  (format #t "Configuration directory [~a] doesn't exist, or is unreadable~%"
          config-dir))

(define (main args)

  (define opts (getopt-long args ((@ (calp util options) getopt-opt) option-spec)))
  (define output-directory (option-ref opts 'output "."))

  (define config-dir
    (option-ref opts 'config-dir
                (path-append (xdg-config-home)
                             "rss-filter")))

  (define quiet? (option-ref opts 'quiet #f))

  (when (option-ref opts 'help #f)
    ((@ (calp util options) print-arg-help) option-spec)
    (exit 0))

  (unless (file-exists? config-dir)
    (display-no-config config-dir)
    (exit 1))

  (add-to-load-path config-dir)

  (for-each (handle-feed output-directory quiet?) (@ (config) feeds)))