Commit | Line | Data |
---|---|---|
32950fc8 AK |
1 | ;;; guix-hydra.el --- Common code for interacting with Hydra -*- 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 some general code for 'list'/'info' interfaces for | |
23 | ;; Hydra (Guix build farm). | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'json) | |
28 | (require 'guix-buffer) | |
29 | (require 'guix-entry) | |
30 | (require 'guix-utils) | |
31 | (require 'guix-help-vars) | |
32 | ||
33 | (guix-define-groups hydra) | |
34 | ||
35 | (defvar guix-hydra-job-regexp | |
36 | (concat ".*\\." (regexp-opt guix-help-system-types) "\\'") | |
37 | "Regexp matching a full name of Hydra job (including system).") | |
38 | ||
b8fa5a2a AK |
39 | (defun guix-hydra-job-name-specification (name version) |
40 | "Return Hydra's job name specification by NAME and VERSION." | |
41 | (concat name "-" version)) | |
42 | ||
32950fc8 AK |
43 | (defun guix-hydra-message (entries search-type &rest _) |
44 | "Display a message after showing Hydra ENTRIES." | |
45 | ;; XXX Add more messages maybe. | |
46 | (when (null entries) | |
47 | (if (eq search-type 'fake) | |
48 | (message "The update is impossible due to lack of Hydra API.") | |
49 | (message "Hydra has returned no results.")))) | |
50 | ||
51 | (defun guix-hydra-list-describe (ids) | |
52 | "Describe 'hydra' entries with IDS (list of identifiers)." | |
53 | (guix-buffer-display-entries | |
54 | (guix-entries-by-ids ids (guix-buffer-current-entries)) | |
55 | 'info (guix-buffer-current-entry-type) | |
56 | ;; Hydra does not provide an API to receive builds/jobsets by | |
57 | ;; IDs/names, so we use a 'fake' search type. | |
58 | '(fake) | |
59 | 'add)) | |
60 | ||
61 | \f | |
62 | ;;; Readers | |
63 | ||
64 | (defvar guix-hydra-projects | |
65 | '("gnu" "guix") | |
66 | "List of available Hydra projects.") | |
67 | ||
68 | (guix-define-readers | |
69 | :completions-var guix-hydra-projects | |
70 | :single-reader guix-hydra-read-project | |
71 | :single-prompt "Project: ") | |
72 | ||
73 | (guix-define-readers | |
74 | :single-reader guix-hydra-read-jobset | |
75 | :single-prompt "Jobset: ") | |
76 | ||
77 | (guix-define-readers | |
78 | :single-reader guix-hydra-read-job | |
79 | :single-prompt "Job: ") | |
80 | ||
81 | (guix-define-readers | |
82 | :completions-var guix-help-system-types | |
83 | :single-reader guix-hydra-read-system | |
84 | :single-prompt "System: ") | |
85 | ||
86 | \f | |
87 | ;;; Defining URLs | |
88 | ||
89 | (defvar guix-hydra-url "http://hydra.gnu.org" | |
90 | "URL of the Hydra build farm.") | |
91 | ||
92 | (defun guix-hydra-url (&rest url-parts) | |
93 | "Return Hydra URL." | |
94 | (apply #'concat guix-hydra-url "/" url-parts)) | |
95 | ||
96 | (defun guix-hydra-api-url (type args) | |
97 | "Return URL for receiving data using Hydra API. | |
98 | TYPE is the name of an allowed method. | |
99 | ARGS is alist of (KEY . VALUE) pairs. | |
100 | Skip ARG, if VALUE is nil or an empty string." | |
101 | (declare (indent 1)) | |
102 | (let* ((fields (mapcar | |
103 | (lambda (arg) | |
104 | (pcase arg | |
105 | (`(,key . ,value) | |
106 | (unless (or (null value) | |
107 | (equal "" value)) | |
108 | (concat (guix-hexify key) "=" | |
109 | (guix-hexify value)))) | |
110 | (_ (error "Wrong argument '%s'" arg)))) | |
111 | args)) | |
112 | (fields (mapconcat #'identity (delq nil fields) "&"))) | |
113 | (guix-hydra-url "api/" type "?" fields))) | |
114 | ||
115 | \f | |
116 | ;;; Receiving data from Hydra | |
117 | ||
118 | (defun guix-hydra-receive-data (url) | |
119 | "Return output received from URL and processed with `json-read'." | |
120 | (with-temp-buffer | |
121 | (url-insert-file-contents url) | |
122 | (goto-char (point-min)) | |
123 | (let ((json-key-type 'symbol) | |
124 | (json-array-type 'list) | |
125 | (json-object-type 'alist)) | |
126 | (json-read)))) | |
127 | ||
128 | (defun guix-hydra-get-entries (entry-type search-type &rest args) | |
129 | "Receive ENTRY-TYPE entries from Hydra. | |
130 | SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'." | |
131 | (unless (eq search-type 'fake) | |
132 | (let* ((url (apply #'guix-hydra-search-url | |
133 | entry-type search-type args)) | |
134 | (raw-entries (guix-hydra-receive-data url)) | |
135 | (entries (guix-hydra-filter-entries | |
136 | raw-entries | |
137 | (guix-hydra-filters entry-type)))) | |
138 | entries))) | |
139 | ||
140 | \f | |
141 | ;;; Filters for processing raw entries | |
142 | ||
143 | (defun guix-hydra-filter-entries (entries filters) | |
144 | "Filter ENTRIES using FILTERS. | |
145 | Call `guix-modify' on each entry from ENTRIES." | |
146 | (mapcar (lambda (entry) | |
147 | (guix-modify entry filters)) | |
148 | entries)) | |
149 | ||
150 | (defun guix-hydra-filter-names (entry name-alist) | |
151 | "Replace names of ENTRY parameters using NAME-ALIST. | |
152 | Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair." | |
153 | (mapcar (lambda (param) | |
154 | (pcase param | |
155 | (`(,name . ,val) | |
156 | (let ((new-name (guix-assq-value name-alist name))) | |
157 | (if new-name | |
158 | (cons new-name val) | |
159 | param))))) | |
160 | entry)) | |
161 | ||
162 | (defun guix-hydra-filter-boolean (entry params) | |
163 | "Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)." | |
164 | (mapcar (lambda (param) | |
165 | (pcase param | |
166 | (`(,name . ,val) | |
167 | (if (memq name params) | |
168 | (cons name (guix-number->bool val)) | |
169 | param)))) | |
170 | entry)) | |
171 | ||
172 | \f | |
173 | ;;; Wrappers for defined variables | |
174 | ||
175 | (defvar guix-hydra-entry-type-data nil | |
176 | "Alist with hydra entry type data. | |
177 | This alist is filled by `guix-hydra-define-entry-type' macro.") | |
178 | ||
179 | (defun guix-hydra-entry-type-value (entry-type symbol) | |
180 | "Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'." | |
181 | (symbol-value (guix-assq-value guix-hydra-entry-type-data | |
182 | entry-type symbol))) | |
183 | ||
184 | (defun guix-hydra-search-url (entry-type search-type &rest args) | |
185 | "Return URL to receive ENTRY-TYPE entries from Hydra." | |
186 | (apply (guix-assq-value (guix-hydra-entry-type-value | |
187 | entry-type 'search-types) | |
188 | search-type) | |
189 | args)) | |
190 | ||
191 | (defun guix-hydra-filters (entry-type) | |
192 | "Return a list of filters for ENTRY-TYPE." | |
193 | (guix-hydra-entry-type-value entry-type 'filters)) | |
194 | ||
195 | \f | |
196 | ;;; Interface definers | |
197 | ||
198 | (defmacro guix-hydra-define-entry-type (entry-type &rest args) | |
199 | "Define general code for ENTRY-TYPE. | |
200 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
201 | ||
202 | Required keywords: | |
203 | ||
204 | - `:search-types' - default value of the generated | |
205 | `guix-ENTRY-TYPE-search-types' variable. | |
206 | ||
207 | Optional keywords: | |
208 | ||
209 | - `:filters' - default value of the generated | |
210 | `guix-ENTRY-TYPE-filters' variable. | |
211 | ||
212 | - `:filter-names' - if specified, a generated | |
213 | `guix-ENTRY-TYPE-filter-names' function for filtering these | |
214 | names will be added to `guix-ENTRY-TYPE-filters' variable. | |
215 | ||
216 | - `:filter-boolean-params' - if specified, a generated | |
217 | `guix-ENTRY-TYPE-filter-boolean' function for filtering these | |
218 | names will be added to `guix-ENTRY-TYPE-filters' variable. | |
219 | ||
220 | The rest keyword arguments are passed to | |
221 | `guix-define-entry-type' macro." | |
222 | (declare (indent 1)) | |
223 | (let* ((entry-type-str (symbol-name entry-type)) | |
224 | (prefix (concat "guix-" entry-type-str)) | |
225 | (search-types-var (intern (concat prefix "-search-types"))) | |
226 | (filters-var (intern (concat prefix "-filters"))) | |
227 | (get-fun (intern (concat prefix "-get-entries")))) | |
228 | (guix-keyword-args-let args | |
229 | ((search-types-val :search-types) | |
230 | (filters-val :filters) | |
231 | (filter-names-val :filter-names) | |
232 | (filter-bool-val :filter-boolean-params)) | |
233 | `(progn | |
234 | (defvar ,search-types-var ,search-types-val | |
235 | ,(format "\ | |
236 | Alist of search types and according URL functions. | |
237 | Functions are used to define URL to receive '%s' entries." | |
238 | entry-type-str)) | |
239 | ||
240 | (defvar ,filters-var ,filters-val | |
241 | ,(format "\ | |
242 | List of filters for '%s' parameters. | |
243 | Each filter is a function that should take an entry as a single | |
244 | argument, and should also return an entry." | |
245 | entry-type-str)) | |
246 | ||
247 | ,(when filter-bool-val | |
248 | (let ((filter-bool-var (intern (concat prefix | |
249 | "-filter-boolean-params"))) | |
250 | (filter-bool-fun (intern (concat prefix | |
251 | "-filter-boolean")))) | |
252 | `(progn | |
253 | (defvar ,filter-bool-var ,filter-bool-val | |
254 | ,(format "\ | |
255 | List of '%s' parameters that should be transformed to boolean values." | |
256 | entry-type-str)) | |
257 | ||
258 | (defun ,filter-bool-fun (entry) | |
259 | ,(format "\ | |
260 | Run `guix-hydra-filter-boolean' with `%S' variable." | |
261 | filter-bool-var) | |
262 | (guix-hydra-filter-boolean entry ,filter-bool-var)) | |
263 | ||
264 | (setq ,filters-var | |
265 | (cons ',filter-bool-fun ,filters-var))))) | |
266 | ||
267 | ;; Do not move this clause up!: name filtering should be | |
268 | ;; performed before any other filtering, so this filter should | |
269 | ;; be consed after the boolean filter. | |
270 | ,(when filter-names-val | |
271 | (let* ((filter-names-var (intern (concat prefix | |
272 | "-filter-names"))) | |
273 | (filter-names-fun filter-names-var)) | |
274 | `(progn | |
275 | (defvar ,filter-names-var ,filter-names-val | |
276 | ,(format "\ | |
277 | Alist of '%s' parameter names returned by Hydra API and names | |
278 | used internally by the elisp code of this package." | |
279 | entry-type-str)) | |
280 | ||
281 | (defun ,filter-names-fun (entry) | |
282 | ,(format "\ | |
283 | Run `guix-hydra-filter-names' with `%S' variable." | |
284 | filter-names-var) | |
285 | (guix-hydra-filter-names entry ,filter-names-var)) | |
286 | ||
287 | (setq ,filters-var | |
288 | (cons ',filter-names-fun ,filters-var))))) | |
289 | ||
290 | (defun ,get-fun (search-type &rest args) | |
291 | ,(format "\ | |
292 | Receive '%s' entries. | |
293 | See `guix-hydra-get-entries' for details." | |
294 | entry-type-str) | |
295 | (apply #'guix-hydra-get-entries | |
296 | ',entry-type search-type args)) | |
297 | ||
298 | (guix-alist-put! | |
299 | '((search-types . ,search-types-var) | |
300 | (filters . ,filters-var)) | |
301 | 'guix-hydra-entry-type-data ',entry-type) | |
302 | ||
303 | (guix-define-entry-type ,entry-type | |
304 | :parent-group guix-hydra | |
305 | :parent-faces-group guix-hydra-faces | |
306 | ,@%foreign-args))))) | |
307 | ||
308 | (defmacro guix-hydra-define-interface (buffer-type entry-type &rest args) | |
309 | "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries. | |
310 | ||
311 | This macro should be called after calling | |
312 | `guix-hydra-define-entry-type' with the same ENTRY-TYPE. | |
313 | ||
314 | ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro." | |
315 | (declare (indent 2)) | |
316 | (let* ((entry-type-str (symbol-name entry-type)) | |
317 | (buffer-type-str (symbol-name buffer-type)) | |
318 | (get-fun (intern (concat "guix-" entry-type-str | |
319 | "-get-entries"))) | |
320 | (definer (intern (concat "guix-" buffer-type-str | |
321 | "-define-interface")))) | |
322 | `(,definer ,entry-type | |
323 | :get-entries-function ',get-fun | |
324 | :message-function 'guix-hydra-message | |
325 | ,@args))) | |
326 | ||
327 | (defmacro guix-hydra-info-define-interface (entry-type &rest args) | |
328 | "Define 'info' interface for displaying ENTRY-TYPE entries. | |
329 | See `guix-hydra-define-interface'." | |
330 | (declare (indent 1)) | |
331 | `(guix-hydra-define-interface info ,entry-type | |
332 | ,@args)) | |
333 | ||
334 | (defmacro guix-hydra-list-define-interface (entry-type &rest args) | |
335 | "Define 'list' interface for displaying ENTRY-TYPE entries. | |
336 | Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ... | |
337 | ||
338 | Optional keywords: | |
339 | ||
340 | - `:describe-function' - default value of the generated | |
341 | `guix-ENTRY-TYPE-list-describe-function' variable (if not | |
342 | specified, use `guix-hydra-list-describe'). | |
343 | ||
344 | The rest keyword arguments are passed to | |
345 | `guix-hydra-define-interface' macro." | |
346 | (declare (indent 1)) | |
347 | (guix-keyword-args-let args | |
348 | ((describe-val :describe-function)) | |
349 | `(guix-hydra-define-interface list ,entry-type | |
350 | :describe-function ,(or describe-val ''guix-hydra-list-describe) | |
351 | ,@args))) | |
352 | ||
353 | \f | |
354 | (defvar guix-hydra-font-lock-keywords | |
355 | (eval-when-compile | |
356 | `((,(rx "(" (group (or "guix-hydra-define-entry-type" | |
357 | "guix-hydra-define-interface" | |
358 | "guix-hydra-info-define-interface" | |
359 | "guix-hydra-list-define-interface")) | |
360 | symbol-end) | |
361 | . 1)))) | |
362 | ||
363 | (font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords) | |
364 | ||
365 | (provide 'guix-hydra) | |
366 | ||
367 | ;;; guix-hydra.el ends here |