-
Ludovic Courtès authored
* about.md, doc/build.scm, events/user-developer-meetup-2021.md, events/workshop-2023.sxml, events/workshop-2024.sxml, haunt.scm: Update.
Ludovic Courtès authored* about.md, doc/build.scm, events/user-developer-meetup-2021.md, events/workshop-2023.sxml, events/workshop-2024.sxml, haunt.scm: Update.
haunt.scm 10.79 KiB
;;; This module is part of Guix-HPC and is licensed under the same terms,
;;; those of the GNU GPL version 3 or (at your option) any later version.
;;;
;;; Copyright © 2017, 2019, 2021-2025 Inria
;; This is a build file for Haunt. Run 'haunt build' to build the web site,
;; and 'haunt serve' to serve it locally. Alternatively, you can run
;; 'guix build -f guix.scm' to have everything built in the store.
(add-to-load-path (dirname (assq-ref (current-source-location) 'filename)))
(use-modules (haunt site)
(haunt reader)
(haunt reader commonmark)
(haunt artifact)
(haunt post)
(haunt html)
(haunt utils)
(haunt builder assets)
(haunt builder blog)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26)
(guix-hpc)
((events workshop-2023 program) #:prefix workshop-2023:)
((events workshop-2024 program) #:prefix workshop-2024:))
(define %web-site-title
"Guix-HPC — Reproducible software deployment for high-performance computing")
(define render-post*
(if (defined? 'post-title) ;Haunt >= 0.3.0?
(lambda (theme site post)
;; Since Haunt commit 1ca9fc90fedc718fbaa425f2a96ffccd40950e7f, the
;; 'render-post' call must be wrapped in 'with-layout' or similar.
(base-layout (render-post theme site post)
#:title (post-title post)
#:meta (post-metadata post))) ;for "fediverse-creators"
render-post))
(define (tag-list posts)
"Return the list of tags found in POSTS, sorted by popularity."
(let ((tags (make-hash-table)))
(for-each (lambda (post)
(for-each (lambda (tag)
(hash-set! tags tag
(+ 1 (hash-ref tags tag 0))))
(post-tags post)))
posts)
(match (sort (hash-fold alist-cons '() tags)
(match-lambda*
(((tag1 . count1) (tag2 . count2))
(> count1 count2))))
(((tags . counters) ...)
tags))))
(define render-collection*
(if (defined? 'post-title) ;Haunt >= 0.3.0?
(lambda* (theme site title posts directory #:key tag-cloud?)
;; Same as above.
(with-layout theme site title
`(div
,(if tag-cloud?
`(div (@ (class "tag-cloud"))
,@(map tag->sxml (tag-list posts)))
"")
,(render-collection theme site title posts
directory)))) render-collection))
(define post-sxml*
(compose full-width-images change-image-to-video post-sxml))
(define canonicalize-tag
(let ((not-good (char-set-union char-set:whitespace (char-set #\/))))
(lambda (tag)
(string-map (lambda (chr)
(if (char-set-contains? not-good chr)
#\-
chr))
(string-downcase tag)))))
(define (tag-url tag)
(string-append "/blog/tag/" (canonicalize-tag tag)))
(define (tag->sxml tag)
"Render TAG, a string, as SXML."
`(div (@ (class "post-tag"))
(a (@ (href ,(tag-url tag))) ,tag)))
(define (summarize-post post uri)
(match (post-sxml* post)
((('p paragraph ...) _ ...)
`((p ,@paragraph)
(p (a (@ (href ,uri)) "Continue reading…"))))
(body
body)))
(define* (post->sxml post #:key post-uri summarize?)
"Return the SXML for POST."
(define post-body*
(if summarize?
(cut summarize-post <> post-uri)
post-sxml*))
`(div (@ (class "post"))
(h1 (@ (class "title"))
,(if post-uri
`(a (@ (href ,post-uri))
,(post-ref post 'title))
(post-ref post 'title)))
(div (@ (class "post-about"))
,(post-ref post 'author)
" — " ,(date->string (post-date post) "~B ~e, ~Y"))
(div (@ (class "post-tags"))
,@(map tag->sxml
(or (assoc-ref (post-metadata post) 'tags)
'())))
(hr)
(div (@ (class "post-body"))
,@(if (post-ref post 'pdf)
`(,@(if (and (post-ref post 'pdf-cover)
(not summarize?))
`((img (@ (class "book-cover")
(alt "Book cover thumbnail.")
(src ,(post-ref post 'pdf-cover)))))
'())
(blockquote
(em "This document is also available as "
(a (@ (href ,(post-ref post 'pdf))) "PDF")
" ("
(a (@ (href ,(post-ref post 'pdf-booklet)))
"printable booklet")
")")))
'())
,(syntax-highlight (post-body* post)))
,(if summarize?
""
`(div (@ (class "license"))
(p "Unless otherwise stated, blog posts on this site are
copyrighted by their respective authors and published under the terms of
the "
(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
"CC-BY-SA 4.0")
" license and those of the "
(a (@ (href
"https://www.gnu.org/licenses/fdl-1.3.html"))
"GNU Free Documentation License")
" (version 1.3 or later, with no Invariant Sections, no
Front-Cover Texts, and no Back-Cover Texts).")))))
(define (page->sxml site title posts prefix)
"Return the SXML for the news page of SITE, containing POSTS."
`((div (@ (class "header"))
(div (@ (class "post-list"))
,@(map (lambda (post)
(post->sxml post #:post-uri (post-url post site)
#:summarize? #t))
posts)))))
(define (post->page post site)
(serialized-artifact
(string-append (post-url post site) "/index.html")
(render-post* %hpc-haunt-theme site post)
sxml->html))
(define %hpc-haunt-theme
;; Theme for the rendering of the news pages.
(theme #:name "Guix-HPC"
#:layout (lambda (site title body)
(base-layout body
#:title (string-append "Guix-HPC — "
title)))
#:post-template post->sxml
#:collection-template page->sxml))
(define %local-test?
;; True when we're testing locally, as opposed to producing things to
;; install to gnu.org.
(or (getenv "WEB_SITE_LOCAL")
(member "serve" (command-line)))) ;'haunt serve' command
(when %local-test?
;; The URLs produced in these pages are only meant for local consumption.
(format #t "~%Producing Web pages for local tests *only*!~%~%"))
(site #:title %web-site-title
#:domain "//hpc.guix.info"
#:default-metadata
'((author . "Guix-HPC Contributors")
(email . "guix-devel@gnu.org"))
#:readers (list sxml-reader commonmark-reader)
#:builders
(cons* (lambda (site posts)
;; Pages for each post.
(map (cut post->page <> site) posts))
(lambda (site posts)
;; The main collection.
(serialized-artifact
"/blog/index.html"
(render-collection* %hpc-haunt-theme site
"Reproducible software \
deployment for high-performance computing — Blog" ;title
(posts/reverse-chronological posts) "/blog"
#:tag-cloud? #t)
sxml->html))
(lambda (site posts)
(map (match-lambda
((tag posts ...)
(serialized-artifact
(string-append "/blog/tag/" (canonicalize-tag tag)
"/index.html")
(render-collection* %hpc-haunt-theme site
(string-append "\
Reproducible software deployment for high-performance computing — Blog — "
tag)
(posts/reverse-chronological posts)
"/blog")
sxml->html)))
(posts/group-by-tag posts)))
;; Apparently the <link> tags of Atom entries must be absolute URLs,
;; hence this #:blog-prefix.
(atom-feed #:file-name "blog/feed.xml"
#:blog-prefix "https://hpc.guix.info")
(static-directory "static")
(append (video-pages workshop-2023:talks
#:event "2023/workshop"
#:directory "/events/2023/workshop/video"
#:slides-directory "/static/doc/workshop-2023"
#:video-directory "/static/videos/workshop-2023"
#:title-prefix "2023 Workshop Videos"
#:footer
'(blockquote
(em "Videos brought to you by the video team at Institut Agro "
"and published under "
(a (@ (href "https://creativecommons.org/licenses/by-nc/3.0/"))
"CC-BY-NC 3.0")
". "
(a (@ (href
"https://git.guix.gnu.org/guix/artwork/src/branch/master/promotional/guix-hpc-workshop-2023"))
"Guix artwork")
" by Luis Felipe published under "
(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
"CC-BY-SA 4.0")
".")))
(video-pages workshop-2024:talks
#:event "2024/workshop"
#:directory "/events/2024/workshop/video"
#:slides-directory "/static/doc/workshop-2024"
#:video-directory "/static/videos/workshop-2024"
#:title-prefix "2024 Workshop Videos")
(static-pages))))