/
utils.scm
44 lines (33 loc) · 1.19 KB
/
utils.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(use srfi-1)
(define (insert-file path)
(with-input-from-file path (lambda () (read-string))))
(define (fold-sep proc sep start list)
(let ((first #t))
(fold (lambda (e o)
(string-append o (if first (begin (set! first #f) "") sep) (proc e)))
start
list)))
(define (string-fold-sep proc sep list)
(fold-sep proc sep "" list))
(define (range from/to . to)
(let ((f (if (= (length to) 0) -1 (- from/to 1)))
(t (if (> (length to) 0) (first to) from/to)))
(do ((i (- t 1) (- i 1))
(l '() (cons i l)))
((= i f) l))))
(define (empty? l) (eq? l '()))
(define (dash->space s)
(string-fold (lambda (c o) (string-append o (if (char=? #\- c) " " (->string c)))) "" s))
(define (space->dash s)
(string-fold (lambda (c o) (string-append o (if (char=? #\space c) "-" (->string c)))) "" s))
(define (id->name id)
(string-titlecase (dash->space id)))
(define (name->id name)
(string-downcase (space->dash name)))
(define (list->path list)
(fold (lambda (e o)
(string-append o (db:sep) e))
""
list))
(define (html-escape s)
(string-fold (lambda (c o) (string-append o (if (char=? #\' c) "'" (->string c)))) "" s))