summaryrefslogtreecommitdiffstats
path: root/haunt.scm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haunt.scm97
1 files changed, 94 insertions, 3 deletions
diff --git a/haunt.scm b/haunt.scm
index f4c95aa..b67b668 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -19,10 +19,15 @@
19 (haunt site) 19 (haunt site)
20 (haunt page) 20 (haunt page)
21 (haunt html) 21 (haunt html)
22 (haunt post)
22 (haunt builder assets) 23 (haunt builder assets)
24 (haunt builder blog)
25 (haunt builder atom)
23 (haunt reader) 26 (haunt reader)
24 (haunt reader commonmark) 27 (haunt reader commonmark)
25 (srfi srfi-71) 28 (srfi srfi-19) ;dates
29 (srfi srfi-26) ;cut
30 (srfi srfi-71) ;multiple-value let
26 (ice-9 match)) 31 (ice-9 match))
27 32
28(define %cwd 33(define %cwd
@@ -152,11 +157,97 @@ representation."
152 "social-contract.md"))) 157 "social-contract.md")))
153 158
154 159
160;;;
161;;; Blog.
162;;;
163
164(define (post-url post site)
165 "Return the URL of POST, a Haunt blog post, for SITE."
166 (let ((date (post-date post)))
167 (base-url "/en/blog/"
168 (number->string (date-year date))
169 "/"
170 (string-pad (number->string (date-month date))
171 2 #\0)
172
173 ;; There's an implicit "/index.html" here.
174 "/" (site-post-slug site post))))
175
176(define* (post->sxml post #:key post-uri summarize?)
177 "Return the SXML for POST."
178 (define post-body*
179 ;; (if summarize?
180 ;; (cut summarize-post <> post-uri)
181 ;; post-sxml*)
182 post-sxml
183 )
184
185 `(div (@ (class "post"))
186 (h1 (@ (class "title"))
187 ,(if post-uri
188 `(a (@ (href ,post-uri))
189 ,(post-ref post 'title))
190 (post-ref post 'title)))
191 (div (@ (class "post-about"))
192 ,(post-ref post 'author)
193 " — " ,(date->string (post-date post) "~B ~e, ~Y"))
194 (hr)
195 (div (@ (class "post-body"))
196 ,(post-body* post))))
197
198(define (page->sxml site title posts prefix)
199 "Return the SXML for the news page of SITE, containing POSTS."
200 `((div (@ (class "header"))
201 (div (@ (class "post-list"))
202 ,@(map (lambda (post)
203 (post->sxml post #:post-uri (post-url post site)
204 #:summarize? #t))
205 posts)))))
206
207(define (post->page post site)
208 (make-page (string-append (post-url post site) "/index.html")
209 (render-post %theme site post)
210 sxml->html))
211
212(define %theme
213 ;; Theme for the rendering of the news pages.
214 (theme #:name "The GNU Assembly"
215 #:layout (lambda (site title body)
216 (base-layout body
217 #:title
218 (string-append "The GNU Assembly — "
219 title)))
220 #:post-template post->sxml
221 #:collection-template page->sxml))
222
223
155(site #:title "The GNU Assembly" 224(site #:title "The GNU Assembly"
156 #:domain "gnu.tools" 225 #:domain "gnu.tools"
157 #:default-metadata 226 #:default-metadata
158 '((author . "The GNU Assembly") 227 '((author . "The GNU Assembly")
159 (email . "assembly@lists.gnu.tools")) 228 (email . "assembly@lists.gnu.tools"))
160 #:readers (list commonmark-reader) 229 #:readers (list commonmark-reader)
161 #:builders (cons (static-directory "static") 230 #:builders (append (list (static-directory "static"))
162 (static-pages))) 231 (static-pages)
232
233 ;; Blog posts.
234 (list (lambda (site posts)
235 ;; Pages for each post.
236 (map (cut post->page <> site) posts))
237
238 (lambda (site posts)
239 ;; The main collection.
240 (make-page
241 "/en/blog/index.html"
242 (render-collection
243 %theme site
244 "The GNU Assembly — Blog" ;title
245 (posts/reverse-chronological posts)
246 "/en/blog")
247 sxml->html))
248
249 ;; Apparently the <link> tags of Atom entries
250 ;; must be absolute URLs, hence this
251 ;; #:blog-prefix.
252 (atom-feed #:file-name "en/blog/feed.xml"
253 #:blog-prefix "https://gnu.tools/en/blog"))))