me
/
guix
Archived
1
0
Fork 0
Code
This repository has been archived on 2024-08-07. You can view files and clone it, but cannot push or open issues/pull-requests.
guix/emacs/guix-hydra-build.el

363 lines
12 KiB
EmacsLisp
Raw Normal View History

emacs: Add Hydra interface. * emacs/guix-utils.el (guix-hexify, guix-number->bool): New procedures. (guix-while-null): New macro. * emacs/guix-hydra.el: New file. * emacs/guix-hydra-build.el: New file. * emacs/guix-hydra-jobset.el: New file. * emacs.am (ELFILES): Add them. * doc/emacs.texi (Emacs Hydra): New node. (Emacs Interface): Add it. * doc/guix.texi (Top): Add it. (Substitutes): Mention Emacs interface.
2015-12-11 11:01:35 +00:00
;;; 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