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