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