git.m455.casa

lol

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