git.m455.casa

m455.casa

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