gdritter repos when-computer / 7d6ea4c
Split apart some modules, added some struct types Getty Ritter 8 years ago
4 changed file(s) with 288 addition(s) and 225 deletion(s). Collapse all Expand all
+74
-212
generator/generate.scm less more
1 (load "telml.scm")
2 (load "libs.scm")
1 (include "types.scm")
2 (include "telml.scm")
3 (include "libs.scm")
4 (include "templates.scm")
5
36 (use-modules (srfi srfi-1))
47 (use-modules (ice-9 match))
58 (use-modules (ice-9 ftw))
69
7 ;; template-ey things and style things
810
9 (define (atom-element title url date content)
10 `(entry
11 (title ,title)
12 (link (@ (href ,url)))
13 (id ,url)
14 (updated ,date)
15 (content (@ (type "html"))
16 ,content)))
1711
18 (define (atom-feed posts)
19 `(feed (@ (xmlns "htpt://www.w3.org/2005/Atom"))
20 (title "what happens when computer")
21 (link (@ (href "http://what.happens.when.computer/feed/")
22 (rel "self")))
23 (link (@ (href "http://what.happens.when.computer/")))
24 (id "http://what.happens.when.computer/")
25 ,(map (lambda (post) (apply atom-element post)) posts)))
12 ;; Create a folder if it doesn't exist. (There does not
13 ;; appear to be a Guile binding to mkdir -p.)
14 (define (ensure-folder f)
15 (if (not (file-exists? f))
16 (mkdir f)))
2617
27 (define stylesheet
28 '((body
29 (font-family "Palatino, \"Palatino Linotype\", \"Palatino LT STD\", \"Book Antiqua\", Georgia, serif")
30 (font-size 15pt)
31 (background-color "#eeeeee")
32 (counter-reset sidenote-counter))
18 ;; create an output filename from a set of path components,
19 ;; creating the necessary folders if needed, as well.
20 (define (outfile chunks)
21 (define (go rest so-far)
22 (ensure-folder so-far)
23 (if (null? rest)
24 (++ so-far "/index.html")
25 (go (cdr rest)
26 (++ so-far "/" (as-string (car rest))))))
27 (go chunks "output"))
3328
34 ((= class all)
35 (width 800px)
36 (margin-left auto)
37 (margin-right auto)
38 (text-align center))
29 ;; create a URL from a set of path components
30 (define (url chunks)
31 (define (go rest so-far)
32 (match rest
33 (() so-far)
34 ((x . xs) (go xs (++ so-far "/" (as-string x))))))
35 (go chunks "/"))
3936
40 ((= class menu)
41 (color "#0f0f0f"))
42
43 ((= class main)
44 (padding-right 25%)
45 (text-align justify)
46 (line-height 150%))
47
48 ((= class menu-index:before)
49 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
50 (content "\"/ \""))
51 ((= class menu-archive:before)
52 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
53 (content "\"^ \""))
54 ((= class menu-tags:before)
55 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
56 (content "\"# \""))
57 ((= class menu-about:before)
58 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
59 (content "\"@ \""))
60
61 ((// (= class navlist) li)
62 (display inline)
63 (list-style-type none)
64 (padding-left 10px)
65 (padding-right 20px))
66
67 ((// (= class navlist) ul)
68 (padding-left 100px)
69 (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))
89
90 ((= class sidenote)
91 (float right)
92 (clear right)
93 (margin-right -60%)
94 (font-size 12pt)
95 (line-height 130%)
96 (width 50%))
97
98 ((= class sidenote-number)
99 (counter-increment sidenote-counter))
100
101 ((&& (= class sidenote-number:after) (= class sidenote:before))
102 (content "counter(sidenote-counter) \" \"")
103 (position relative)
104 (color "#ff0000"))
105
106 ((= class sidenote-number:after)
107 (content "counter(sidenote-counter) \" \"")
108 (top -0.5rem)
109 (left -0.1rem)
110 (vertical-align super)
111 (font-size 70%)
112 (color "#ff0000")
113 (font-size: 0.9rem))
114
115 ((= class sidenote:before)
116 (content "counter(sidenote-counter) \". \"")
117 (position absolute)
118 (-webkit-transform "translateX(-100%) translateX(-0.25rem)")
119 (-ms-transform "translateX(-100%) translateX(-0.25rem)")
120 (transform "translateX(-100%) translateX(-0.25rem)"))))
121
122 ;; the SXML chunk representing the navigation menu
123 (define menu
124 (let ((menu-item
125 (lambda (name url)
126 `(li (@ (class ,(string-append "menu-" name)))
127 (a (@ (href ,url)) ,name)))))
128 `(ul (@ (class navlist))
129 ,(menu-item "index" "/")
130 ,(menu-item "archive" "/archive/")
131 ,(menu-item "tags" "/tags/")
132 ,(menu-item "about" "/about/"))))
133
134 ;; The SXML chunk representing a page on the site
135 (define (page title content)
136 `(html
137 (head
138 (meta (@ (http-equiv "Content-Type")
139 (content "application/xhtml+xml; charset=utf-8;")))
140 (style (@ (type "text/css")) ,(scss->css stylesheet))
141 (script (@ (type "text/javascript")
142 (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")) "")
143 (title ,(string-append "what happens when computer: " title)))
144 (div (@ (class "all"))
145 (div (@ (class "header"))
146 (h1 "what happens when computer"))
147 (div (@ (class "nav")) ,menu)
148 (div (@ (class "main")) ,content)
149 (div (@ (class "footer")) "© 2015 getty ritter"))))
150
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
37 ;; Grab all the posts and their metadata from the posts folder,
38 ;; sorted by creation time. This does unnecessary work right
39 ;; now; parsing all of them just to get the first metadata tag
40 ;; out of them.
16141 (define (get-all-posts)
16242 (let* ((files (cddr (file-system-tree "posts")))
16343 (files-sorted (sort files (lambda (x y)
16444 (> (stat:mtime (cadr x))
16545 (stat:mtime (cadr y)))))))
16646 (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))))))
47 (let* ((filename (string-append "posts/" (car file-entry)))
48 (metadata (telml-meta (translate-file filename))))
49 (make-post filename
50 (localtime (stat:mtime (cadr file-entry)))
51 (meta-slug metadata)
52 (meta-title metadata)
53 (meta-tags metadata))))
17154 files-sorted)))
17255
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
56 ;; Turn a post into an <li> element with appropriate
57 ;; link and date.
18758 (define (post->list-elem post)
18859 (let* ((date (date->string (post-time post)))
189 (url (format #f "/~a/~a/" date (post-slug post)))
60 (href (post-url post))
19061 (title (post-title post)))
191 `(li ,(++ date ": ") (a (@ (href ,url)) ,title))))
62 `(li ,(++ date ": ") (a (@ (href ,href)) ,title))))
19263
64 ;; Turn a tag into an <li> element with the appropriate link
19365 (define (tag->list-elem tag)
194 (let ((url (format #f "/tag/~a/" tag)))
66 (let ((url (url (list 'tag tag))))
19567 `(li (@ (class tag-entry))
19668 (a (@ (href ,url)) ,tag))))
19769
70 ;; Generate the archive page
19871 (define (archive)
19972 (let* ((posts (get-all-posts))
20073 (list `(div (@ (class archive-list))
20174 (ul
20275 ,(map post->list-elem posts)))))
203 (with-output-to-file "output/archive/index.html"
76 (with-output-to-file (outfile '(archive))
20477 (lambda ()
20578 (display (sxml->html5 (page "archive" list)))))))
20679
80 ;; Flatten a list
20781 (define (concat list)
20882 (apply append list))
20983
84 ;; Get the list of all tags
21085 (define (get-tag-list posts)
21186 (let ((c (concat (map post-tags posts))))
21287 (delete-duplicates (sort c string<?))))
21388
89 ;; Get the list of all posts that are tagged with a given tag
21490 (define (get-posts-with-tag tag posts)
21591 (filter (lambda (post) (member tag (post-tags post))) posts))
21692
93 ;; Generate all tag-related pages
21794 (define (tags)
218
21995 (let* ((posts (get-all-posts))
22096 (tags (get-tag-list posts))
22197 (tag-list `(div (@ (class archive-list))
224100
225101 (define (mk-tag-page tag)
226102 (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)
103 (content `(div (@ (class archive-list))
104 "pages tagged "
105 (span (@ (class tag)) ,tag)
106 ":"
107 (ul
108 ,(map post->list-elem ps)))))
109 (with-output-to-file (outfile (list 'tag tag))
235110 (lambda ()
236 (display (sxml->html5 (page tag list)))))))
111 (display (sxml->html5 (page tag content)))))))
237112
238 (with-output-to-file (format #f "output/tags/index.html")
113 (with-output-to-file (outfile '(tags))
239114 (lambda ()
240115 (display (sxml->html5 (page "tags" tag-list)))))
241116
242117 (map mk-tag-page tags)))
243118
244 (define (ensure-folder f)
245 (if (not (file-exists? f))
246 (mkdir f)))
247
248 ;; actually load and generate the relevant files
119 ;; Load a telml page and turn it into an html page
249120 (define (main pg file out)
250121 (let* ((page-source (translate-file file))
251 (telml (cdr page-source))
252 (meta (car page-source))
122 (telml (telml-content page-source))
123 (meta (telml-meta page-source))
253124 (date (localtime (stat:mtime (stat file))))
254125 (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))))
126 (title (if meta (meta-title meta) pg))
127 (target (if out out
128 (outfile (list ndate (meta-slug meta)))))
258129 (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
130 (format #t "printing to ~a\n" target)
131 (with-output-to-file target
265132 (lambda () (format #t "~a\n" display)))))
266133
134 ;; Figure out which page is supposed to be generated
267135 (define (dispatch pg files)
268 (cond ((equal? pg "index")
269 (main "index" (car files) "output/index.html"))
270 ((equal? pg "post")
271 (map
272 (lambda (f) (main "post" f #f))
273 files))
274 ((equal? pg "archive")
275 (archive))
276 ((equal? pg "tags")
277 (tags))
278 ((equal? pg "about")
279 (main "about" "pages/about.telml" "output/about/index.html"))))
136 (match pg
137 ("index" (main "index" (car files) (outfile '())))
138 ("post" (map (lambda (f) (main "post" f #f)) files))
139 ("archive" (archive))
140 ("tags" (tags))
141 ("about" (main "about" "pages/about.telml" (outfile '(about))))))
280142
281143 (let ((args (cdr (command-line))))
282144 (cond ((= (length args) 0)
+25
-13
generator/telml.scm less more
1 (use-modules (ice-9 match))
12 (use-modules (ice-9 rdelim))
23 (use-modules (ice-9 regex))
4 (use-modules (srfi srfi-9))
5
6 (define-record-type <telml-doc>
7 (make-telml-doc meta content)
8 telml-doc?
9 (meta telml-meta)
10 (content telml-content))
11
12 (define-record-type <meta>
13 (make-meta slug title tags)
14 meta?
15 (slug meta-slug)
16 (title meta-title)
17 (tags meta-tags))
318
419 (define (mk-stream s)
520 (let ((lst (string->list s)))
159174 (raise "Unknown tag"))))
160175 (else
161176 (map rec arg))))
162 (let ((meta (if (and (not (null? telml))
163 (not (null? (car telml)))
164 (eq? (caar telml) 'meta))
165 (caadar telml)
166 #f))
167 (body (if (and (not (null? telml))
168 (not (null? (car telml)))
169 (eq? (caar telml) 'meta))
170 (cdr telml)
171 telml)))
172 (cons (if meta (string->sexp meta) '())
173 (map (lambda (x)
174 (cons 'p (rec x)))
177 (let ((meta (match telml
178 ((('meta (xs)) . _) xs)
179 (_ #f)))
180 (body (match telml
181 ((('meta _) . xs) xs)
182 (xs xs))))
183 (make-telml-doc
184 (if meta (apply make-meta (string->sexp meta)) '())
185 (map (lambda (x)
186 (cons 'p (rec x)))
175187 (gather-para body)))))
176188
177189 (define (translate-file filename)
+172
-0
generator/templates.scm less more
1 ;; template-ey things and style things
2
3 ;; The date format we're using is {year:04}-{month:02}-{day:02}.
4 (define (date->string date)
5 (strftime "%Y-%m-%d" date))
6
7 (define (post-url post)
8 (let ((date (date->string (post-time post)))
9 (slug (post-slug post)))
10 (format #f "/~a/~a/" date slug)))
11
12 (define (atom-element post content)
13 (let ((url (post-url post)))
14 `(entry
15 (title ,(post-title))
16 (link (@ (href ,url)))
17 (id ,url)
18 (updated ,(post-date post))
19 (content (@ (type "html"))
20 ,content))))
21
22 (define (atom-element title url date content)
23 `(entry
24 (title ,title)
25 (link (@ (href ,url)))
26 (id ,url)
27 (updated ,date)
28 (content (@ (type "html"))
29 ,content)))
30
31 (define (atom-feed posts)
32 `(feed (@ (xmlns "htpt://www.w3.org/2005/Atom"))
33 (title "what happens when computer")
34 (link (@ (href "http://what.happens.when.computer/feed/")
35 (rel "self")))
36 (link (@ (href "http://what.happens.when.computer/")))
37 (id "http://what.happens.when.computer/")
38 ,(map (lambda (post) (apply atom-element post)) posts)))
39
40 (define stylesheet
41 '((body
42 (font-family "Palatino, \"Palatino Linotype\", \"Palatino LT STD\", \"Book Antiqua\", Georgia, serif")
43 (font-size 15pt)
44 (background-color "#eeeeee")
45 (counter-reset sidenote-counter))
46
47 ((= class all)
48 (width 800px)
49 (margin-left auto)
50 (margin-right auto)
51 (text-align center))
52
53 ((= class menu)
54 (color "#0f0f0f"))
55
56 ((= class main)
57 (padding-right 25%)
58 (text-align justify)
59 (line-height 150%))
60
61 ((= class menu-index:before)
62 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
63 (content "\"/ \""))
64 ((= class menu-archive:before)
65 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
66 (content "\"^ \""))
67 ((= class menu-tags:before)
68 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
69 (content "\"# \""))
70 ((= class menu-about:before)
71 (font-family "fira, \"Arial\", \"Helvetica\", sans-serif")
72 (content "\"@ \""))
73
74 ((// (= class navlist) li)
75 (display inline)
76 (list-style-type none)
77 (padding-left 10px)
78 (padding-right 20px))
79
80 ((// (= class navlist) ul)
81 (padding-left 100px)
82 (padding-right 100px))
83
84 ((// (= class archive-list) ul)
85 (padding-left 100px)
86 (padding-right 100px))
87
88 ((// (= class archive-list) li)
89 (list-style-type none))
90
91 ((= class tag-entry:before)
92 (content "\"#\""))
93
94 ((// (= class tags) ul)
95 (display inline))
96
97 ((= class tag:before)
98 (content "\"#\""))
99
100 ((= class tag)
101 (font-style italic))
102
103 ((= class sidenote)
104 (float right)
105 (clear right)
106 (margin-right -60%)
107 (font-size 12pt)
108 (line-height 130%)
109 (width 50%))
110
111 ((= class sidenote-number)
112 (counter-increment sidenote-counter))
113
114 ((&& (= class sidenote-number:after) (= class sidenote:before))
115 (content "counter(sidenote-counter) \" \"")
116 (position relative)
117 (color "#ff0000"))
118
119 ((= class sidenote-number:after)
120 (content "counter(sidenote-counter) \" \"")
121 (top -0.5rem)
122 (left -0.1rem)
123 (vertical-align super)
124 (font-size 70%)
125 (color "#ff0000")
126 (font-size: 0.9rem))
127
128 ((= class sidenote:before)
129 (content "counter(sidenote-counter) \". \"")
130 (position absolute)
131 (-webkit-transform "translateX(-100%) translateX(-0.25rem)")
132 (-ms-transform "translateX(-100%) translateX(-0.25rem)")
133 (transform "translateX(-100%) translateX(-0.25rem)"))))
134
135 ;; the SXML chunk representing the navigation menu
136 (define menu
137 (let ((menu-item
138 (lambda (name url)
139 `(li (@ (class ,(string-append "menu-" name)))
140 (a (@ (href ,url)) ,name)))))
141 `(ul (@ (class navlist))
142 ,(menu-item "index" "/")
143 ,(menu-item "archive" "/archive/")
144 ,(menu-item "tags" "/tags/")
145 ,(menu-item "about" "/about/"))))
146
147 ;; The SXML chunk representing a page on the site
148 (define (page title content)
149 `(html
150 (head
151 (meta (@ (http-equiv "Content-Type")
152 (content "application/xhtml+xml; charset=utf-8;")))
153 (style (@ (type "text/css")) ,(scss->css stylesheet))
154 (script (@ (type "text/javascript")
155 (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")) "")
156 (title ,(string-append "what happens when computer: " title)))
157 (div (@ (class "all"))
158 (div (@ (class "header"))
159 (h1 "what happens when computer"))
160 (div (@ (class "nav")) ,menu)
161 (div (@ (class "main")) ,content)
162 (div (@ (class "footer")) "&copy; 2015 getty ritter"))))
163
164 (define (add-tags chunk tags)
165 (define (tag->link tag)
166 `(a (@ (href ,(format #f "/tag/~a/" tag))
167 (class tag)) ,tag))
168 (if (null? tags)
169 chunk
170 (append chunk
171 `((div (@ (class "tags"))
172 (ul ,(map tag->link tags)))))))
+17
-0
generator/types.scm less more
1 (use-modules (srfi srfi-9))
2
3 (define-record-type <meta>
4 (make-meta slug title tags)
5 meta?
6 (slug meta-slug)
7 (title meta-title)
8 (tags meta-tags))
9
10 (define-record-type <post>
11 (make-post file time slug title tags)
12 post?
13 (file post-file)
14 (time post-time)
15 (slug post-slug)
16 (title post-title)
17 (tags post-tags))