git.m455.casa

m455.casa

clone url: git://git.m455.casa/m455.casa


src/generate-rss-feed.scm

1 (include "src/imports.scm")
2 (include "src/static.scm")
3 (include "src/utils.scm")
4 (include "src/parser.scm")
5
6 ;; this is mostly to fix the issue of rss readers opening relative links.
7 ;; this just takes links like "/path/to/thing.html" and changes them
8 ;; to "https://example.com/path/to/thing.html"
9 (define (relative-links->urls str)
10 (irregex-replace/all
11 (irregex "\\[(/[^\\[]*)\\|([^\\[]*)\\]" 's)
12 str
13 (lambda (m)
14 (format "[https://m455.casa~a|~a]"
15 (irregex-match-substring m 1) ;; link
16 (irregex-match-substring m 2))))) ;; title
17
18 (define (date->rss-date str)
19 (time->string
20 (string->time str "%Y-%m-%d %H:%M")
21 "%a, %d %b %Y %H:%M:%S %z"))
22
23 (define (post->rss-item path-data)
24 (let* ((content (with-input-from-file (alist-ref 'path path-data) read-string))
25 (content-links-fixed (relative-links->urls content))
26 (path (pathname-replace-extension (alist-ref 'path path-data) "html")))
27 (string-populate
28 RSS-ITEM-TEMPLATE
29 `((post-title . ,(alist-ref 'title path-data))
30 (post-url . ,(string-append "https://m455.casa/" path))
31 (post-date . ,(date->rss-date (alist-ref 'date path-data)))
32 (post-contents . ,(parse-lines
33 (with-input-from-string content-links-fixed read-lines)
34 'normal))))))
35
36 (define (main)
37 (let* ((paths-data (paths->sorted-alists (directory POSTS-DIRECTORY)))
38 (posts-as-rss-items (string-intersperse (map post->rss-item paths-data) "\n")))
39 (file-write
40 (make-pathname BUILD-DIRECTORY "feed.rss")
41 (string-populate RSS-CHANNEL-TEMPLATE `((items . ,posts-as-rss-items))))))
42
43 (main)