1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
| | ;;; GNU Guix web site
;;; Initially written by sirgazil who waives all
;;; copyright interest on this file.
;;;
;;; This file is part of the GNU Guix web site.
;;;
;;; The GNU Guix web site is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; The GNU Guix web site is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public License
;;; along with the GNU Guix web site. If not, see <http://www.gnu.org/licenses/>.
(define-module (apps download templates download-latest)
#:use-module (apps base templates theme)
#:use-module (apps base types)
#:use-module (apps base utils)
#:use-module (apps download templates components)
#:use-module (guix ci)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:export (download-latest-t))
(define ci-url "https://ci.guix.gnu.org")
(define-record-type <image>
(make-image description logo job type)
image?
(description image-description) ;string
(logo image-logo) ;string
(job image-job) ;string
(type image-type)) ;string
(define images
(list (make-image
"GNU Guix System ISO-9660 image for x86_64"
(guix-url "static/base/img/GuixSD-package.png")
"iso9660-image.x86_64-linux"
"ISO-9660")))
(define (build-detail-url url build)
"Return the detail page for BUILD hosted on CI server at URL."
(format #f "~a/build/~a/details" url (build-id build)))
(define (build-product-download-url url build-product)
"Return a download URL for BUILD-PRODUCT hosted on CI server at URL."
(string-append url "/download/" (number->string
(build-product-id build-product))))
(define* (products-latest-urls job type
#:optional (limit 15)
#:key url)
"Fetch the latest LIMIT jobs from URL matching the given JOB. Then, for the
first job with a build output of the given TYPE, return '(DETAIL-URL
. DOWNLOAD-URL), where DETAIL-URL is the URL describing the matching build in
the CI, and DOWNLOAD-URL is the URL to download the build output. If no
matching jobs are found, return an empty list."
;; See build-status enumeration in (cuirass database).
(define build-status-success 0)
(define (find-product-by-type build-products type)
(find (lambda (build-product)
(string=? (build-product-type build-product) type))
build-products))
(define (latest-build-products)
(let ((builds
(latest-builds url limit
#:job job
#:status build-status-success)))
(filter-map
(lambda (build)
(let ((products (build-products build)))
(match products
(() #f)
(x (let ((product
(find-product-by-type products type)))
(and product
(cons build product)))))))
builds)))
(match (latest-build-products)
(((build . product) . rest)
(cons
(build-detail-url url build)
(build-product-download-url url product)))
(_ '())))
(define (image-table-row image)
"Return as an HTML table row, the representation of IMAGE."
(let* ((description (image-description image))
(job (image-job image))
(type (image-type image))
(logo (image-logo image))
(urls (products-latest-urls job type #:url ci-url)))
`(tr
(td
(table
(@ (class "download-table-box"))
(tbody
(tr
(td
(@ (class "download-table-box"))
(img (@ (src ,logo) (alt ""))))
(td
(@ (class "download-table-box"))
(h3 ,description))))))
,(if (null? urls)
'(td "No available image")
(match urls
((detail-url . download-url)
`(td
(a (@ (href ,download-url)) "Download")
" "
(a (@ (href ,detail-url)) "(details)"))))))))
(define (download-latest-t)
"Return the Download latest page in SHTML."
(theme
#:title '("Download latest")
#:description
"Download latest GNU Guix System images built by the Cuirass continuous
integration system."
#:keywords
'("GNU" "Linux" "Unix" "Free software" "Libre software"
"Operating system" "GNU Hurd" "GNU Guix package manager"
"Installer" "Source code" "Package manager")
#:active-menu-item "Download"
#:css (list
(guix-url "static/base/css/page.css")
(guix-url "static/base/css/download.css"))
#:crumbs (list (crumb "Download" (guix-url "download/"))
(crumb "Latest" "./"))
#:content
`(main
(section
(@ (class "page"))
(h2 "Download latest images")
(p
(@ (class "centered-block limit-width"))
"Download latest GNU Guix System images built by the "
(a (@ (href ,(manual-url "Continuous-Integration.html"))) "Cuirass")
" continuous integration system at "
(a (@ (href ci-url)) "ci.guix.gnu.org")
".")
(div
(@ (class "centered-block limit-width table-box"))
(table
(thread
(tr (th "image")
(th "download")))
(tbody
,(map image-table-row images))))))))
|