clone url: git://git.m455.casa/m455.casa
src/utils.scm
1 | (module utils (directory2 |
2 | strip-pages-directory-from-start-of-path |
3 | file->lines |
4 | file-write |
5 | string-populate |
6 | paths->sorted-alists) |
7 |
|
8 | (import scheme |
9 | utf8 |
10 | srfi-1 |
11 | (chicken base) |
12 | (chicken string) |
13 | (chicken sort) |
14 | (chicken pathname) |
15 | (chicken file) |
16 | (chicken io) |
17 | static) |
18 |
|
19 | (define (directory2 dir) |
20 | (map (lambda (path) |
21 | (make-pathname dir path)) |
22 | (directory dir))) |
23 |
|
24 | (define (strip-pages-directory-from-start-of-path path) |
25 | (substring path (string-length (string-append PAGES-DIRECTORY "/")))) |
26 |
|
27 | (define (file->lines file) |
28 | (with-input-from-file file read-lines)) |
29 |
|
30 | (define (file-write file contents) |
31 | (with-output-to-file |
32 | file |
33 | (lambda () (display contents)))) |
34 |
|
35 | (define (pair->mustached-pair pair) |
36 | (let* ((first (car pair)) |
37 | (key (if (string? first) |
38 | first |
39 | (symbol->string first)))) |
40 | `(,(string-append "{{" key "}}") . ,(cdr pair)))) |
41 |
|
42 | (define (string-populate str smap) |
43 | (string-translate* |
44 | str |
45 | (map pair->mustached-pair smap))) |
46 |
|
47 | (define (path->alist path) |
48 | (let ((lines (file->lines path))) |
49 | `((date . ,(caddr lines)) |
50 | (path . ,path) |
51 | (title . ,(substring (car lines) (string-length TITLE-PREFIX)))))) |
52 |
|
53 | (define (paths->sorted-alists paths) |
54 | (let* ((relative-paths (filter (lambda (path) |
55 | (not (directory-exists? path))) |
56 | paths)) |
57 | (paths-data (map path->alist relative-paths))) |
58 | (sort paths-data |
59 | (lambda (data-a data-b) |
60 | (string>? (alist-ref 'date data-a) (alist-ref 'date data-b))))))) |
61 |
|