[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: website: Add "News" page.
From: |
Ludovic Courtès |
Subject: |
04/04: website: Add "News" page. |
Date: |
Tue, 25 Oct 2016 23:18:56 +0000 (UTC) |
civodul pushed a commit to branch wip-haunt
in repository guix-artwork.
commit 16a9d331dc1ab7accae2983387bb245de8e98b39
Author: Ludovic Courtès <address@hidden>
Date: Wed Oct 26 01:16:53 2016 +0200
website: Add "News" page.
* website/www/news.scm: New file.
* website/static/base/css/news.css: New file.
* website/haunt.scm (with-url-parameters): New macro.
(parameterized-procedure, parameterized-theme): New procedures.
<top level>: Use 'with-url-parameters' and add blog and atom feed.
---
website/haunt.scm | 38 ++++++++++++++++----
website/static/base/css/news.css | 22 ++++++++++++
website/www/news.scm | 73 ++++++++++++++++++++++++++++++++++++++
3 files changed, 126 insertions(+), 7 deletions(-)
diff --git a/website/haunt.scm b/website/haunt.scm
index af57d2f..47719d1 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 "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..99f7992
--- /dev/null
+++ b/website/static/base/css/news.css
@@ -0,0 +1,22 @@
+/*
+ Public domain 2016 Ludovic Courtès <address@hidden>.
+ All rights waived.
+*/
+
address@hidden url("article.css");
+
+.example {
+ border-style: none;
+ border-radius: 0.3em;
+ background-color: #F2EFE4;
+ border-width: thin;
+ color: #4D4D4D;
+ font-size: 0.9em;
+ padding: 10px;
+ text-align: left;
+ font-family: fixed-width;
+}
+
+.post-about {
+ color: #4D4D4D;
+}
diff --git a/website/www/news.scm b/website/www/news.scm
new file mode 100644
index 0000000..3c6ca4a
--- /dev/null
+++ b/website/www/news.scm
@@ -0,0 +1,73 @@
+;;; GuixSD website --- GNU's advanced distro website
+;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;;
+;;; 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 (%news-haunt-theme))
+
+(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"))
+ (span (@ (class "by-line"))
+ ,(post-ref post 'author))
+ " — " ,(date->string (post-date post) "~e ~B ~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."
+ (define (post-uri post)
+ (base-url (string-append "news/" (site-post-slug site post) ".html")))
+
+ `((div (@ (class "news-header"))
+ (h1 "Recent News"))
+ (div (@ (class "post-list"))
+ ,@(map (lambda (post)
+ (post->sxml post #:post-uri (post-uri post)))
+ 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))