From 756f16c6d28b6281156bcd252f79832b823a4d43 Mon Sep 17 00:00:00 2001 From: Alex Sassmannshausen Date: Fri, 11 Nov 2016 20:55:24 +0100 Subject: Generate multiple paginated packages pages. * website/www.scm (%web-pages): Add code for generating our packages pages. * website/www/packages.scm (packages-by-grouping): New procedure. (paginated-packages-page): New procedure. (packages-page): Tweak for use by `paginated-packages-page` as well as standalone. * website/static/base/css/packages.css (li.package-index-link): Add styling. --- website/static/base/css/packages.css | 8 ++- website/www.scm | 8 ++- website/www/packages.scm | 96 ++++++++++++++++++++++++++++-------- 3 files changed, 89 insertions(+), 23 deletions(-) diff --git a/website/static/base/css/packages.css b/website/static/base/css/packages.css index 177f416..d218c51 100644 --- a/website/static/base/css/packages.css +++ b/website/static/base/css/packages.css @@ -2,6 +2,12 @@ @import url("article.css"); +li.package-index-link { + list-style: none; + display: inline; + margin: 0 0.3em; +} + a { transition: all 0.3s; } @@ -82,4 +88,4 @@ img.status-icon { position: absolute; top: 0px; left: 0px; -} \ No newline at end of file +} diff --git a/website/www.scm b/website/www.scm index 59e917a..7ca6a78 100644 --- a/website/www.scm +++ b/website/www.scm @@ -27,6 +27,7 @@ #:use-module (www about) #:use-module (www contribute) #:use-module (www help) + #:use-module (www packages) #:use-module (www security) #:use-module (www news) #:use-module (haunt post) @@ -293,7 +294,12 @@ Distribution.") ("download/index.html" ,download-page) ("help/index.html" ,help-page) ("security/index.html" ,security-page) - ;; ("packages/index.html" ,packages-page) ; Need Guix + ;; ,@(map (lambda (group) + ;; `(,(string-append "packages/" group ".html") + ;; ,(paginated-packages-page group))) + ;; %groups) + ;; ("packages/index.html" ,(paginated-packages-page "0-9")) + ;; ("packages/all.html" ,packages-page) ;; ("packages/issues.html" ,issues-page) )) diff --git a/website/www/packages.scm b/website/www/packages.scm index 9f345ae..63cea3a 100644 --- a/website/www/packages.scm +++ b/website/www/packages.scm @@ -44,7 +44,9 @@ #:use-module (srfi srfi-26) #:use-module (texinfo) #:use-module (texinfo html) - #:export (packages-page + #:export (%groups + packages-page + paginated-packages-page issues-page)) (define lookup-gnu-package @@ -441,6 +443,21 @@ PACKAGES." ;;; Pages. ;;; +(define %groups + ;; List of package groups. + (cons "0-9" + (map string + '(#\a #\b #\c #\d #\e #\f #\g #\h + #\i #\j #\k #\l #\m #\n #\o #\p + #\q #\r #\s #\t #\u #\v #\w #\x + #\y #\z)))) + +(define (group-file-name group) + (string-append "/packages/" group ".html")) + +(define (group-name group) + (string-upcase group)) + (define (all-packages) "Return the list of all package objects, sorted by name." (sort (fold-packages (lambda (package lst) @@ -452,29 +469,66 @@ PACKAGES." (string) + first string->list package-name) + (all-packages))) + (letter (filter (lambda (package) + (string=? (string-take (package-name package) 1) + letter)) + (all-packages)))))) + +(define (paginated-packages-page grouping) + "Return a packages page that contains only content for the packages +that match GROUPING (either the string '0-9' or a string of one +letter)." + (lambda () + (packages-page (string-upcase grouping) (packages-by-grouping grouping)))) + +(define* (packages-page #:optional (grouping "All") + (packages (all-packages))) `(html (@ (lang "en")) - ,(html-page-header "Packages" #:css "packages.css" #:js "packages.js") - (body - ,(html-page-description) - ,(html-page-links) - - (div (@ (id "content-box")) - (article - (h1 "Packages") - (p "GNU Guix provides " + ,(html-page-header "Packages" #:css "packages.css" #:js "packages.js") + (body + ,(html-page-description) + ,(html-page-links) + + (div (@ (id "content-box")) + (article + (h1 ,(string-append "Packages [" grouping "]")) + (p "GNU Guix provides " ,(number* (fold-packages (lambda (p n) (+ 1 n)) 0)) " packages transparently " - (a (@ (href "http://hydra.gnu.org/jobset/gnu/master#tabs-status")) - "available as pre-built binaries") - ". This is a complete list of the packages. Our " - (a (@ (href "http://hydra.gnu.org/jobset/gnu/master")) - "continuous integration system") - " shows their current build status " - "(Updated " ,(date->string (current-date) "~B ~e, ~Y") ").") - ,(packages->sxml (all-packages)))) - - ,(html-page-footer)))) + (a (@ (href "http://hydra.gnu.org/jobset/gnu/master#tabs-status")) + "available as pre-built binaries") + ". These pages provide a complete list of the packages. + Our " + (a (@ (href "http://hydra.gnu.org/jobset/gnu/master")) + "continuous integration system") + " shows their current build status " + "(Updated " ,(date->string (current-date) "~B ~e, ~Y") ").") + (p "You can browse packages indexed by their first letter, or +you can view " + (a (@ (href "/packages/all.html")) + "all packages on a single page.")) + (ul + ,@(map (lambda (group) + `(li (@ (id ,(string-append group "-link")) + (class "package-index-link")) + (a (@ (href ,(group-file-name group))) + ,(group-name group)))) + %groups)) + ,(packages->sxml packages))) + + ,(html-page-footer)))) (define* (issues-page #:key (checkers %issue-checkers)) `(html -- cgit v1.2.3