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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
;;; GNU Guix web site
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
;;;
;;; 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 packages builder)
#:use-module (apps aux lists)
#:use-module (apps aux system)
#:use-module (apps base utils)
#:use-module (apps packages data)
#:use-module (apps packages templates detailed-index)
#:use-module (apps packages templates index)
#:use-module (apps packages templates detailed-package-list)
#:use-module (apps packages templates package)
#:use-module (apps packages templates package-list)
#:use-module (apps packages types)
#:use-module (apps packages utils)
#:use-module (haunt html)
#:use-module (haunt page)
#:use-module (haunt utils)
#:use-module (srfi srfi-1)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix svn-download)
#:use-module (json)
#:use-module (ice-9 match)
#:export (builder))
;;;
;;; Application builder.
;;;
(define (builder site posts)
"Return the list of web resources that compose the app.
This procedure is a Haunt builder procedure.
SITE (<site>)
A site object that defines all the properties of the website. See
Haunt <site> objects for more information.
POSTS (list of <post>)
A list of post objects that represent articles from the blog. See
Haunt <post> objects for more information.
RETURN (list of <page>)
A list of page objects that represent the web resources of the
application. See Haunt <page> objects for more information."
(flatten
(list
(index-builder)
(packages-json-builder)
(packages-builder)
(package-list-builder))))
;;;
;;; Helper builders.
;;;
(define %max-packages-on-index
;; Maximum number of packages shown on /packages.
30)
(define (packages-json-builder)
"Return a JSON page listing all packages."
(define (origin->json origin)
(define method
(origin-method origin))
`((type . ,(cond ((eq? url-fetch method) 'url)
((eq? git-fetch method) 'git)
((eq? svn-fetch method) 'svn)
(else #nil)))
,@(cond ((eq? url-fetch method)
`(("url" . ,(match (origin-uri origin)
((? string? url) (vector url))
((urls ...) (list->vector urls))))))
((eq? git-fetch method)
`(("git_url" . ,(git-reference-url (origin-uri origin)))))
((eq? svn-fetch method)
`(("svn_url" . ,(svn-reference-url (origin-uri origin)))))
(else '()))
,@(if (eq? method git-fetch)
`(("git_ref" . ,(git-reference-commit (origin-uri origin))))
'())
,@(if (eq? method svn-fetch)
`(("svn_revision" . ,(svn-reference-revision
(origin-uri origin))))
'())))
(define (package->json package)
(define cpe-name
(assoc-ref (package-properties package) 'cpe-name))
(define cpe-version
(assoc-ref (package-properties package) 'cpe-version))
`(("name" . ,(package-name package))
("version" . ,(package-version package))
,@(if cpe-name `(("cpe_name" . ,cpe-name)) '())
,@(if cpe-version `(("cpe_version" . ,cpe-version)) '())
,@(if (origin? (package-source package))
`(("source" . ,(origin->json (package-source package))))
'())
("synopsis" . ,(package-synopsis package))
("homepage" . ,(package-home-page package))))
(make-page "packages.json"
(list->vector (map package->json (all-packages)))
(lambda args
(apply scm->json (append args '(#:pretty #t))))))
(define (index-builder)
"Return a Haunt page listing some random packages."
(define (sample n from)
(map (lambda (id) (list-ref from id))
(list-tabulate n (lambda _ (random (length from))))))
(let ((context (list (cons "packages"
(sample %max-packages-on-index
(all-packages)))
(cons "total"
(length (all-packages))))))
(make-page "packages/index.html" (index-t context) sxml->html)))
(define (detailed-index-builder)
"Return a Haunt page listing some random packages."
;; TODO: Pass ~30 random Guix packages.
(let ((context (list (cons "packages"
(take-at-most (all-packages)
%max-packages-on-index)))))
(make-page "packages/index.html"
(detailed-index-t context (length (all-packages)))
sxml->html)))
(define (detailed-package-list-builder)
"Return a list of grouped Haunt pages listing Guix packages.
Each group is a list of page objects corresponding to paginated
packages starting with a specific letter."
(let ((package-groups (packages/group-by-letter (all-packages))))
(map
(lambda (package-group)
(let* ((letter (car package-group))
(context
(list
(cons "letter" letter))))
(paginate #:dataset (cdr package-group)
#:limit 100
#:base-path (path-join "packages" letter)
#:template detailed-package-list-t
#:context context
#:writer sxml->html)))
package-groups)))
(define (packages-builder)
"Return a list of Haunt pages for each Guix package."
(map
(lambda (package)
(let ((context (list (cons "package" package))))
(make-page
(path-join (package-url-path package) "index.html")
(package-t context)
sxml->html)))
(all-packages)))
(define (package-list-builder)
"Return a list of grouped Haunt pages listing Guix packages.
Each group is a list of page objects corresponding to paginated
packages starting with a specific letter."
(let ((package-groups (packages/group-by-letter (all-packages))))
(map
(lambda (package-group)
(let* ((letter (car package-group))
(context
(list
(cons "letter" letter))))
(paginate #:dataset (cdr package-group)
#:limit 100
#:base-path (path-join "packages" letter)
#:template package-list-t
#:context context
#:writer sxml->html)))
package-groups)))
|
