diff mbox

Generate multiple paginated packages pages.

Message ID 20161111200339.7062-2-alex@pompo.co
State New
Headers show

Commit Message

Alex Sassmannshausen Nov. 11, 2016, 8:03 p.m. UTC
* 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(-)

Comments

Ludovic Courtès Nov. 12, 2016, 2:34 p.m. UTC | #1
Hello Alex!

Alex Sassmannshausen <alex.sassmannshausen@gmail.com> skribis:

> * 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`.

Neat!

I had in mind something that would involve JS code in the browser and
would allow people to make generic searches.  However, what you suggest
has the advantage of not requiring JS at all and it’s convenient as
well, so I guess we should go for it.  :-)

> 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))))

Yes this should work.

> -(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))))))

I think we should keep ‘all-packages’ instead of inlining it here.

> +                ;; 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."))

What about generating a list of links instead, like:

  (map (lambda (group)
         `(a (@ (href ,(group-file-name group))) ,(group-name group)))
       %groups)

where:

  (define %groups
    ;; List of package groups.
    (cons "0-9" (map string '(#\a …))))

  (define (group-file-name group)
    (match group
      ("0-9" "0-9.html")
      …))

  …

?

With these changes, that’s OK for me.

I’ll adjust the cron job on hydra.gnu.org to generate all the pages when
it’s committed.

Thank you!

Ludo’.
diff mbox

Patch

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")