branch master updated: website: download: Distiguish different job specifications.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-artwork.

The following commit(s) were added to refs/heads/master by this push:
     new d3c3a7a  website: download: Distiguish different job specifications.
d3c3a7a is described below

commit d3c3a7a2b92597f43459e74c65048b52351cf6a1
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Apr 12 10:00:21 2021 +0200

    website: download: Distiguish different job specifications.
    
    * website/apps/download/templates/download-latest.scm (<image>)[spec]: New
    field.
    (images): Specify the image specification.
    (build-query, build-detail-url, build-product-download-url): Add a "spec"
    argument.
    (download-latest-t): Adapt accordingly.
---
 .../apps/download/templates/download-latest.scm    | 56 ++++++++++++++--------
 1 file changed, 35 insertions(+), 21 deletions(-)

diff --git a/website/apps/download/templates/download-latest.scm 
b/website/apps/download/templates/download-latest.scm
index ea2640b..2503691 100644
--- a/website/apps/download/templates/download-latest.scm
+++ b/website/apps/download/templates/download-latest.scm
@@ -31,26 +31,45 @@
   #:export (download-latest-t))
 
 (define ci-url "https://ci.guix.gnu.org";)
-(define default-spec "images")
+(define images-spec "images")
+(define tarball-spec "tarball")
 (define default-system "x86_64-linux")
 
 (define-record-type <image>
-  (make-image title description logo job labels systems type)
+  (make-image title description logo job spec labels systems type)
   image?
   (title       image-title)         ;string
   (description image-description)   ;string
   (logo        image-logo)          ;string
   (job         image-job)           ;string
+  (spec        image-spec)          ;string
   (labels      image-labels)        ;list of strings
   (systems     image-systems)       ;list of strings
   (type        image-type))         ;string
 
+(define* (build-query job system
+                      #:key
+                      (spec images-spec))
+  (format #f "query=spec:~a+status:success+system:~a+~a"
+          spec system job))
+
+(define (build-detail-url job spec system)
+  "Return the detail page for BUILD hosted on CI server at URL."
+  (format #f  "~a/search/latest?~a"
+          ci-url (build-query job system #:spec spec)))
+
+(define (build-product-download-url job spec system type)
+  "Return a download URL for BUILD-PRODUCT hosted on CI server at URL."
+  (format #f  "~a/search/latest/~a?~a"
+          ci-url type (build-query job system #:spec spec)))
+
 (define images
   (list (make-image
          (C_ "download page title" "GNU Guix System on Linux")
          (G_ "USB/DVD ISO installer of the standalone Guix System on Linux.")
          (guix-url "static/base/img/GuixSD-package.png")
          "image.iso"
+         images-spec
          (list default-system)
          (list default-system)
          "ISO-9660")
@@ -59,6 +78,7 @@
          (G_ "Virtual machine image of the standalone Guix System on GNU 
Hurd.")
          (guix-url "static/base/img/hurd.png")
          "hurd-barebones.qcow2"
+         images-spec
          (list "qcow2")
          (list default-system)
          "image")
@@ -68,28 +88,17 @@
        dependencies, to be installed on top of your Linux-based system.")
          (guix-url "static/base/img/Guix-package.png")
          "guix-binary.tar.xz"
+         tarball-spec
          (list default-system)
          (list default-system)
          "archive")))
 
-(define (build-query job system)
-  (format #f "query=spec:~a+status:success+system:~a+~a"
-          default-spec system job))
-
-(define (build-detail-url job system)
-  "Return the detail page for BUILD hosted on CI server at URL."
-  (format #f  "~a/search/latest?~a" ci-url (build-query job system)))
-
-(define (build-product-download-url job system type)
-  "Return a download URL for BUILD-PRODUCT hosted on CI server at URL."
-  (format #f  "~a/search/latest/~a?~a"
-          ci-url type (build-query job system)))
-
 (define (image-download image)
   "Return as an HTML table row, the representation of IMAGE."
   (let* ((title (image-title image))
          (description (image-description image))
          (job (image-job image))
+         (spec (image-spec image))
          (labels (image-labels image))
          (systems (image-systems image))
          (type (image-type image))
@@ -104,7 +113,8 @@
                `(a
                  (@ (class "download-btn")
                     (download "")
-                    (href ,(build-product-download-url job system type)))
+                    (href
+                     ,(build-product-download-url job spec system type)))
                  ,label
                  " ")) ; Force a space for readability in non-CSS browsers.
              systems labels)
@@ -114,9 +124,11 @@
                      `(a
                        (@ (class "detail-btn")
                           (download "")
-                          (href ,(build-detail-url job system)))
+                          (href
+                           ,(build-detail-url job spec system)))
                        ,label
-                       " ")) ; Force a space for readability in non-CSS 
browsers.
+                       " ")) ; Force a space for readability in non-CSS
+                             ; browsers.
                    systems labels))))))
 
 (define (download-latest-t)
@@ -135,8 +147,9 @@ Package manager") #\|)
    #:css (list
           (guix-url "static/base/css/page.css")
           (guix-url "static/base/css/download.css"))
-   #:crumbs (list (crumb (C_ "website menu" "Download") (guix-url "download/"))
-                  (crumb (C_ "website menu" "Latest") "./"))
+   #:crumbs
+   (list (crumb (C_ "website menu" "Download") (guix-url "download/"))
+         (crumb (C_ "website menu" "Latest") "./"))
    #:content
    `(main
      (section
@@ -148,7 +161,8 @@ Package manager") #\|)
         `(p
           (@ (class "centered-block limit-width"))
           "Download latest GNU Guix System images built by the "
-          ,(G_ (manual-href "Cuirass"  (G_ "en") (G_ 
"Continuous-Integration.html")))
+          ,(G_ (manual-href "Cuirass"  (G_ "en")
+                            (G_ "Continuous-Integration.html")))
           " continuous integration system at "
           (a (@ (href ,ci-url)) "ci.guix.gnu.org")
           ". These images are " ,(G_ `(b "development snapshots"))