gdritter repos when-computer / 97df62c
Almost-finished static gen (sans rss) Getty Ritter 8 years ago
3 changed file(s) with 163 addition(s) and 41 deletion(s). Collapse all Expand all
+143
-31
generator/generate.scm less more
11 (load "telml.scm")
22 (load "libs.scm")
3 (use-modules (srfi srfi-1))
34 (use-modules (ice-9 match))
4
5 (define (pairs lst)
6 (match lst
7 ((x . (y . xs)) (cons (list x y) (pairs xs)))
8 (__ '())))
5 (use-modules (ice-9 ftw))
96
107 ;; template-ey things and style things
118
7067 ((// (= class navlist) ul)
7168 (padding-left 100px)
7269 (padding-right 100px))
70
71 ((// (= class archive-list) ul)
72 (padding-left 100px)
73 (padding-right 100px))
74
75 ((// (= class archive-list) li)
76 (list-style-type none))
77
78 ((= class tag-entry:before)
79 (content "\"#\""))
80
81 ((// (= class tags) ul)
82 (display inline))
83
84 ((= class tag:before)
85 (content "\"#\""))
86
87 ((= class tag)
88 (font-style italic))
7389
7490 ((= class sidenote)
7591 (float right)
123139 (content "application/xhtml+xml; charset=utf-8;")))
124140 (style (@ (type "text/css")) ,(scss->css stylesheet))
125141 (script (@ (type "text/javascript")
126 (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")))
142 (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")) "")
127143 (title ,(string-append "what happens when computer: " title)))
128144 (div (@ (class "all"))
129145 (div (@ (class "header"))
132148 (div (@ (class "main")) ,content)
133149 (div (@ (class "footer")) "© 2015 getty ritter"))))
134150
151 (define (add-tags chunk tags)
152 (define (tag->link tag)
153 `(a (@ (href ,(format #f "/tag/~a/" tag))
154 (class tag)) ,tag))
155 (if (null? tags)
156 chunk
157 (append chunk
158 `((div (@ (class "tags"))
159 (ul ,(map tag->link tags)))))))
160
161 (define (get-all-posts)
162 (let* ((files (cddr (file-system-tree "posts")))
163 (files-sorted (sort files (lambda (x y)
164 (> (stat:mtime (cadr x))
165 (stat:mtime (cadr y)))))))
166 (map (lambda (file-entry)
167 (let ((filename (string-append "posts/" (car file-entry))))
168 (cons filename
169 (cons (localtime (stat:mtime (cadr file-entry)))
170 (car (translate-file filename))))))
171 files-sorted)))
172
173 (define post-file car)
174 (define post-time cadr)
175 (define post-slug caddr)
176 (define post-title cadddr)
177 (define (post-tags l)
178 (list-ref l 4))
179
180 (define meta-slug car)
181 (define meta-title cadr)
182 (define meta-tags caddr)
183
184 (define (date->string date)
185 (strftime "%Y-%m-%d" date))
186
187 (define (post->list-elem post)
188 (let* ((date (date->string (post-time post)))
189 (url (format #f "/~a/~a/" date (post-slug post)))
190 (title (post-title post)))
191 `(li ,(++ date ": ") (a (@ (href ,url)) ,title))))
192
193 (define (tag->list-elem tag)
194 (let ((url (format #f "/tag/~a/" tag)))
195 `(li (@ (class tag-entry))
196 (a (@ (href ,url)) ,tag))))
197
135198 (define (archive)
136 (let* ((metadata (read-file "site.scm")))
137 (display (serialize-sxml (page "archive" metadata)))))
199 (let* ((posts (get-all-posts))
200 (list `(div (@ (class archive-list))
201 (ul
202 ,(map post->list-elem posts)))))
203 (with-output-to-file "output/archive/index.html"
204 (lambda ()
205 (display (sxml->html5 (page "archive" list)))))))
206
207 (define (concat list)
208 (apply append list))
209
210 (define (get-tag-list posts)
211 (let ((c (concat (map post-tags posts))))
212 (delete-duplicates (sort c string<?))))
213
214 (define (get-posts-with-tag tag posts)
215 (filter (lambda (post) (member tag (post-tags post))) posts))
138216
139217 (define (tags)
140 (let* ((metadata (read-file "site.scm")))
141 (display (serialize-sxml (page "tags" "blah")))))
218
219 (let* ((posts (get-all-posts))
220 (tags (get-tag-list posts))
221 (tag-list `(div (@ (class archive-list))
222 (ul
223 ,(map tag->list-elem tags)))))
224
225 (define (mk-tag-page tag)
226 (let* ((ps (get-posts-with-tag tag posts))
227 (list `(div (@ (class archive-list))
228 "pages tagged "
229 (span (@ (class tag)) ,tag)
230 ":"
231 (ul
232 ,(map post->list-elem ps)))))
233 (ensure-folder (format #f "output/tag/~a" tag))
234 (with-output-to-file (format #f "output/tag/~a/index.html" tag)
235 (lambda ()
236 (display (sxml->html5 (page tag list)))))))
237
238 (with-output-to-file (format #f "output/tags/index.html")
239 (lambda ()
240 (display (sxml->html5 (page "tags" tag-list)))))
241
242 (map mk-tag-page tags)))
243
244 (define (ensure-folder f)
245 (if (not (file-exists? f))
246 (mkdir f)))
142247
143248 ;; actually load and generate the relevant files
144 (define (main pg file)
249 (define (main pg file out)
145250 (let* ((page-source (translate-file file))
146 (telml (cdr page-source))
147 (meta (car page-source))
148 (title (if (not (null? meta)) (cadr meta) pg))
149 (display (serialize-sxml (page title telml))))
150 (format #t "~a\n" display)))
251 (telml (cdr page-source))
252 (meta (car page-source))
253 (date (localtime (stat:mtime (stat file))))
254 (ndate (date->string date))
255 (title (if (not (null? meta)) (meta-title meta) pg))
256 (outfile (if out out
257 (format #f "output/~a/~a/index.html" ndate (meta-slug meta))))
258 (display (sxml->html5 (page title (add-tags telml (meta-tags meta))))))
259 (if (not out)
260 (begin
261 (ensure-folder (format #f "output/~a" ndate))
262 (ensure-folder (format #f "output/~a/~a" ndate (car meta)))))
263 (format #t "printing to ~a\n" outfile)
264 (with-output-to-file outfile
265 (lambda () (format #t "~a\n" display)))))
151266
152267 (define (dispatch pg files)
153268 (cond ((equal? pg "index")
154 (with-output-to-file "output/index.html"
155 (lambda () (main "index" (car files)))))
269 (main "index" (car files) "output/index.html"))
156270 ((equal? pg "post")
157 (with-output-to-file "output/post.html"
158 (lambda () (main "post" (car files)))))
271 (map
272 (lambda (f) (main "post" f #f))
273 files))
159274 ((equal? pg "archive")
160 (with-output-to-file "output/archive/index.html"
161 (lambda () (archive))))
275 (archive))
162276 ((equal? pg "tags")
163 (with-output-to-file "output/tags/index.html"
164 (lambda () (tags))))
277 (tags))
165278 ((equal? pg "about")
166 (with-output-to-file "output/about/index.html"
167 (lambda () (main "about" "pages/about.telml"))))))
168
169 (define args (cdr (command-line)))
170 (cond ((= (length args) 0)
171 (format #t "Usage: generate [page] [files]\n"))
172 (else (dispatch (car args) (cdr args))))
279 (main "about" "pages/about.telml" "output/about/index.html"))))
280
281 (let ((args (cdr (command-line))))
282 (cond ((= (length args) 0)
283 (format #t "Usage: generate [page] [files]\n"))
284 (else (dispatch (car args) (cdr args)))))
+16
-8
generator/libs.scm less more
6464 (cdadr sxml) '()))
6565 (vals (if (and (cadr? sxml) (eq? (caadr sxml) '@))
6666 (cddr sxml) (cdr sxml))))
67 (++ "<"
68 tag
69 (apply ++ (map mk-prop props))
70 ">"
71 (apply ++ (map serialize-sxml vals))
72 "</"
73 tag
74 ">")))))
67 (if (null? vals)
68 (++ "<"
69 tag
70 (apply ++ (map mk-prop props))
71 " />")
72 (++ "<"
73 tag
74 (apply ++ (map mk-prop props))
75 ">"
76 (apply ++ (map serialize-sxml vals))
77 "</"
78 tag
79 ">"))))))
80
81 (define (sxml->html5 sxml)
82 (++ "<!DOCTYPE html>" (serialize-sxml sxml)))
+4
-2
generator/telml.scm less more
114114 `(a (@ (href ,(apply string-append url))) ,name)))
115115 (cons 'sidenote (lambda (arg) `(span (@ (class sidenote)) ,arg)))
116116 (cons 'ref (lambda (name)
117 `(label (@ (for ,(car name)) (class "sidenote-number"))))))))
117 `(label (@ (for ,(car name)) (class "sidenote-number")) ""))))))
118118
119119 (define (partition doc lst)
120120 (cond ((null? doc) (reverse lst))
145145 (append (split-string (car doc)) (go (cdr doc))))))
146146 (partition (go document) '(())))
147147
148 (define (string->sexp str)
149 (call-with-input-string str read))
148150
149151 (define (telml->sxml telml tags)
150152 (define (rec arg)
167169 (eq? (caar telml) 'meta))
168170 (cdr telml)
169171 telml)))
170 (cons (if #f (string->sexp meta) '())
172 (cons (if meta (string->sexp meta) '())
171173 (map (lambda (x)
172174 (cons 'p (rec x)))
173175 (gather-para body)))))