blob: 33a06d1c372a8fa56cc2e9d077f6f3371541b62d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
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)))))
))
))
|
