git.m455.casa

m455.casa

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

src/generate.scm

1 (module generate ()
2
3 (import scheme
4 utf8
5 srfi-1
6 (chicken base)
7 (chicken format)
8 (chicken time posix)
9 (chicken irregex)
10 (chicken pathname)
11 (chicken string)
12 (chicken file)
13 (chicken io)
14 (chicken port)
15 static
16 utils
17 parser)
18
19 ;; generate posts page ======================================================
20 (define (path-data->html-link path-data)
21 (format " <li><a href=\"/~a\">~a</a></li>"
22 (pathname-replace-extension (alist-ref 'path path-data) "html")
23 (clean (alist-ref 'title path-data))))
24
25 (define (create-posts-page posts-data)
26 (let* ((posts-list (map path-data->html-link posts-data))
27 ;; TODO: probably turn this into a template eventually
28 (html-contents (string-append
29 "<h1>posts</h1>\n"
30 "<ul>\n"
31 (string-intersperse posts-list "\n")
32 #<<STRING-BLOCK
33 </ul>
34
35 <h2 id="old-archived-posts">old archived posts</h2>
36
37 <p>this section contains a list of html pages that were originally generated
38 using a mix of my favourite programming language at the time and pandoc. i've
39 archived these for good memories more than anything, and i've kept that as html
40 instead of the original source so i don't have to worry about parsing them in
41 the future. <a href="/posts/starting-fresh.html">i've also decided to write
42 more informally and personal</a> on my homepage, because this isn't a
43 professional blog, it's place for me to explore doing things i like, be it
44 programming, parsers, non computer things, or something else. in retrospect, my
45 attempt at making things look very well written and professional-looking was
46 probably a reflection of how much i worried about what other people thought
47 about me or my writing.</p>
48
49 <p>in order from oldest to newest,
50 <a href="https://codeberg.org/m455/pancake">pancake</a>,
51 <a href="https://codeberg.org/m455/wg">wg</a>, and
52 <a href="https://codeberg.org/m455/lol">lol</a> all used to generate the
53 archived pages below from markdown using pandoc:</p>
54
55 <ul>
56 <li><a href="/posts/trying-out-an-early-web-look-for-my-homepage.html">Trying out an early web look for my homepage</a></li>
57 <li><a href="/posts/home-hosting.html">Home-hosting</a></li>
58 <li><a href="/posts/redesigning-my-paste-service-with-fennel.html">Redesigning my paste service with Fennel</a></li>
59 <li><a href="/posts/weechat-tips.html">WeeChat tips</a></li>
60 <li><a href="/posts/setting-up-a-paste-service-with-vim-rsync-and-nginx.html">Setting up a paste service with Vim, rsync, and nginx</a></li>
61 <li><a href="/posts/connecting-to-twitch-with-weechat.html">Connecting to Twitch with WeeChat</a></li>
62 <li><a href="/posts/setting-up-a-git-forge-with-gitea.html">Setting up a Git forge with Gitea</a></li>
63 <li><a href="/posts/setting-up-an-irc-server-with-oragono.html">Setting up an IRC server with Oragono</a></li>
64 <li><a href="/posts/generating-a-list-of-posts-for-my-blog.html">Generating a list of posts for my blog</a></li>
65 <li><a href="/posts/adding-date-support-to-my-awful-rss-feed-generator.html">Adding date support to my awful RSS-feed generator</a></li>
66 <li><a href="/posts/why-i-dont-use-facebook-products.html">Why I don't use Facebook products</a></li>
67 <li><a href="/posts/all-about-my-awful-rss-feed-generator.html">All about my awful RSS feed generator</a></li>
68 <li><a href="/posts/thoughts-on-technical-writing-and-accidentally-gatekeeping-communities.html">Thoughts on technical writing and accidentally gatekeeping communities</a></li>
69 <li><a href="/posts/having-fun-with-lisps.html">Having fun with Lisp(s)</a></li>
70 <li><a href="/posts/public-unix-server-etiquette.html">Public Unix server etiquette</a></li>
71 <li><a href="/posts/what-i-like-about-the-scheme-community.html">What I like about the Scheme community</a></li>
72 <li><a href="/posts/what-are-social-unix-servers.html">What are social Unix servers?</a></li>
73 <li><a href="/posts/redirecting-your-github-pages-website-to-a-dat-url.html">Redirecting your GitHub Pages website to a Dat URL</a></li>
74 <li><a href="/posts/setting-up-graphical-applications-in-windows-subsystem-for-linux.html">Setting up graphical applications in Windows Subsystem for Linux</a></li>
75 <li><a href="/posts/setting-up-a-chinese-input-method-on-debian.html">Setting up a Chinese input method on Debian</a></li>
76 <li><a href="/posts/a-quick-guide-to-pronouncing-chinese-words.html">A quick guide to pronouncing Chinese words</a></li>
77 <li><a href="/posts/interpreting-second-language-speakers.html">Interpreting second language speakers</a></li>
78 <li><a href="/posts/learn-to-read-and-type-chinese.html">Learn to read and type Chinese</a></li>
79 </ul>
80 STRING-BLOCK
81 "\n</ul>")))
82 (string-populate
83 HTML-TEMPLATE
84 `((title . "m455's posts")
85 (contents . ,html-contents)))))
86
87 (define (generate-posts-page)
88 (let ((posts-data (paths->sorted-alists (directory2 POSTS-DIRECTORY)))
89 (posts-build-path (make-pathname BUILD-DIRECTORY POSTS-DIRECTORY)))
90 (create-directory posts-build-path #t)
91 (file-write (make-pathname posts-build-path "index.html")
92 (create-posts-page posts-data))))
93
94 ;; generate html ============================================================
95 (define (markup-file->html file)
96 (let ((lines (file->lines file)))
97 (string-populate
98 HTML-TEMPLATE
99 `((title . ,(substring (car lines) (string-length TITLE-PREFIX)))
100 (contents . ,(parse-lines lines 'normal))))))
101
102 ;; generate pages (removing "pages/" from any generated URLs
103 (define (generate-html)
104 (create-directory (make-pathname BUILD-DIRECTORY POSTS-DIRECTORY))
105 (for-each
106 (lambda (path)
107 (file-write (pathname-replace-extension
108 (make-pathname BUILD-DIRECTORY (strip-pages-directory-from-start-of-path path))
109 "html")
110 (markup-file->html path)))
111 (directory2 PAGES-DIRECTORY))
112
113 ;; generate posts
114 (for-each
115 (lambda (path)
116 (file-write (pathname-replace-extension
117 (make-pathname BUILD-DIRECTORY path)
118 "html")
119 (markup-file->html path)))
120 (directory2 POSTS-DIRECTORY)))
121
122 ;; generate rss =============================================================
123
124 ;; this is mostly to fix the issue of rss readers opening relative links.
125 ;; this just takes links like "/path/to/thing.html" and changes them
126 ;; to "https://example.com/path/to/thing.html"
127 (define (relative-links->urls str)
128 (irregex-replace/all
129 (irregex "\\[(/[^\\[]*)\\|([^\\[]*)\\]" 's)
130 str
131 (lambda (m)
132 (format "[https://m455.casa~a|~a]"
133 (irregex-match-substring m 1) ;; link
134 (irregex-match-substring m 2))))) ;; title
135
136 (define (date->rss-date str)
137 (time->string
138 (string->time str "%Y-%m-%d %H:%M")
139 "%a, %d %b %Y %H:%M:%S %z"))
140
141 (define (post->rss-item path-data)
142 (let* ((content (with-input-from-file (alist-ref 'path path-data) read-string))
143 (content-links-fixed (relative-links->urls content))
144 (path (pathname-replace-extension (alist-ref 'path path-data) "html")))
145 (string-populate
146 RSS-ITEM-TEMPLATE
147 `((post-title . ,(alist-ref 'title path-data))
148 (post-url . ,(string-append "https://m455.casa/" path))
149 (post-date . ,(date->rss-date (alist-ref 'date path-data)))
150 (post-contents . ,(parse-lines
151 (with-input-from-string content-links-fixed read-lines)
152 'normal))))))
153
154 (define (generate-rss)
155 (let* ((posts-data (paths->sorted-alists (directory2 POSTS-DIRECTORY)))
156 (posts-as-rss-items (string-intersperse (map post->rss-item posts-data) "\n")))
157 (file-write
158 (make-pathname BUILD-DIRECTORY "feed.rss")
159 (string-populate RSS-CHANNEL-TEMPLATE `((items . ,posts-as-rss-items))))))
160
161 ;; do the stuff
162 (generate-posts-page)
163 (generate-html)
164 (generate-rss))