mirror of git://git.savannah.gnu.org/guix.git
363 lines
12 KiB
EmacsLisp
363 lines
12 KiB
EmacsLisp
;;; guix-hydra-build.el --- Interface for Hydra builds -*- lexical-binding: t -*-
|
||
|
||
;; Copyright © 2015 Alex Kost <alezost@gmail.com>
|
||
|
||
;; This file is part of GNU Guix.
|
||
|
||
;; GNU Guix is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Guix 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 General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; This file provides an interface for displaying Hydra builds in
|
||
;; 'list' and 'info' buffers.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'guix-buffer)
|
||
(require 'guix-list)
|
||
(require 'guix-info)
|
||
(require 'guix-hydra)
|
||
(require 'guix-build-log)
|
||
(require 'guix-utils)
|
||
|
||
(guix-hydra-define-entry-type hydra-build
|
||
:search-types '((latest . guix-hydra-build-latest-api-url)
|
||
(queue . guix-hydra-build-queue-api-url))
|
||
:filters '(guix-hydra-build-filter-status)
|
||
:filter-names '((nixname . name)
|
||
(buildstatus . build-status)
|
||
(timestamp . time))
|
||
:filter-boolean-params '(finished busy))
|
||
|
||
(defun guix-hydra-build-get-display (search-type &rest args)
|
||
"Search for Hydra builds and show results."
|
||
(apply #'guix-list-get-display-entries
|
||
'hydra-build search-type args))
|
||
|
||
(cl-defun guix-hydra-build-latest-prompt-args (&key project jobset
|
||
job system)
|
||
"Prompt for and return a list of 'latest builds' arguments."
|
||
(let* ((number (read-number "Number of latest builds: "))
|
||
(project (if current-prefix-arg
|
||
(guix-hydra-read-project nil project)
|
||
project))
|
||
(jobset (if current-prefix-arg
|
||
(guix-hydra-read-jobset nil jobset)
|
||
jobset))
|
||
(job-or-name (if current-prefix-arg
|
||
(guix-hydra-read-job nil job)
|
||
job))
|
||
(job (and job-or-name
|
||
(string-match-p guix-hydra-job-regexp
|
||
job-or-name)
|
||
job-or-name))
|
||
(system (if (and (not job)
|
||
(or current-prefix-arg
|
||
(and job-or-name (not system))))
|
||
(if job-or-name
|
||
(guix-while-null
|
||
(guix-hydra-read-system
|
||
(concat job-or-name ".") system))
|
||
(guix-hydra-read-system nil system))
|
||
system))
|
||
(job (or job
|
||
(and job-or-name
|
||
(concat job-or-name "." system)))))
|
||
(list number
|
||
:project project
|
||
:jobset jobset
|
||
:job job
|
||
:system system)))
|
||
|
||
(defun guix-hydra-build-view-log (id)
|
||
"View build log of a hydra build ID."
|
||
(guix-build-log-find-file (guix-hydra-build-log-url id)))
|
||
|
||
|
||
;;; Defining URLs
|
||
|
||
(defun guix-hydra-build-url (id)
|
||
"Return Hydra URL of a build ID."
|
||
(guix-hydra-url "build/" (number-to-string id)))
|
||
|
||
(defun guix-hydra-build-log-url (id)
|
||
"Return Hydra URL of the log file of a build ID."
|
||
(concat (guix-hydra-build-url id) "/log/raw"))
|
||
|
||
(cl-defun guix-hydra-build-latest-api-url
|
||
(number &key project jobset job system)
|
||
"Return Hydra API URL to receive latest NUMBER of builds."
|
||
(guix-hydra-api-url "latestbuilds"
|
||
`(("nr" . ,number)
|
||
("project" . ,project)
|
||
("jobset" . ,jobset)
|
||
("job" . ,job)
|
||
("system" . ,system))))
|
||
|
||
(defun guix-hydra-build-queue-api-url (number)
|
||
"Return Hydra API URL to receive the NUMBER of queued builds."
|
||
(guix-hydra-api-url "queue"
|
||
`(("nr" . ,number))))
|
||
|
||
|
||
;;; Filters for processing raw entries
|
||
|
||
(defun guix-hydra-build-filter-status (entry)
|
||
"Add 'status' parameter to 'hydra-build' ENTRY."
|
||
(let ((status (if (guix-entry-value entry 'finished)
|
||
(guix-hydra-build-status-number->name
|
||
(guix-entry-value entry 'build-status))
|
||
(if (guix-entry-value entry 'busy)
|
||
'running
|
||
'scheduled))))
|
||
(cons `(status . ,status)
|
||
entry)))
|
||
|
||
|
||
;;; Build status
|
||
|
||
(defface guix-hydra-build-status-running
|
||
'((t :inherit bold))
|
||
"Face used if hydra build is not finished."
|
||
:group 'guix-hydra-build-faces)
|
||
|
||
(defface guix-hydra-build-status-scheduled
|
||
'((t))
|
||
"Face used if hydra build is scheduled."
|
||
:group 'guix-hydra-build-faces)
|
||
|
||
(defface guix-hydra-build-status-succeeded
|
||
'((t :inherit success))
|
||
"Face used if hydra build succeeded."
|
||
:group 'guix-hydra-build-faces)
|
||
|
||
(defface guix-hydra-build-status-cancelled
|
||
'((t :inherit warning))
|
||
"Face used if hydra build was cancelled."
|
||
:group 'guix-hydra-build-faces)
|
||
|
||
(defface guix-hydra-build-status-failed
|
||
'((t :inherit error))
|
||
"Face used if hydra build failed."
|
||
:group 'guix-hydra-build-faces)
|
||
|
||
(defvar guix-hydra-build-status-alist
|
||
'((0 . succeeded)
|
||
(1 . failed-build)
|
||
(2 . failed-dependency)
|
||
(3 . failed-other)
|
||
(4 . cancelled))
|
||
"Alist of hydra build status numbers and status names.
|
||
Status numbers are returned by Hydra API, names (symbols) are
|
||
used internally by the elisp code of this package.")
|
||
|
||
(defun guix-hydra-build-status-number->name (number)
|
||
"Convert build status number to a name.
|
||
See `guix-hydra-build-status-alist'."
|
||
(guix-assq-value guix-hydra-build-status-alist number))
|
||
|
||
(defun guix-hydra-build-status-string (status)
|
||
"Return a human readable string for build STATUS."
|
||
(cl-case status
|
||
(scheduled
|
||
(guix-get-string "Scheduled" 'guix-hydra-build-status-scheduled))
|
||
(running
|
||
(guix-get-string "Running" 'guix-hydra-build-status-running))
|
||
(succeeded
|
||
(guix-get-string "Succeeded" 'guix-hydra-build-status-succeeded))
|
||
(cancelled
|
||
(guix-get-string "Cancelled" 'guix-hydra-build-status-cancelled))
|
||
(failed-build
|
||
(guix-hydra-build-status-fail-string))
|
||
(failed-dependency
|
||
(guix-hydra-build-status-fail-string "dependency"))
|
||
(failed-other
|
||
(guix-hydra-build-status-fail-string "other"))))
|
||
|
||
(defun guix-hydra-build-status-fail-string (&optional reason)
|
||
"Return a string for a failed build."
|
||
(let ((base (guix-get-string "Failed" 'guix-hydra-build-status-failed)))
|
||
(if reason
|
||
(concat base " (" reason ")")
|
||
base)))
|
||
|
||
(defun guix-hydra-build-finished? (entry)
|
||
"Return non-nil, if hydra build was finished."
|
||
(guix-entry-value entry 'finished))
|
||
|
||
(defun guix-hydra-build-running? (entry)
|
||
"Return non-nil, if hydra build is running."
|
||
(eq (guix-entry-value entry 'status)
|
||
'running))
|
||
|
||
(defun guix-hydra-build-scheduled? (entry)
|
||
"Return non-nil, if hydra build is scheduled."
|
||
(eq (guix-entry-value entry 'status)
|
||
'scheduled))
|
||
|
||
(defun guix-hydra-build-succeeded? (entry)
|
||
"Return non-nil, if hydra build succeeded."
|
||
(eq (guix-entry-value entry 'status)
|
||
'succeeded))
|
||
|
||
(defun guix-hydra-build-cancelled? (entry)
|
||
"Return non-nil, if hydra build was cancelled."
|
||
(eq (guix-entry-value entry 'status)
|
||
'cancelled))
|
||
|
||
(defun guix-hydra-build-failed? (entry)
|
||
"Return non-nil, if hydra build failed."
|
||
(memq (guix-entry-value entry 'status)
|
||
'(failed-build failed-dependency failed-other)))
|
||
|
||
|
||
;;; Hydra build 'info'
|
||
|
||
(guix-hydra-info-define-interface hydra-build
|
||
:mode-name "Hydra-Build-Info"
|
||
:buffer-name "*Guix Hydra Build Info*"
|
||
:format '((name ignore (simple guix-info-heading))
|
||
ignore
|
||
guix-hydra-build-info-insert-url
|
||
(time format (time))
|
||
(status format guix-hydra-build-info-insert-status)
|
||
(project format (format guix-hydra-build-project))
|
||
(jobset format (format guix-hydra-build-jobset))
|
||
(job format (format guix-hydra-build-job))
|
||
(system format (format guix-hydra-build-system))
|
||
(priority format (format))))
|
||
|
||
(defface guix-hydra-build-info-project
|
||
'((t :inherit link))
|
||
"Face for project names."
|
||
:group 'guix-hydra-build-info-faces)
|
||
|
||
(defface guix-hydra-build-info-jobset
|
||
'((t :inherit link))
|
||
"Face for jobsets."
|
||
:group 'guix-hydra-build-info-faces)
|
||
|
||
(defface guix-hydra-build-info-job
|
||
'((t :inherit link))
|
||
"Face for jobs."
|
||
:group 'guix-hydra-build-info-faces)
|
||
|
||
(defface guix-hydra-build-info-system
|
||
'((t :inherit link))
|
||
"Face for system names."
|
||
:group 'guix-hydra-build-info-faces)
|
||
|
||
(defmacro guix-hydra-build-define-button (name)
|
||
"Define `guix-hydra-build-NAME' button."
|
||
(let* ((name-str (symbol-name name))
|
||
(button-name (intern (concat "guix-hydra-build-" name-str)))
|
||
(face-name (intern (concat "guix-hydra-build-info-" name-str)))
|
||
(keyword (intern (concat ":" name-str))))
|
||
`(define-button-type ',button-name
|
||
:supertype 'guix
|
||
'face ',face-name
|
||
'help-echo ,(format "\
|
||
Show latest builds for this %s (with prefix, prompt for all parameters)"
|
||
name-str)
|
||
'action (lambda (btn)
|
||
(let ((args (guix-hydra-build-latest-prompt-args
|
||
,keyword (button-label btn))))
|
||
(apply #'guix-hydra-build-get-display
|
||
'latest args))))))
|
||
|
||
(guix-hydra-build-define-button project)
|
||
(guix-hydra-build-define-button jobset)
|
||
(guix-hydra-build-define-button job)
|
||
(guix-hydra-build-define-button system)
|
||
|
||
(defun guix-hydra-build-info-insert-url (entry)
|
||
"Insert Hydra URL for the build ENTRY."
|
||
(guix-insert-button (guix-hydra-build-url (guix-entry-id entry))
|
||
'guix-url)
|
||
(when (guix-hydra-build-finished? entry)
|
||
(guix-info-insert-indent)
|
||
(guix-info-insert-action-button
|
||
"Build log"
|
||
(lambda (btn)
|
||
(guix-hydra-build-view-log (button-get btn 'id)))
|
||
"View build log"
|
||
'id (guix-entry-id entry))))
|
||
|
||
(defun guix-hydra-build-info-insert-status (status &optional _)
|
||
"Insert a string with build STATUS."
|
||
(insert (guix-hydra-build-status-string status)))
|
||
|
||
|
||
;;; Hydra build 'list'
|
||
|
||
(guix-hydra-list-define-interface hydra-build
|
||
:mode-name "Hydra-Build-List"
|
||
:buffer-name "*Guix Hydra Build List*"
|
||
:format '((name nil 30 t)
|
||
(system nil 16 t)
|
||
(status guix-hydra-build-list-get-status 20 t)
|
||
(project nil 10 t)
|
||
(jobset nil 17 t)
|
||
(time guix-list-get-time 20 t)))
|
||
|
||
(let ((map guix-hydra-build-list-mode-map))
|
||
(define-key map (kbd "B") 'guix-hydra-build-list-latest-builds)
|
||
(define-key map (kbd "L") 'guix-hydra-build-list-view-log))
|
||
|
||
(defun guix-hydra-build-list-get-status (status &optional _)
|
||
"Return a string for build STATUS."
|
||
(guix-hydra-build-status-string status))
|
||
|
||
(defun guix-hydra-build-list-latest-builds (number &rest args)
|
||
"Display latest NUMBER of Hydra builds of the current job.
|
||
Interactively, prompt for NUMBER. With prefix argument, prompt
|
||
for all ARGS."
|
||
(interactive
|
||
(let ((entry (guix-list-current-entry)))
|
||
(guix-hydra-build-latest-prompt-args
|
||
:project (guix-entry-value entry 'project)
|
||
:jobset (guix-entry-value entry 'name)
|
||
:job (guix-entry-value entry 'job)
|
||
:system (guix-entry-value entry 'system))))
|
||
(apply #'guix-hydra-latest-builds number args))
|
||
|
||
(defun guix-hydra-build-list-view-log ()
|
||
"View build log of the current Hydra build."
|
||
(interactive)
|
||
(guix-hydra-build-view-log (guix-list-current-id)))
|
||
|
||
|
||
;;; Interactive commands
|
||
|
||
;;;###autoload
|
||
(defun guix-hydra-latest-builds (number &rest args)
|
||
"Display latest NUMBER of Hydra builds.
|
||
ARGS are the same arguments as for `guix-hydra-build-latest-api-url'.
|
||
Interactively, prompt for NUMBER. With prefix argument, prompt
|
||
for all ARGS."
|
||
(interactive (guix-hydra-build-latest-prompt-args))
|
||
(apply #'guix-hydra-build-get-display
|
||
'latest number args))
|
||
|
||
;;;###autoload
|
||
(defun guix-hydra-queued-builds (number)
|
||
"Display the NUMBER of queued Hydra builds."
|
||
(interactive "NNumber of queued builds: ")
|
||
(guix-hydra-build-get-display 'queue number))
|
||
|
||
(provide 'guix-hydra-build)
|
||
|
||
;;; guix-hydra-build.el ends here
|