Commit 29490435 authored by Ludovic Courtès's avatar Ludovic Courtès

Fix 'feed.xml' to use the new blog post URLs.

* guix-hpc.scm (sxml->xml*, date->string*)
(post->atom-entry, atom-feed): New procedures.
* haunt.scm: Use it.  Adjust blog URL.
parent c2f5d77b
...@@ -3,20 +3,25 @@ ...@@ -3,20 +3,25 @@
;;; ;;;
;;; Copyright © 2017 Inria ;;; Copyright © 2017 Inria
;;; Copyright © 2017 Ludovic Courtès ;;; Copyright © 2017 Ludovic Courtès
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
(define-module (guix-hpc) (define-module (guix-hpc)
#:use-module (haunt post) #:use-module (haunt post)
#:use-module (haunt page) #:use-module (haunt page)
#:use-module (haunt site) #:use-module (haunt site)
#:use-module (haunt html) #:use-module (haunt html)
#:use-module (haunt utils)
#:use-module (haunt reader) #:use-module (haunt reader)
#:use-module (haunt reader commonmark) #:use-module (haunt reader commonmark)
#:use-module (syntax-highlight) #:use-module (syntax-highlight)
#:use-module (syntax-highlight scheme) #:use-module (syntax-highlight scheme)
#:use-module (syntax-highlight lexers) #:use-module (syntax-highlight lexers)
#:use-module (sxml simple)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:export (base-url #:export (base-url
image-url image-url
css-url css-url
...@@ -25,7 +30,8 @@ ...@@ -25,7 +30,8 @@
syntax-highlight syntax-highlight
base-layout base-layout
static-pages)) static-pages
atom-feed))
(define (base-url . location) (define (base-url . location)
(string-concatenate (cons "" location))) (string-concatenate (cons "" location)))
...@@ -142,6 +148,10 @@ ...@@ -142,6 +148,10 @@
"Source of this site"))))))) "Source of this site")))))))
;;;
;;; Static pages.
;;;
(define %cwd (define %cwd
(and=> (assq-ref (current-source-location) 'filename) (and=> (assq-ref (current-source-location) 'filename)
dirname)) dirname))
...@@ -168,3 +178,63 @@ representation." ...@@ -168,3 +178,63 @@ representation."
(list (markdown-page "about/index.html" "about.md") (list (markdown-page "about/index.html" "about.md")
(markdown-page "index.html" "getting-started.md"))) (markdown-page "index.html" "getting-started.md")))
;;;
;;; Atom feed (stolen from Haunt and adjusted).
;;;
;;; We cannot use Haunt's 'atom-feed' because of the non-default post URLs
;;; that we use. Thus the code below is mostly duplicated from (haunt
;;; builder atom), with the exception of the URLs.
(define (sxml->xml* sxml port)
"Write SXML to PORT, preceded by an <?xml> tag."
(display "<?xml version=\"1.0\" encoding=\"utf-8\"?>" port)
(sxml->xml sxml port))
(define (date->string* date)
"Convert date to ISO-8601 formatted string."
(date->string date "~4"))
(define* (post->atom-entry site post #:key (blog-prefix ""))
"Convert POST into an Atom <entry> XML node."
`(entry
(title ,(post-ref post 'title))
(author
(name ,(post-ref post 'author))
,(let ((email (post-ref post 'email)))
(if email `(email ,email) '())))
(updated ,(date->string* (post-date post)))
(link (@ (href ,(post-url post site))
(rel "alternate")))
(summary (@ (type "html"))
,(sxml->html-string (post-sxml post)))))
(define* (atom-feed #:key
(file-name "feed.xml")
(subtitle "Recent Posts")
(filter posts/reverse-chronological)
(max-entries 20)
(blog-prefix ""))
"Return a builder procedure that renders a list of posts as an Atom
feed. All arguments are optional:
FILE-NAME: The page file name
SUBTITLE: The feed subtitle
FILTER: The procedure called to manipulate the posts list before rendering
MAX-ENTRIES: The maximum number of posts to render in the feed"
(lambda (site posts)
(make-page file-name
`(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
(title ,(site-title site))
(subtitle ,subtitle)
(updated ,(date->string* (current-date)))
(link (@ (href ,(string-append (site-domain site)
"/" file-name))
(rel "self")))
(link (@ (href ,(site-domain site))))
,@(map (cut post->atom-entry site <>
#:blog-prefix blog-prefix)
(take-up-to max-entries (filter posts))))
sxml->xml*)))
...@@ -15,7 +15,6 @@ ...@@ -15,7 +15,6 @@
(haunt utils) (haunt utils)
(haunt builder assets) (haunt builder assets)
(haunt builder blog) (haunt builder blog)
(haunt builder atom)
(ice-9 match) (ice-9 match)
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-19) (srfi srfi-19)
...@@ -94,7 +93,7 @@ ...@@ -94,7 +93,7 @@
;; Apparently the <link> tags of Atom entries must be absolute URLs, ;; Apparently the <link> tags of Atom entries must be absolute URLs,
;; hence this #:blog-prefix. ;; hence this #:blog-prefix.
(atom-feed #:file-name "blog/feed.xml" (atom-feed #:file-name "blog/feed.xml"
#:blog-prefix "https://hpc.guixsd.org") #:blog-prefix "https://hpc.guixsd.org/blog")
(static-directory "static") (static-directory "static")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment