clone url: git://git.m455.casa/lol
src/utils.scm
1 | (define (filter pred? lst) |
2 | (if (null? lst) |
3 | '() |
4 | (if (pred? (car lst)) |
5 | (cons (car lst) (filter pred? (cdr lst))) |
6 | (filter pred? (cdr lst))))) |
7 |
|
8 | (define (displayln str) |
9 | (display str) |
10 | (newline)) |
11 |
|
12 | (define-syntax displayln-format |
13 | (syntax-rules () |
14 | ((_ str v ...) |
15 | (displayln (format str v ...))))) |
16 |
|
17 | (define (get alist key) |
18 | (if (and (pair? alist) |
19 | (pair? (car alist)) |
20 | (symbol? key)) |
21 | (cadr (assq key alist)) |
22 | alist)) |
23 |
|
24 | (define (load-config-file) |
25 | (if (file-exists? CONFIG-FILE) |
26 | (with-input-from-file CONFIG-FILE read) |
27 | #f)) |
28 |
|
29 | (define (string->lines str) |
30 | (with-input-from-string str read-lines)) |
31 |
|
32 | (define (file->lines file) |
33 | (string->lines (file->string file))) |
34 |
|
35 | (define (file->string file) |
36 | (with-input-from-file file read-string)) |
37 |
|
38 | (define (file-write file contents) |
39 | (with-output-to-file file (lambda () (display contents)))) |
40 |
|
41 | ;; converts dates in the format of yyyy-mm-dd or yyyy-mm-dd hh:mm to a date |
42 | ;; that works in rss feeds |
43 | (define (date->rss-date str) |
44 | (time->string (string->time str "%Y-%m-%d %H:%M") |
45 | "%a, %d %b %Y %H:%M:%S %z")) |
46 |
|
47 | ;; creates `("{{some-key}}" . "some value") |
48 | (define (key->mustached-key pair) |
49 | (if (pair? pair) |
50 | `(,(string-append "{{" (symbol->string (car pair)) "}}") ,(cadr pair)) |
51 | pair)) |
52 |
|
53 | ;; takes a string, and key-value replacements in the form of |
54 | ;; `((key1 "value one") |
55 | ;; (key2 "value two")) |
56 | ;; , converts the list above to the following format |
57 | ;; `(("{{key1}}" "value one") |
58 | ;; ("{{key2}}" "value two") |
59 | ;; ("{{key3}}" "value three")) |
60 | ;; , and then replaces each {{key}} found in the string with its |
61 | ;; corresponding value |
62 | (define (string-populate str kv-replacements) |
63 | (if (null? kv-replacements) |
64 | str |
65 | (let ((first-pair (car (map key->mustached-key kv-replacements)))) |
66 | (string-populate |
67 | (string-translate* str `((,(car first-pair) . ,(cadr first-pair)))) |
68 | (cdr kv-replacements))))) |
69 |
|
70 | ;; takes "source/posts/2021/file.txt" |
71 | ;; returns either |
72 | ;; "https://example.com/posts/2021/file.html" |
73 | ;; or |
74 | ;; "/posts/2021/file.html" |
75 | (define (pathname->url source-file mode) |
76 | (let* ((prefix (if (equal? 'with-https-prefix mode) |
77 | (string-append "https://" (get *config-data* 'domain) "/") |
78 | "/")) |
79 | (pathname-no-top-directory (cdr (string-split source-file "/"))) ;; => '("posts" "2021" "file.txt") |
80 | (pathname-rebuilt (string-intersperse pathname-no-top-directory "/")) ;; => "posts/2021/file.txt" |
81 | (pathname-html-file (pathname-replace-extension pathname-rebuilt "html"))) ;; => "posts/2021/file.html" |
82 | (string-append prefix pathname-html-file))) |
83 |
|
84 | ;; takes one of the following types of pathnames: |
85 | ;; "source/posts/2021/some-file.txt" |
86 | ;; "source/posts/2021" |
87 | ;; and creates one of the following types pathnames: |
88 | ;; "build/posts/2021/some-file.txt" |
89 | ;; "build/posts/2021" |
90 | (define (pathname->destination-pathname source-pathname) |
91 | (make-pathname |
92 | (get *config-data* 'build-directory) |
93 | (string-intersperse (cdr (string-split source-pathname "/")) "/"))) ;; => "build/posts/2021" directory |
94 |
|
95 | (define (string->date contents) |
96 | (caddr (string->lines contents))) ;; => "2022-07-03" |
97 |
|
98 | (define (string->title source-file-contents) |
99 | (let ((first-line (car (string->lines source-file-contents)))) ;; => "# some title" |
100 | (substring first-line (string-length "# ") (string-length first-line)))) ;; => "some title" |
101 |
|