diff options
| -rw-r--r-- | website/haunt.scm | 38 | ||||
| -rw-r--r-- | website/static/base/css/news.css | 23 | ||||
| -rw-r--r-- | website/www/news.scm | 77 |
3 files changed, 131 insertions, 7 deletions
diff --git a/website/haunt.scm b/website/haunt.scm index ec37fcf..7e694d2 100644 --- a/website/haunt.scm +++ b/website/haunt.scm @@ -25,9 +25,12 @@ (haunt html) (haunt utils) (haunt builder assets) + (haunt builder blog) + (haunt builder atom) (ice-9 match) (www) - (www utils)) + (www utils) + (www news)) (define %local-test? ;; True when we're testing locally, as opposed to producing things to @@ -39,6 +42,28 @@ ;; The URLs produced in these pages are only meant for local consumption. (format #t "~%Producing Web pages for local tests *only*!~%~%")) +(define-syntax-rule (with-url-parameters body ...) + "Run BODY in a context where URL parameters honor %LOCAL-TEST?." + (parameterize ((current-url-root (if %local-test? + "" + (current-url-root))) + (gnu.org-root (if %local-test? + "https://www.gnu.org" + (gnu.org-root)))) + body ...)) + +(define (parameterized-procedure proc) + (lambda args + (with-url-parameters + (apply proc args)))) + +(define (parameterized-theme thm) + (theme #:name (theme-name thm) + #:layout (parameterized-procedure (theme-layout thm)) + #:post-template (parameterized-procedure (theme-post-template thm)) + #:collection-template (parameterized-procedure + (theme-collection-template thm)))) + (site #:title "GNU's advanced distro and transactional package manager" #:domain "//www.gnu.org/software/guix" #:default-metadata @@ -49,12 +74,11 @@ `(,@(map (match-lambda ((file-name contents) (lambda (site posts) - (parameterize ((current-url-root (if %local-test? - "" - (current-url-root))) - (gnu.org-root (if %local-test? - "https://www.gnu.org" - (gnu.org-root)))) + (with-url-parameters (make-page file-name (contents) sxml->html))))) %web-pages) + ,(blog #:theme (parameterized-theme %news-haunt-theme) + #:prefix "news") + ,(atom-feed #:file-name "news/feed.xml" + #:blog-prefix "news") ,(static-directory "static"))) diff --git a/website/static/base/css/news.css b/website/static/base/css/news.css new file mode 100644 index 0000000..7f1da04 --- /dev/null +++ b/website/static/base/css/news.css @@ -0,0 +1,23 @@ +/* + Public domain 2016 Ludovic Courtès <ludo@gnu.org>. + All rights waived. +*/ + +@import url("article.css"); + +.example { + border-style: none; + border-radius: 0.3em; + background-color: #F2EFE4; + border-width: thin; + color: black; + font-size: 0.9em; + padding: 10px; + text-align: left; + font-family: fixed-width; +} + +.post-about { + color: #4D4D4D; + font-size: 0.9em; +} diff --git a/website/www/news.scm b/website/www/news.scm new file mode 100644 index 0000000..849fc44 --- /dev/null +++ b/website/www/news.scm @@ -0,0 +1,77 @@ +;;; GuixSD website --- GNU's advanced distro website +;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GuixSD website. +;;; +;;; GuixSD website is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU Affero General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GuixSD website is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public License +;;; along with GuixSD website. If not, see <http://www.gnu.org/licenses/>. + +(define-module (www news) + #:use-module (www utils) + #:use-module (www shared) + #:use-module (haunt site) + #:use-module (haunt post) + #:use-module (haunt builder blog) + #:use-module (srfi srfi-19) + #:export (post-url + %news-haunt-theme)) + +(define (post-url post site) + "Return the URL of POST, a Haunt blog post, for SITE." + (base-url (string-append "news/" (site-post-slug site post) ".html"))) + +(define* (post->sxml post #:key post-uri) + "Return the SXML for POST." + `(div (h2 (@ (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-body")) + ,(post-sxml post)))) + +(define (news-page-sxml site title posts prefix) + "Return the SXML for the news page of SITE, containing POSTS." + `((div (@ (class "news-header")) + (h1 "Recent News " + (a (@ (href ,(base-url "news/feed.xml"))) + (img (@ (alt "Atom feed") + (src ,(image-url "feed.png"))))))) + (div (@ (class "post-list")) + ,@(map (lambda (post) + (post->sxml post #:post-uri (post-url post site))) + posts)))) + +(define (base-layout body) + `(html (@ (lang "en")) + ,(html-page-header "News" #:css "news.css") + + (body + ,(html-page-description) + ,(html-page-links) + + (div (@ (id "content-box")) + (article ,body)) + + ,(html-page-footer)))) + +(define %news-haunt-theme + ;; Theme for the rendering of the news pages. + (theme #:name "GuixSD" + #:layout (lambda (site title body) + (base-layout body)) + #:post-template post->sxml + #:collection-template news-page-sxml)) |