git.m455.casa

m455.casa

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


src/generate-posts.scm

1 (include "src/imports.scm")
2 (include "src/static.scm")
3 (include "src/utils.scm")
4 (include "src/parser.scm")
5
6 (define (clean str)
7 (string-translate* str '(("&" . "&amp")
8 ("<" . "&lt;")
9 (">" . "&gt;")
10 ("\"" . "&quot;")
11 ("\'" . "&#39;"))))
12
13 (define (path-data->html-link path-data)
14 (format " <li><a href=\"/~a\">~a</a></li>"
15 (pathname-replace-extension (alist-ref 'path path-data) "html")
16 (clean (alist-ref 'title path-data))))
17
18 (define (create-posts-page paths-data)
19 (let* ((posts-list (map path-data->html-link paths-data))
20 (html-contents (string-append
21 "<h1>posts</h1>\n"
22 "<p>here's a list of my blog posts. if you're looking for my older posts, then check\n"
23 "out my <a href=\"/archive\">archive</a>.</p>\n"
24 "<ul>\n"
25 (string-intersperse posts-list "\n")
26 "\n</ul>")))
27 (string-populate
28 HTML-TEMPLATE
29 `((title . "m455's posts")
30 (contents . ,html-contents)))))
31
32 (define (markup-file->html file)
33 (let ((lines (file->lines file)))
34 (string-populate
35 HTML-TEMPLATE
36 `((title . ,(substring (car lines) (string-length TITLE-PREFIX)))
37 (contents . ,(parse-lines lines 'normal))))))
38
39 (define (generate-posts-page)
40 (let ((paths-data (paths->sorted-alists (directory POSTS-DIRECTORY)))
41 (posts-build-path (make-pathname BUILD-DIRECTORY POSTS-DIRECTORY)))
42 (create-directory posts-build-path #t)
43 (file-write (make-pathname posts-build-path "index.html")
44 (create-posts-page paths-data))))
45
46 (define (generate-posts)
47 (for-each
48 (lambda (file)
49 (file-write (pathname-replace-extension
50 (make-pathname BUILD-DIRECTORY file)
51 "html")
52 (markup-file->html file)))
53 (map (lambda (path) (make-pathname POSTS-DIRECTORY path))
54 (directory POSTS-DIRECTORY))))
55
56 (define (main)
57 (generate-posts-page)
58 (generate-posts))
59
60 (main)