diff options
Diffstat (limited to '')
-rw-r--r-- | config.scm | 81 |
1 files changed, 81 insertions, 0 deletions
diff --git a/config.scm b/config.scm new file mode 100644 index 0000000..33a06d1 --- /dev/null +++ b/config.scm @@ -0,0 +1,81 @@ +(define-module (config) + :export (feeds)) + +(use-modules + (sxml xpath) + (ice-9 regex) + + (feed-handler) + + ((datetime) :select (datetime datetime->string))) + + +(define (parse-month str) + "Get month number from (a shortened) monthname. +Returns -1 on failure" + (let loop ((i 1) + (months + (list "january" "february" "march" "april" "may" "june" "july" + "august" "september" "october" "november" "december"))) + + + (if (null? months) + -1 + (let ((len (min (string-length (car months)) + (string-length str)))) + (if (string=? + (string-take (string-downcase str) len) + (string-take (car months) len)) + i + (loop (1+ i) (cdr months))))))) + + +(define (parse-date str) + (and=> (string-match "([a-zA-Z]*)\\. ([0-9]+), ([0-9]+), ([0-9]+):([0-9]+) ([ap])\\.m\\." str) + (lambda (m) + (let ((month (match:substring m 1)) + (day (string->number (match:substring m 2))) + (year (string->number (match:substring m 3))) + (hour (string->number (match:substring m 4))) + (minute (string->number (match:substring m 5))) + (am-pm (match:substring m 6))) + (datetime #:year year + #:month (parse-month month) + #:day day + #:hour (+ hour (if (string=? am-pm "p") 12 0)) + #:minute minute))))) + +(define feeds + (list + (make-feed + "https://lwn.net/headlines/Features" + `((rss:item + . ,(lambda (key . children) + (define tag (cons key children)) + (call-with-values (lambda () (apply values ((sxpath '(rss:title *text*)) tag))) + (case-lambda (() tag) + ((title . _) + (if (string-match "^\\[\\$\\]" title) + '() tag)))))))) + + (make-feed + "https://swordscomic.com/comic/feed/" + `((rss:pubDate + . ,(lambda (key . children) + (cond ((parse-date (car children)) + => (lambda (dt) + (list key (datetime->string dt "~Y-~m-~dT~H:~M:~S")))) + (else (cons key children))))) + + (rss:description + . ,(lambda (key . children) + (cons key + ;; Each entry has a <style/> tag at the + ;; beggining, which brakes the short preview on + ;; NetNewsWire. This removes it + (cond ((string-match "</style>" (car children)) + => (lambda (m) + (list (string-drop (car children) (match:end m))))) + (else children))))) + )) + )) |