diff options
author | Case Duckworth | 2023-09-06 22:45:45 -0500 |
---|---|---|
committer | Case Duckworth | 2023-09-06 22:45:45 -0500 |
commit | 59598f42c16cf12e544e5bf2ce9c873fba94238e (patch) | |
tree | 055f106b72f289f59d4af417a24448e4983dbec3 /lib/types.sls | |
parent | A new start (again) (diff) | |
download | boudin-59598f42c16cf12e544e5bf2ce9c873fba94238e.tar.gz boudin-59598f42c16cf12e544e5bf2ce9c873fba94238e.zip |
A newerer beginning
Diffstat (limited to 'lib/types.sls')
-rw-r--r-- | lib/types.sls | 72 |
1 files changed, 0 insertions, 72 deletions
diff --git a/lib/types.sls b/lib/types.sls deleted file mode 100644 index 2b4da5d..0000000 --- a/lib/types.sls +++ /dev/null | |||
@@ -1,72 +0,0 @@ | |||
1 | ;;; (boudin types) --- pages, indeces, and static files | ||
2 | |||
3 | ;; All paths are relative to the site directory unless otherwise noted | ||
4 | |||
5 | (define-record-type page | ||
6 | (make-page path ; Input path | ||
7 | dest ; Output path (rel. to output directory) | ||
8 | text ; Input text | ||
9 | sxml ; Rendered sxml | ||
10 | meta ; Metadata (title, etc.) | ||
11 | ) | ||
12 | page? | ||
13 | (path page-path) | ||
14 | (dest page-dest set-page-dest!) | ||
15 | (text page-text set-page-text!) | ||
16 | (sxml page-sxml set-page-sxml!) | ||
17 | (meta page-meta set-page-meta!)) | ||
18 | |||
19 | (define (page-ref pg key) | ||
20 | (assoc-ref key (page-meta pg) (identity #f))) | ||
21 | |||
22 | (define (page-set! pg key val) | ||
23 | (set-page-meta! pg (cons (cons key val) | ||
24 | (page-meta pg)))) | ||
25 | |||
26 | (define (extract-metadata sxml) | ||
27 | #f) | ||
28 | |||
29 | (define (*urlify path) | ||
30 | (normalize-pathname | ||
31 | (make-pathname (list (site-url) | ||
32 | (pathname-strip-extension path)) | ||
33 | "index.html"))) | ||
34 | |||
35 | (define (page-url pg) ; foo.html => http://site.com/foo/index.html | ||
36 | (or (page-ref pg "url") ; memoization | ||
37 | (let ((url (*urlify (page-path pg)))) | ||
38 | (page-set! pg "url" url) | ||
39 | url))) | ||
40 | |||
41 | (define (*slugify url) ; I don't love how this is written.. | ||
42 | (let-values (((_ _ dirs) (decompose-directory url))) | ||
43 | (let loop ((this (car dirs)) | ||
44 | (rest (cdr dirs))) | ||
45 | (if (null? (cdr rest)) | ||
46 | (make-pathname (list "/" this) #f) | ||
47 | (loop (car rest) | ||
48 | (cdr rest)))))) | ||
49 | |||
50 | (define (page-slug pg) ; http://site.com/foo/index.html => /foo/ | ||
51 | (or (page-ref pg "slug") ; memoization | ||
52 | (let ((slug (*slugify (page-url pg)))) | ||
53 | (page-set! pg "slug" slug) | ||
54 | slug))) | ||
55 | |||
56 | (define (read-page path) | ||
57 | (let ((pg (make-page path #f #f #f #f))) | ||
58 | (set-page-dest! pg ((apply o (page-path-transformers)) path)) | ||
59 | (set-page-text! pg (with-input-from-file path slurp)) | ||
60 | (set-page-sxml! pg ((apply o (page-text-transformers)) (page-text pg))) | ||
61 | (set-page-meta! pg (extract-metadata (page-sxml pg))) | ||
62 | pg)) | ||
63 | |||
64 | (define write-page | ||
65 | (case-lambda | ||
66 | ((pg) (call-with-output-file (page-dest pg) | ||
67 | (lambda (port) (write-page pg port)))) | ||
68 | ((pg port) | ||
69 | (sxml-display-as-html ((eval/q (page-template)) pg) port)))) | ||
70 | |||
71 | |||
72 | |||