* website/www.scm (%web-pages): Add prototype code for generating our
packages pages.
* website/www/packages.scm (all-packages): Re-factor to
`packages-by-grouping`.
(paginated-packages-page): New procedure.
(packages-page): Tweak for use by `paginated-packages-page` as well as
standalone.
(issues-page): Use `packages-by-grouping`.
---
website/www.scm | 12 +++++++-
website/www/packages.scm | 74 +++++++++++++++++++++++++++++++++++++-----------
2 files changed, 69 insertions(+), 17 deletions(-)
diff --git a/website/www.scm b/website/www.scm
index 459629f..489260e 100644
--- a/website/www.scm
+++ b/website/www.scm
@@ -293,7 +293,17 @@ Distribution.")
("download/index.html" ,download-page)
("help/index.html" ,help-page)
("security/index.html" ,security-page)
- ;; ("packages/index.html" ,packages-page) ; Need Guix
+ ;; Paged packages pages! Need Guix
+ ;; Not 100% if this how the website is supposed to work. Would
+ ;; appreciate comment on this.
+ ;; ,@(map (lambda (grouping)
+ ;; `(,(string-append "packages/" grouping ".html")
+ ;; (paginated-packages-page ,grouping)))
+ ;; (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))))
+ ;; ("packages/index.html" ,packages-page)
;; ("packages/issues.html" ,issues-page)
))
diff --git a/website/www/packages.scm b/website/www/packages.scm
index ccafa28..9d39bc6 100644
--- a/website/www/packages.scm
+++ b/website/www/packages.scm
@@ -438,18 +438,39 @@ PACKAGES."
;;; Pages.
;;;
-(define (all-packages)
- "Return the list of all package objects, sorted by name."
- (sort (fold-packages (lambda (package lst)
- (cons (or (package-replacement package)
- package)
- lst))
- '())
- (lambda (p1 p2)
- (string<? (package-name p1)
- (package-name p2)))))
-
-(define (packages-page)
+(define packages-by-grouping
+ (let ((packages (sort (fold-packages (lambda (package lst)
+ (cons (or (package-replacement package)
+ package)
+ lst))
+ '())
+ (lambda (p1 p2)
+ (string<? (package-name p1)
+ (package-name p2))))))
+ (lambda* (#:optional (grouping 'all))
+ "Return an alphabetically sorted list of Guix packages, limited
+to those matching GROUPING. GROUPING can be 'all for all packages,
+the string '0-9' for all packages starting with digits, or a string of
+a single, lower-case letter for a list of all packages starting with
+that letter."
+ (match grouping
+ ('all packages)
+ ("0-9" (filter (compose (cut char-set-contains? char-set:digit <>)
+ first string->list package-name)
+ packages))
+ (letter (filter (lambda (package)
+ (string=? (string-take (package-name package) 1)
+ letter))
+ 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)."
+ (packages-page (string-upcase grouping) (packages-by-grouping grouping)))
+
+(define* (packages-page #:optional (grouping "All")
+ (packages (packages-by-grouping)))
`(html (@ (lang "en"))
,(html-page-header "Packages" #:css "packages.css" #:js "packages.js")
(body
@@ -458,17 +479,38 @@ PACKAGES."
(div (@ (id "content-box"))
(article
- (h1 "Packages")
+ (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 "
+ ". 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.")
- ,(packages->sxml (all-packages))
+ ;; fixme: Ensure these pages work.
+ (p "You can browse packages indexed by their first letter, or
+you can view "
+ (a (@ (href "/software/guix/packages/all"))
+ "all packages on a single page."))
+ (ul
+ ,@(map (lambda (grouping)
+ `(li (@ (id ,(string-append grouping "-link"))
+ (class "package-index-link"))
+ (a (@ (href ,(string-append
"/software/guix/packages/"
+ grouping ".html")))
+
+ ,(string-upcase grouping))))
+ (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)))))
+
+ ,(packages->sxml packages)
(p "Updated " ,(date->string (current-date) "~B ~e, ~Y")
".")))
@@ -492,7 +534,7 @@ reported by "
"manual/html_node/Invoking-guix-lint.html")))
(code "guix lint")) ".")
- ,(packages->issue-sxml (all-packages)
+ ,(packages->issue-sxml (packages-by-grouping)
#:checkers checkers)
(p "Updated " ,(date->string (current-date) "~B ~e, ~Y")
--
2.10.1
