Added feed generation
Getty Ritter
10 years ago
| 3 | 3 | |
| 4 | 4 | Number one: I want to force myself to write on a regular |
| 5 | 5 | basis, mostly regardless of content. It's striking to me that I am |
| 6 |
ver |
|
| 6 | very used to \em{writing}—I probably write a novel's worth on various | |
| 7 | 7 | chat services every week or so—but when I start to do long-form |
| 8 | 8 | writing, I tend to waffle and get bogged down in little details |
| 9 | 9 | and then give up.\ref{blog} |
| 20 | 20 | (define (outfile chunks) |
| 21 | 21 | (define (go rest so-far) |
| 22 | 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)))))) | |
| 23 | (match rest | |
| 24 | (() (++ so-far "/index.html")) | |
| 25 | ((x . xs) (go xs (++ so-far "/" (as-string x)))))) | |
| 27 | 26 | (go chunks "output")) |
| 28 | 27 | |
| 29 | 28 | ;; create a URL from a set of path components |
| 30 | 29 | (define (url chunks) |
| 31 | 30 | (define (go rest so-far) |
| 32 | 31 | (match rest |
| 33 |
(() |
|
| 32 | (() (++ so-far "/")) | |
| 34 | 33 | ((x . xs) (go xs (++ so-far "/" (as-string x)))))) |
| 35 |
(go chunks " |
|
| 34 | (go chunks "")) | |
| 36 | 35 | |
| 37 | 36 | ;; Grab all the posts and their metadata from the posts folder, |
| 38 | 37 | ;; sorted by creation time. This does unnecessary work right |
| 45 | 44 | (stat:mtime (cadr y))))))) |
| 46 | 45 | (map (lambda (file-entry) |
| 47 | 46 | (let* ((filename (string-append "posts/" (car file-entry))) |
| 48 |
( |
|
| 47 | (telml (translate-file filename)) | |
| 48 | (metadata (telml-meta telml))) | |
| 49 | 49 | (make-post filename |
| 50 | 50 | (localtime (stat:mtime (cadr file-entry))) |
| 51 | 51 | (meta-slug metadata) |
| 52 | 52 | (meta-title metadata) |
| 53 |
(meta-tags metadata) |
|
| 53 | (meta-tags metadata) | |
| 54 | (telml-content telml)))) | |
| 54 | 55 | files-sorted))) |
| 55 | 56 | |
| 56 | 57 | ;; Turn a post into an <li> element with appropriate |
| 75 | 76 | ,(map post->list-elem posts))))) |
| 76 | 77 | (with-output-to-file (outfile '(archive)) |
| 77 | 78 | (lambda () |
| 78 |
(display (sxml->html5 (page |
|
| 79 | (display (sxml->html5 (page (url '(archive)) "archive" list))))))) | |
| 79 | 80 | |
| 80 | 81 | ;; Flatten a list |
| 81 | 82 | (define (concat list) |
| 108 | 109 | ,(map post->list-elem ps))))) |
| 109 | 110 | (with-output-to-file (outfile (list 'tag tag)) |
| 110 | 111 | (lambda () |
| 111 |
(display (sxml->html5 (page |
|
| 112 | (display (sxml->html5 (page (url (list 'tag tag)) | |
| 113 | tag | |
| 114 | content))))))) | |
| 112 | 115 | |
| 113 | 116 | (with-output-to-file (outfile '(tags)) |
| 114 | 117 | (lambda () |
| 115 |
(display (sxml->html5 (page |
|
| 118 | (display (sxml->html5 (page (url '(tags)) | |
| 119 | "tags" | |
| 120 | tag-list))))) | |
| 116 | 121 | |
| 117 | 122 | (map mk-tag-page tags))) |
| 123 | ||
| 124 | (define (feed) | |
| 125 | (let ((posts (get-all-posts))) | |
| 126 | (with-output-to-file "output/feed.xml" | |
| 127 | (lambda () | |
| 128 | (display (serialize-sxml (atom-feed posts))))))) | |
| 118 | 129 | |
| 119 | 130 | ;; Load a telml page and turn it into an html page |
| 120 | 131 | (define (main pg file out) |
| 124 | 135 | (date (localtime (stat:mtime (stat file)))) |
| 125 | 136 | (ndate (date->string date)) |
| 126 | 137 | (title (if meta (meta-title meta) pg)) |
| 127 | (target (if out out | |
| 128 | (outfile (list ndate (meta-slug meta))))) | |
| 129 |
( |
|
| 138 | (target (outfile (if out out | |
| 139 | (list ndate (meta-slug meta))))) | |
| 140 | (url (url (if out out | |
| 141 | (list ndate (meta-slug meta))))) | |
| 142 | (display (sxml->html5 (page url | |
| 143 | title | |
| 144 | (add-tags telml (meta-tags meta)))))) | |
| 130 | 145 | (format #t "printing to ~a\n" target) |
| 131 | 146 | (with-output-to-file target |
| 132 | 147 | (lambda () (format #t "~a\n" display))))) |
| 134 | 149 | ;; Figure out which page is supposed to be generated |
| 135 | 150 | (define (dispatch pg files) |
| 136 | 151 | (match pg |
| 137 |
("index" (main "index" (car files) |
|
| 152 | ("index" (main "index" (car files) '())) | |
| 138 | 153 | ("post" (map (lambda (f) (main "post" f #f)) files)) |
| 139 | 154 | ("archive" (archive)) |
| 140 | 155 | ("tags" (tags)) |
| 141 |
("about" (main "about" "pages/about.telml" |
|
| 156 | ("about" (main "about" "pages/about.telml" '(about))) | |
| 157 | ("feed" (feed)))) | |
| 142 | 158 | |
| 143 | 159 | (let ((args (cdr (command-line)))) |
| 144 | 160 | (cond ((= (length args) 0) |
| 4 | 4 | (define (date->string date) |
| 5 | 5 | (strftime "%Y-%m-%d" date)) |
| 6 | 6 | |
| 7 | (define (date->tz date) | |
| 8 | (strftime "%Y-%m-%dT%TZ" date)) | |
| 9 | ||
| 7 | 10 | (define (post-url post) |
| 8 | 11 | (let ((date (date->string (post-time post))) |
| 9 | 12 | (slug (post-slug post))) |
| 10 | 13 | (format #f "/~a/~a/" date slug))) |
| 11 | 14 | |
| 12 | (define (atom-element post content) | |
| 13 | (let ((url (post-url post))) | |
| 15 | (define (atom-element post) | |
| 16 | (let ((url (++ "http://what.happens.when.computer" (post-url post)))) | |
| 14 | 17 | `(entry |
| 15 |
(title ,(post-title |
|
| 18 | (title ,(post-title post)) | |
| 16 | 19 | (link (@ (href ,url))) |
| 17 | 20 | (id ,url) |
| 18 |
(updated ,( |
|
| 21 | (updated ,(date->tz (post-time post))) | |
| 19 | 22 | (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))) | |
| 23 | ,(post-content post))))) | |
| 30 | 24 | |
| 31 | 25 | (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 |
|
|
| 26 | (let ((updated (date->tz (post-time (car posts))))) | |
| 27 | `(feed (@ (xmlns "htpt://www.w3.org/2005/Atom")) | |
| 28 | (title "what happens when computer") | |
| 29 | (link (@ (href "http://what.happens.when.computer/feed.xml") | |
| 30 | (rel "self"))) | |
| 31 | (link (@ (href "http://what.happens.when.computer/"))) | |
| 32 | (updated ,updated) | |
| 33 | (id "http://what.happens.when.computer/") | |
| 34 | ,(map (lambda (post) (atom-element post)) posts)))) | |
| 39 | 35 | |
| 36 | ;; the scss stylesheet | |
| 40 | 37 | (define stylesheet |
| 41 | 38 | '((body |
| 42 | 39 | (font-family "Palatino, \"Palatino Linotype\", \"Palatino LT STD\", \"Book Antiqua\", Georgia, serif") |
| 145 | 142 | ,(menu-item "about" "/about/")))) |
| 146 | 143 | |
| 147 | 144 | ;; The SXML chunk representing a page on the site |
| 148 |
(define (page |
|
| 145 | (define (page url title content) | |
| 149 | 146 | `(html |
| 150 | 147 | (head |
| 151 | 148 | (meta (@ (http-equiv "Content-Type") |
| 152 | 149 | (content "application/xhtml+xml; charset=utf-8;"))) |
| 150 | (meta (@ (property "og:title") | |
| 151 | (content ,(++ "what happens when computer: " title)))) | |
| 152 | (meta (@ (property "og:url") | |
| 153 | (content ,(++ "http://what.happens.when.computer" url)))) | |
| 154 | (meta (@ (property "og:type") | |
| 155 | (content "website"))) | |
| 156 | (link (@ (href "/feed.xml") | |
| 157 | (type "application/atom+xml") | |
| 158 | (rel "alternate") | |
| 159 | (title "what happens when computer atom feed"))) | |
| 153 | 160 | (style (@ (type "text/css")) ,(scss->css stylesheet)) |
| 154 | 161 | (script (@ (type "text/javascript") |
| 155 | 162 | (src "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML")) "") |
| 161 | 168 | (div (@ (class "main")) ,content) |
| 162 | 169 | (div (@ (class "footer")) "© 2015 getty ritter")))) |
| 163 | 170 | |
| 171 | ;; if a page has tags, add those tags to the end of the page | |
| 164 | 172 | (define (add-tags chunk tags) |
| 165 | 173 | (define (tag->link tag) |
| 166 | 174 | `(a (@ (href ,(format #f "/tag/~a/" tag)) |
| 1 | 1 | (use-modules (srfi srfi-9)) |
| 2 | 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 | 3 | (define-record-type <post> |
| 11 |
(make-post file time slug title tags |
|
| 4 | (make-post file time slug title tags content) | |
| 12 | 5 | post? |
| 13 | (file post-file) | |
| 14 | (time post-time) | |
| 15 | (slug post-slug) | |
| 16 | (title post-title) | |
| 17 |
( |
|
| 6 | (file post-file) | |
| 7 | (time post-time) | |
| 8 | (slug post-slug) | |
| 9 | (title post-title) | |
| 10 | (tags post-tags) | |
| 11 | (content post-content)) |