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)))))
+      ))
+   ))