From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Sassmannshausen Subject: [PATCH] Generate multiple paginated packages pages. Date: Wed, 30 Nov 2016 00:22:24 +0100 Message-ID: <20161129232224.28525-2-alex@pompo.co> References: <20161129232224.28525-1-alex@pompo.co> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:54174) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cBrkl-0002mx-3H for guix-devel@gnu.org; Tue, 29 Nov 2016 18:24:00 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cBrkh-00036q-T3 for guix-devel@gnu.org; Tue, 29 Nov 2016 18:23:59 -0500 Received: from mail-wm0-f68.google.com ([74.125.82.68]:36029) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cBrkh-00036i-IX for guix-devel@gnu.org; Tue, 29 Nov 2016 18:23:55 -0500 Received: by mail-wm0-f68.google.com with SMTP id m203so26780134wma.3 for ; Tue, 29 Nov 2016 15:23:55 -0800 (PST) In-Reply-To: <20161129232224.28525-1-alex@pompo.co> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org Cc: Alex Sassmannshausen * 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 -- 2.10.2