Commit | Line | Data |
---|---|---|
32950fc8 AK |
1 | ;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*- |
2 | ||
3 | ;; Copyright © 2015 Alex Kost <alezost@gmail.com> | |
4 | ||
5 | ;; This file is part of GNU Guix. | |
6 | ||
7 | ;; GNU Guix is free software; you can redistribute it and/or modify | |
8 | ;; it under the terms of the GNU General Public License as published by | |
9 | ;; the Free Software Foundation, either version 3 of the License, or | |
10 | ;; (at your option) any later version. | |
11 | ||
12 | ;; GNU Guix is distributed in the hope that it will be useful, | |
13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;; GNU General Public License for more details. | |
16 | ||
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;; This file provides an interface for displaying Hydra builds in | |
23 | ;; 'list' and 'info' buffers. | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'cl-lib) | |
28 | (require 'guix-buffer) | |
29 | (require 'guix-list) | |
30 | (require 'guix-info) | |
31 | (require 'guix-hydra) | |
32 | (require 'guix-build-log) | |
33 | (require 'guix-utils) | |
34 | ||
35 | (guix-hydra-define-entry-type hydra-build | |
36 | :search-types '((latest . guix-hydra-build-latest-api-url) | |
37 | (queue . guix-hydra-build-queue-api-url)) | |
38 | :filters '(guix-hydra-build-filter-status) | |
39 | :filter-names '((nixname . name) | |
40 | (buildstatus . build-status) | |
41 | (timestamp . time)) | |
42 | :filter-boolean-params '(finished busy)) | |
43 | ||
44 | (defun guix-hydra-build-get-display (search-type &rest args) | |
45 | "Search for Hydra builds and show results." | |
46 | (apply #'guix-list-get-display-entries | |
47 | 'hydra-build search-type args)) | |
48 | ||
49 | (cl-defun guix-hydra-build-latest-prompt-args (&key project jobset | |
50 | job system) | |
51 | "Prompt for and return a list of 'latest builds' arguments." | |
52 | (let* ((number (read-number "Number of latest builds: ")) | |
53 | (project (if current-prefix-arg | |
54 | (guix-hydra-read-project nil project) | |
55 | project)) | |
56 | (jobset (if current-prefix-arg | |
57 | (guix-hydra-read-jobset nil jobset) | |
58 | jobset)) | |
59 | (job-or-name (if current-prefix-arg | |
60 | (guix-hydra-read-job nil job) | |
61 | job)) | |
62 | (job (and job-or-name | |
63 | (string-match-p guix-hydra-job-regexp | |
64 | job-or-name) | |
65 | job-or-name)) | |
66 | (system (if (and (not job) | |
67 | (or current-prefix-arg | |
68 | (and job-or-name (not system)))) | |
69 | (if job-or-name | |
70 | (guix-while-null | |
71 | (guix-hydra-read-system | |
72 | (concat job-or-name ".") system)) | |
73 | (guix-hydra-read-system nil system)) | |
74 | system)) | |
75 | (job (or job | |
76 | (and job-or-name | |
77 | (concat job-or-name "." system))))) | |
78 | (list number | |
79 | :project project | |
80 | :jobset jobset | |
81 | :job job | |
82 | :system system))) | |
83 | ||
84 | (defun guix-hydra-build-view-log (id) | |
85 | "View build log of a hydra build ID." | |
86 | (guix-build-log-find-file (guix-hydra-build-log-url id))) | |
87 | ||
88 | \f | |
89 | ;;; Defining URLs | |
90 | ||
91 | (defun guix-hydra-build-url (id) | |
92 | "Return Hydra URL of a build ID." | |
93 | (guix-hydra-url "build/" (number-to-string id))) | |
94 | ||
95 | (defun guix-hydra-build-log-url (id) | |
96 | "Return Hydra URL of the log file of a build ID." | |
97 | (concat (guix-hydra-build-url id) "/log/raw")) | |
98 | ||
99 | (cl-defun guix-hydra-build-latest-api-url | |
100 | (number &key project jobset job system) | |
101 | "Return Hydra API URL to receive latest NUMBER of builds." | |
102 | (guix-hydra-api-url "latestbuilds" | |
103 | `(("nr" . ,number) | |
104 | ("project" . ,project) | |
105 | ("jobset" . ,jobset) | |
106 | ("job" . ,job) | |
107 | ("system" . ,system)))) | |
108 | ||
109 | (defun guix-hydra-build-queue-api-url (number) | |
110 | "Return Hydra API URL to receive the NUMBER of queued builds." | |
111 | (guix-hydra-api-url "queue" | |
112 | `(("nr" . ,number)))) | |
113 | ||
114 | \f | |
115 | ;;; Filters for processing raw entries | |
116 | ||
117 | (defun guix-hydra-build-filter-status (entry) | |
118 | "Add 'status' parameter to 'hydra-build' ENTRY." | |
119 | (let ((status (if (guix-entry-value entry 'finished) | |
120 | (guix-hydra-build-status-number->name | |
121 | (guix-entry-value entry 'build-status)) | |
122 | (if (guix-entry-value entry 'busy) | |
123 | 'running | |
124 | 'scheduled)))) | |
125 | (cons `(status . ,status) | |
126 | entry))) | |
127 | ||
128 | \f | |
129 | ;;; Build status | |
130 | ||
131 | (defface guix-hydra-build-status-running | |
132 | '((t :inherit bold)) | |
133 | "Face used if hydra build is not finished." | |
134 | :group 'guix-hydra-build-faces) | |
135 | ||
136 | (defface guix-hydra-build-status-scheduled | |
137 | '((t)) | |
138 | "Face used if hydra build is scheduled." | |
139 | :group 'guix-hydra-build-faces) | |
140 | ||
141 | (defface guix-hydra-build-status-succeeded | |
142 | '((t :inherit success)) | |
143 | "Face used if hydra build succeeded." | |
144 | :group 'guix-hydra-build-faces) | |
145 | ||
146 | (defface guix-hydra-build-status-cancelled | |
147 | '((t :inherit warning)) | |
148 | "Face used if hydra build was cancelled." | |
149 | :group 'guix-hydra-build-faces) | |
150 | ||
151 | (defface guix-hydra-build-status-failed | |
152 | '((t :inherit error)) | |
153 | "Face used if hydra build failed." | |
154 | :group 'guix-hydra-build-faces) | |
155 | ||
156 | (defvar guix-hydra-build-status-alist | |
157 | '((0 . succeeded) | |
158 | (1 . failed-build) | |
159 | (2 . failed-dependency) | |
160 | (3 . failed-other) | |
161 | (4 . cancelled)) | |
162 | "Alist of hydra build status numbers and status names. | |
163 | Status numbers are returned by Hydra API, names (symbols) are | |
164 | used internally by the elisp code of this package.") | |
165 | ||
166 | (defun guix-hydra-build-status-number->name (number) | |
167 | "Convert build status number to a name. | |
168 | See `guix-hydra-build-status-alist'." | |
169 | (guix-assq-value guix-hydra-build-status-alist number)) | |
170 | ||
171 | (defun guix-hydra-build-status-string (status) | |
172 | "Return a human readable string for build STATUS." | |
173 | (cl-case status | |
174 | (scheduled | |
175 | (guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled)) | |
176 | (running | |
177 | (guix-get-string "Running" 'guix-hydra-build-status-running)) | |
178 | (succeeded | |
179 | (guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded)) | |
180 | (cancelled | |
181 | (guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled)) | |
182 | (failed-build | |
183 | (guix-hydra-build-status-fail-string)) | |
184 | (failed-dependency | |
185 | (guix-hydra-build-status-fail-string "dependency")) | |
186 | (failed-other | |
187 | (guix-hydra-build-status-fail-string "other")))) | |
188 | ||
189 | (defun guix-hydra-build-status-fail-string (&optional reason) | |
190 | "Return a string for a failed build." | |
191 | (let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed))) | |
192 | (if reason | |
193 | (concat base " (" reason ")") | |
194 | base))) | |
195 | ||
196 | (defun guix-hydra-build-finished? (entry) | |
197 | "Return non-nil, if hydra build was finished." | |
198 | (guix-entry-value entry 'finished)) | |
199 | ||
200 | (defun guix-hydra-build-running? (entry) | |
201 | "Return non-nil, if hydra build is running." | |
202 | (eq (guix-entry-value entry 'status) | |
203 | 'running)) | |
204 | ||
205 | (defun guix-hydra-build-scheduled? (entry) | |
206 | "Return non-nil, if hydra build is scheduled." | |
207 | (eq (guix-entry-value entry 'status) | |
208 | 'scheduled)) | |
209 | ||
210 | (defun guix-hydra-build-succeeded? (entry) | |
211 | "Return non-nil, if hydra build succeeded." | |
212 | (eq (guix-entry-value entry 'status) | |
213 | 'succeeded)) | |
214 | ||
215 | (defun guix-hydra-build-cancelled? (entry) | |
216 | "Return non-nil, if hydra build was cancelled." | |
217 | (eq (guix-entry-value entry 'status) | |
218 | 'cancelled)) | |
219 | ||
220 | (defun guix-hydra-build-failed? (entry) | |
221 | "Return non-nil, if hydra build failed." | |
222 | (memq (guix-entry-value entry 'status) | |
223 | '(failed-build failed-dependency failed-other))) | |
224 | ||
225 | \f | |
226 | ;;; Hydra build 'info' | |
227 | ||
228 | (guix-hydra-info-define-interface hydra-build | |
229 | :mode-name "Hydra-Build-Info" | |
230 | :buffer-name "*Guix Hydra Build Info*" | |
231 | :format '((name ignore (simple guix-info-heading)) | |
232 | ignore | |
233 | guix-hydra-build-info-insert-url | |
234 | (time format (time)) | |
235 | (status format guix-hydra-build-info-insert-status) | |
236 | (project format (format guix-hydra-build-project)) | |
237 | (jobset format (format guix-hydra-build-jobset)) | |
238 | (job format (format guix-hydra-build-job)) | |
239 | (system format (format guix-hydra-build-system)) | |
240 | (priority format (format)))) | |
241 | ||
242 | (defface guix-hydra-build-info-project | |
243 | '((t :inherit link)) | |
244 | "Face for project names." | |
245 | :group 'guix-hydra-build-info-faces) | |
246 | ||
247 | (defface guix-hydra-build-info-jobset | |
248 | '((t :inherit link)) | |
249 | "Face for jobsets." | |
250 | :group 'guix-hydra-build-info-faces) | |
251 | ||
252 | (defface guix-hydra-build-info-job | |
253 | '((t :inherit link)) | |
254 | "Face for jobs." | |
255 | :group 'guix-hydra-build-info-faces) | |
256 | ||
257 | (defface guix-hydra-build-info-system | |
258 | '((t :inherit link)) | |
259 | "Face for system names." | |
260 | :group 'guix-hydra-build-info-faces) | |
261 | ||
262 | (defmacro guix-hydra-build-define-button (name) | |
263 | "Define `guix-hydra-build-NAME' button." | |
264 | (let* ((name-str (symbol-name name)) | |
265 | (button-name (intern (concat "guix-hydra-build-" name-str))) | |
266 | (face-name (intern (concat "guix-hydra-build-info-" name-str))) | |
267 | (keyword (intern (concat ":" name-str)))) | |
268 | `(define-button-type ',button-name | |
269 | :supertype 'guix | |
270 | 'face ',face-name | |
271 | 'help-echo ,(format "\ | |
272 | Show latest builds for this %s (with prefix, prompt for all parameters)" | |
273 | name-str) | |
274 | 'action (lambda (btn) | |
275 | (let ((args (guix-hydra-build-latest-prompt-args | |
276 | ,keyword (button-label btn)))) | |
277 | (apply #'guix-hydra-build-get-display | |
278 | 'latest args)))))) | |
279 | ||
280 | (guix-hydra-build-define-button project) | |
281 | (guix-hydra-build-define-button jobset) | |
282 | (guix-hydra-build-define-button job) | |
283 | (guix-hydra-build-define-button system) | |
284 | ||
285 | (defun guix-hydra-build-info-insert-url (entry) | |
286 | "Insert Hydra URL for the build ENTRY." | |
287 | (guix-insert-button (guix-hydra-build-url (guix-entry-id entry)) | |
288 | 'guix-url) | |
289 | (when (guix-hydra-build-finished? entry) | |
290 | (guix-info-insert-indent) | |
291 | (guix-info-insert-action-button | |
292 | "Build log" | |
293 | (lambda (btn) | |
294 | (guix-hydra-build-view-log (button-get btn 'id))) | |
295 | "View build log" | |
296 | 'id (guix-entry-id entry)))) | |
297 | ||
298 | (defun guix-hydra-build-info-insert-status (status &optional _) | |
299 | "Insert a string with build STATUS." | |
300 | (insert (guix-hydra-build-status-string status))) | |
301 | ||
302 | \f | |
303 | ;;; Hydra build 'list' | |
304 | ||
305 | (guix-hydra-list-define-interface hydra-build | |
306 | :mode-name "Hydra-Build-List" | |
307 | :buffer-name "*Guix Hydra Build List*" | |
308 | :format '((name nil 30 t) | |
309 | (system nil 16 t) | |
310 | (status guix-hydra-build-list-get-status 20 t) | |
311 | (project nil 10 t) | |
312 | (jobset nil 17 t) | |
313 | (time guix-list-get-time 20 t))) | |
314 | ||
315 | (let ((map guix-hydra-build-list-mode-map)) | |
316 | (define-key map (kbd "B") 'guix-hydra-build-list-latest-builds) | |
317 | (define-key map (kbd "L") 'guix-hydra-build-list-view-log)) | |
318 | ||
319 | (defun guix-hydra-build-list-get-status (status &optional _) | |
320 | "Return a string for build STATUS." | |
321 | (guix-hydra-build-status-string status)) | |
322 | ||
323 | (defun guix-hydra-build-list-latest-builds (number &rest args) | |
324 | "Display latest NUMBER of Hydra builds of the current job. | |
325 | Interactively, prompt for NUMBER. With prefix argument, prompt | |
326 | for all ARGS." | |
327 | (interactive | |
328 | (let ((entry (guix-list-current-entry))) | |
329 | (guix-hydra-build-latest-prompt-args | |
330 | :project (guix-entry-value entry 'project) | |
331 | :jobset (guix-entry-value entry 'name) | |
332 | :job (guix-entry-value entry 'job) | |
333 | :system (guix-entry-value entry 'system)))) | |
334 | (apply #'guix-hydra-latest-builds number args)) | |
335 | ||
336 | (defun guix-hydra-build-list-view-log () | |
337 | "View build log of the current Hydra build." | |
338 | (interactive) | |
339 | (guix-hydra-build-view-log (guix-list-current-id))) | |
340 | ||
341 | \f | |
342 | ;;; Interactive commands | |
343 | ||
344 | ;;;###autoload | |
345 | (defun guix-hydra-latest-builds (number &rest args) | |
346 | "Display latest NUMBER of Hydra builds. | |
347 | ARGS are the same arguments as for `guix-hydra-build-latest-api-url'. | |
348 | Interactively, prompt for NUMBER. With prefix argument, prompt | |
349 | for all ARGS." | |
350 | (interactive (guix-hydra-build-latest-prompt-args)) | |
351 | (apply #'guix-hydra-build-get-display | |
352 | 'latest number args)) | |
353 | ||
354 | ;;;###autoload | |
355 | (defun guix-hydra-queued-builds (number) | |
356 | "Display the NUMBER of queued Hydra builds." | |
357 | (interactive "NNumber of queued builds: ") | |
358 | (guix-hydra-build-get-display 'queue number)) | |
359 | ||
360 | (provide 'guix-hydra-build) | |
361 | ||
362 | ;;; guix-hydra-build.el ends here |