mirror of git://git.savannah.gnu.org/guix.git
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.
This commit is contained in:
Alex Kost
parent
494a62f215
commit
32950fc846
|
|
@ -14,6 +14,7 @@ Guix convenient and fun.
|
|||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||
* Development: Emacs Development. Tools for Guix developers.
|
||||
* Hydra: Emacs Hydra. Interface for Guix build farm.
|
||||
@end menu
|
||||
|
||||
|
||||
|
|
@ -741,3 +742,41 @@ evaluation will be finished in the REPL.
|
|||
Alternatively, to avoid this limitation, you may just run another Geiser
|
||||
REPL, and while something is being evaluated in the previous REPL, you
|
||||
can continue editing a scheme file with the help of the current one.
|
||||
|
||||
|
||||
@node Emacs Hydra
|
||||
@section Hydra
|
||||
|
||||
The continuous integration server at @code{hydra.gnu.org} builds all
|
||||
the distribution packages on the supported architectures and serves
|
||||
them as substitutes (@pxref{Substitutes}). Continuous integration is
|
||||
currently orchestrated by @uref{https://nixos.org/hydra/, Hydra}.
|
||||
|
||||
This section describes an Emacs interface to query Hydra to know the
|
||||
build status of specific packages, discover recent and ongoing builds,
|
||||
view build logs, and so on. This interface is mostly the same as the
|
||||
``list''/``info'' interface for displaying packages and generations
|
||||
(@pxref{Emacs Package Management}).
|
||||
|
||||
The following commands are available:
|
||||
|
||||
@table @kbd
|
||||
|
||||
@item M-x guix-hydra-latest-builds
|
||||
Display latest failed or successful builds (you will be prompted for a
|
||||
number of builds). With @kbd{C-u}, you will also be prompted for other
|
||||
parameters (project, jobset, job and system).
|
||||
|
||||
@item M-x guix-hydra-queued-builds
|
||||
Display scheduled or currently running builds (you will be prompted for
|
||||
a number of builds).
|
||||
|
||||
@item M-x guix-hydra-jobsets
|
||||
Display available jobsets (you will be prompted for a project).
|
||||
|
||||
@end table
|
||||
|
||||
In a list of builds you can press @kbd{L} key to display a build log of
|
||||
the current build. Also both a list of builds and a list of jobsets
|
||||
provide @kbd{B} key to display latest builds of the current job or
|
||||
jobset (don't forget about @kbd{C-u}).
|
||||
|
|
|
|||
|
|
@ -116,6 +116,7 @@ Emacs Interface
|
|||
* Build Log Mode: Emacs Build Log. Highlighting Guix build logs.
|
||||
* Completions: Emacs Completions. Completing @command{guix} shell command.
|
||||
* Development: Emacs Development. Tools for Guix developers.
|
||||
* Hydra: Emacs Hydra. Interface for Guix build farm.
|
||||
|
||||
Programming Interface
|
||||
|
||||
|
|
@ -1585,7 +1586,9 @@ also result from derivation builds, can be available as substitutes.
|
|||
|
||||
The @code{hydra.gnu.org} server is a front-end to a build farm that
|
||||
builds packages from the GNU distribution continuously for some
|
||||
architectures, and makes them available as substitutes. This is the
|
||||
architectures, and makes them available as substitutes (@pxref{Emacs
|
||||
Hydra}, for information on how to query the continuous integration
|
||||
server). This is the
|
||||
default source of substitutes; it can be overridden by passing the
|
||||
@option{--substitute-urls} option either to @command{guix-daemon}
|
||||
(@pxref{daemon-substitute-urls,, @code{guix-daemon --substitute-urls}})
|
||||
|
|
|
|||
3
emacs.am
3
emacs.am
|
|
@ -32,6 +32,9 @@ ELFILES = \
|
|||
emacs/guix-guile.el \
|
||||
emacs/guix-help-vars.el \
|
||||
emacs/guix-history.el \
|
||||
emacs/guix-hydra.el \
|
||||
emacs/guix-hydra-build.el \
|
||||
emacs/guix-hydra-jobset.el \
|
||||
emacs/guix-info.el \
|
||||
emacs/guix-init.el \
|
||||
emacs/guix-list.el \
|
||||
|
|
|
|||
|
|
@ -0,0 +1,362 @@
|
|||
;;; 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
|
||||
|
|
@ -0,0 +1,162 @@
|
|||
;;; guix-hydra-jobset.el --- Interface for Hydra jobsets -*- 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 jobsets in
|
||||
;; 'list' and 'info' buffers.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-list)
|
||||
(require 'guix-info)
|
||||
(require 'guix-hydra)
|
||||
(require 'guix-hydra-build)
|
||||
(require 'guix-utils)
|
||||
|
||||
(guix-hydra-define-entry-type hydra-jobset
|
||||
:search-types '((project . guix-hydra-jobset-api-url))
|
||||
:filters '(guix-hydra-jobset-filter-id)
|
||||
:filter-names '((nrscheduled . scheduled)
|
||||
(nrsucceeded . succeeded)
|
||||
(nrfailed . failed)
|
||||
(nrtotal . total)))
|
||||
|
||||
(defun guix-hydra-jobset-get-display (search-type &rest args)
|
||||
"Search for Hydra builds and show results."
|
||||
(apply #'guix-list-get-display-entries
|
||||
'hydra-jobset search-type args))
|
||||
|
||||
|
||||
;;; Defining URLs
|
||||
|
||||
(defun guix-hydra-jobset-url (project jobset)
|
||||
"Return Hydra URL of a PROJECT's JOBSET."
|
||||
(guix-hydra-url "jobset/" project "/" jobset))
|
||||
|
||||
(defun guix-hydra-jobset-api-url (project)
|
||||
"Return Hydra API URL for jobsets by PROJECT."
|
||||
(guix-hydra-api-url "jobsets"
|
||||
`(("project" . ,project))))
|
||||
|
||||
|
||||
;;; Filters for processing raw entries
|
||||
|
||||
(defun guix-hydra-jobset-filter-id (entry)
|
||||
"Add 'ID' parameter to 'hydra-jobset' ENTRY."
|
||||
(cons `(id . ,(guix-entry-value entry 'name))
|
||||
entry))
|
||||
|
||||
|
||||
;;; Hydra jobset 'info'
|
||||
|
||||
(guix-hydra-info-define-interface hydra-jobset
|
||||
:mode-name "Hydra-Jobset-Info"
|
||||
:buffer-name "*Guix Hydra Jobset Info*"
|
||||
:format '((name ignore (simple guix-info-heading))
|
||||
ignore
|
||||
guix-hydra-jobset-info-insert-url
|
||||
(project format guix-hydra-jobset-info-insert-project)
|
||||
(scheduled format (format guix-hydra-jobset-info-scheduled))
|
||||
(succeeded format (format guix-hydra-jobset-info-succeeded))
|
||||
(failed format (format guix-hydra-jobset-info-failed))
|
||||
(total format (format guix-hydra-jobset-info-total))))
|
||||
|
||||
(defface guix-hydra-jobset-info-scheduled
|
||||
'((t))
|
||||
"Face used for the number of scheduled builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-succeeded
|
||||
'((t :inherit guix-hydra-build-status-succeeded))
|
||||
"Face used for the number of succeeded builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-failed
|
||||
'((t :inherit guix-hydra-build-status-failed))
|
||||
"Face used for the number of failed builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defface guix-hydra-jobset-info-total
|
||||
'((t))
|
||||
"Face used for the total number of builds."
|
||||
:group 'guix-hydra-jobset-info-faces)
|
||||
|
||||
(defun guix-hydra-jobset-info-insert-project (project entry)
|
||||
"Insert PROJECT button for the jobset ENTRY."
|
||||
(let ((jobset (guix-entry-value entry 'name)))
|
||||
(guix-insert-button
|
||||
project 'guix-hydra-build-project
|
||||
'action (lambda (btn)
|
||||
(let ((args (guix-hydra-build-latest-prompt-args
|
||||
:project (button-get btn 'project)
|
||||
:jobset (button-get btn 'jobset))))
|
||||
(apply #'guix-hydra-build-get-display
|
||||
'latest args)))
|
||||
'project project
|
||||
'jobset jobset)))
|
||||
|
||||
(defun guix-hydra-jobset-info-insert-url (entry)
|
||||
"Insert Hydra URL for the jobset ENTRY."
|
||||
(guix-insert-button (guix-hydra-jobset-url
|
||||
(guix-entry-value entry 'project)
|
||||
(guix-entry-value entry 'name))
|
||||
'guix-url))
|
||||
|
||||
|
||||
;;; Hydra jobset 'list'
|
||||
|
||||
(guix-hydra-list-define-interface hydra-jobset
|
||||
:mode-name "Hydra-Jobset-List"
|
||||
:buffer-name "*Guix Hydra Jobset List*"
|
||||
:format '((name nil 25 t)
|
||||
(project nil 10 t)
|
||||
(scheduled nil 12 t)
|
||||
(succeeded nil 12 t)
|
||||
(failed nil 9 t)
|
||||
(total nil 10 t)))
|
||||
|
||||
(let ((map guix-hydra-jobset-list-mode-map))
|
||||
(define-key map (kbd "B") 'guix-hydra-jobset-list-latest-builds))
|
||||
|
||||
(defun guix-hydra-jobset-list-latest-builds (number &rest args)
|
||||
"Display latest NUMBER of Hydra builds of the current jobset.
|
||||
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))))
|
||||
(apply #'guix-hydra-latest-builds number args))
|
||||
|
||||
|
||||
;;; Interactive commands
|
||||
|
||||
;;;###autoload
|
||||
(defun guix-hydra-jobsets (project)
|
||||
"Display jobsets of PROJECT."
|
||||
(interactive (list (guix-hydra-read-project)))
|
||||
(guix-hydra-jobset-get-display 'project project))
|
||||
|
||||
(provide 'guix-hydra-jobset)
|
||||
|
||||
;;; guix-hydra-jobset.el ends here
|
||||
|
|
@ -0,0 +1,363 @@
|
|||
;;; guix-hydra.el --- Common code for interacting with Hydra -*- 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 some general code for 'list'/'info' interfaces for
|
||||
;; Hydra (Guix build farm).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'json)
|
||||
(require 'guix-buffer)
|
||||
(require 'guix-entry)
|
||||
(require 'guix-utils)
|
||||
(require 'guix-help-vars)
|
||||
|
||||
(guix-define-groups hydra)
|
||||
|
||||
(defvar guix-hydra-job-regexp
|
||||
(concat ".*\\." (regexp-opt guix-help-system-types) "\\'")
|
||||
"Regexp matching a full name of Hydra job (including system).")
|
||||
|
||||
(defun guix-hydra-message (entries search-type &rest _)
|
||||
"Display a message after showing Hydra ENTRIES."
|
||||
;; XXX Add more messages maybe.
|
||||
(when (null entries)
|
||||
(if (eq search-type 'fake)
|
||||
(message "The update is impossible due to lack of Hydra API.")
|
||||
(message "Hydra has returned no results."))))
|
||||
|
||||
(defun guix-hydra-list-describe (ids)
|
||||
"Describe 'hydra' entries with IDS (list of identifiers)."
|
||||
(guix-buffer-display-entries
|
||||
(guix-entries-by-ids ids (guix-buffer-current-entries))
|
||||
'info (guix-buffer-current-entry-type)
|
||||
;; Hydra does not provide an API to receive builds/jobsets by
|
||||
;; IDs/names, so we use a 'fake' search type.
|
||||
'(fake)
|
||||
'add))
|
||||
|
||||
|
||||
;;; Readers
|
||||
|
||||
(defvar guix-hydra-projects
|
||||
'("gnu" "guix")
|
||||
"List of available Hydra projects.")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-hydra-projects
|
||||
:single-reader guix-hydra-read-project
|
||||
:single-prompt "Project: ")
|
||||
|
||||
(guix-define-readers
|
||||
:single-reader guix-hydra-read-jobset
|
||||
:single-prompt "Jobset: ")
|
||||
|
||||
(guix-define-readers
|
||||
:single-reader guix-hydra-read-job
|
||||
:single-prompt "Job: ")
|
||||
|
||||
(guix-define-readers
|
||||
:completions-var guix-help-system-types
|
||||
:single-reader guix-hydra-read-system
|
||||
:single-prompt "System: ")
|
||||
|
||||
|
||||
;;; Defining URLs
|
||||
|
||||
(defvar guix-hydra-url "http://hydra.gnu.org"
|
||||
"URL of the Hydra build farm.")
|
||||
|
||||
(defun guix-hydra-url (&rest url-parts)
|
||||
"Return Hydra URL."
|
||||
(apply #'concat guix-hydra-url "/" url-parts))
|
||||
|
||||
(defun guix-hydra-api-url (type args)
|
||||
"Return URL for receiving data using Hydra API.
|
||||
TYPE is the name of an allowed method.
|
||||
ARGS is alist of (KEY . VALUE) pairs.
|
||||
Skip ARG, if VALUE is nil or an empty string."
|
||||
(declare (indent 1))
|
||||
(let* ((fields (mapcar
|
||||
(lambda (arg)
|
||||
(pcase arg
|
||||
(`(,key . ,value)
|
||||
(unless (or (null value)
|
||||
(equal "" value))
|
||||
(concat (guix-hexify key) "="
|
||||
(guix-hexify value))))
|
||||
(_ (error "Wrong argument '%s'" arg))))
|
||||
args))
|
||||
(fields (mapconcat #'identity (delq nil fields) "&")))
|
||||
(guix-hydra-url "api/" type "?" fields)))
|
||||
|
||||
|
||||
;;; Receiving data from Hydra
|
||||
|
||||
(defun guix-hydra-receive-data (url)
|
||||
"Return output received from URL and processed with `json-read'."
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents url)
|
||||
(goto-char (point-min))
|
||||
(let ((json-key-type 'symbol)
|
||||
(json-array-type 'list)
|
||||
(json-object-type 'alist))
|
||||
(json-read))))
|
||||
|
||||
(defun guix-hydra-get-entries (entry-type search-type &rest args)
|
||||
"Receive ENTRY-TYPE entries from Hydra.
|
||||
SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'."
|
||||
(unless (eq search-type 'fake)
|
||||
(let* ((url (apply #'guix-hydra-search-url
|
||||
entry-type search-type args))
|
||||
(raw-entries (guix-hydra-receive-data url))
|
||||
(entries (guix-hydra-filter-entries
|
||||
raw-entries
|
||||
(guix-hydra-filters entry-type))))
|
||||
entries)))
|
||||
|
||||
|
||||
;;; Filters for processing raw entries
|
||||
|
||||
(defun guix-hydra-filter-entries (entries filters)
|
||||
"Filter ENTRIES using FILTERS.
|
||||
Call `guix-modify' on each entry from ENTRIES."
|
||||
(mapcar (lambda (entry)
|
||||
(guix-modify entry filters))
|
||||
entries))
|
||||
|
||||
(defun guix-hydra-filter-names (entry name-alist)
|
||||
"Replace names of ENTRY parameters using NAME-ALIST.
|
||||
Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair."
|
||||
(mapcar (lambda (param)
|
||||
(pcase param
|
||||
(`(,name . ,val)
|
||||
(let ((new-name (guix-assq-value name-alist name)))
|
||||
(if new-name
|
||||
(cons new-name val)
|
||||
param)))))
|
||||
entry))
|
||||
|
||||
(defun guix-hydra-filter-boolean (entry params)
|
||||
"Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)."
|
||||
(mapcar (lambda (param)
|
||||
(pcase param
|
||||
(`(,name . ,val)
|
||||
(if (memq name params)
|
||||
(cons name (guix-number->bool val))
|
||||
param))))
|
||||
entry))
|
||||
|
||||
|
||||
;;; Wrappers for defined variables
|
||||
|
||||
(defvar guix-hydra-entry-type-data nil
|
||||
"Alist with hydra entry type data.
|
||||
This alist is filled by `guix-hydra-define-entry-type' macro.")
|
||||
|
||||
(defun guix-hydra-entry-type-value (entry-type symbol)
|
||||
"Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'."
|
||||
(symbol-value (guix-assq-value guix-hydra-entry-type-data
|
||||
entry-type symbol)))
|
||||
|
||||
(defun guix-hydra-search-url (entry-type search-type &rest args)
|
||||
"Return URL to receive ENTRY-TYPE entries from Hydra."
|
||||
(apply (guix-assq-value (guix-hydra-entry-type-value
|
||||
entry-type 'search-types)
|
||||
search-type)
|
||||
args))
|
||||
|
||||
(defun guix-hydra-filters (entry-type)
|
||||
"Return a list of filters for ENTRY-TYPE."
|
||||
(guix-hydra-entry-type-value entry-type 'filters))
|
||||
|
||||
|
||||
;;; Interface definers
|
||||
|
||||
(defmacro guix-hydra-define-entry-type (entry-type &rest args)
|
||||
"Define general code for ENTRY-TYPE.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Required keywords:
|
||||
|
||||
- `:search-types' - default value of the generated
|
||||
`guix-ENTRY-TYPE-search-types' variable.
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:filters' - default value of the generated
|
||||
`guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
- `:filter-names' - if specified, a generated
|
||||
`guix-ENTRY-TYPE-filter-names' function for filtering these
|
||||
names will be added to `guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
- `:filter-boolean-params' - if specified, a generated
|
||||
`guix-ENTRY-TYPE-filter-boolean' function for filtering these
|
||||
names will be added to `guix-ENTRY-TYPE-filters' variable.
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-define-entry-type' macro."
|
||||
(declare (indent 1))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(prefix (concat "guix-" entry-type-str))
|
||||
(search-types-var (intern (concat prefix "-search-types")))
|
||||
(filters-var (intern (concat prefix "-filters")))
|
||||
(get-fun (intern (concat prefix "-get-entries"))))
|
||||
(guix-keyword-args-let args
|
||||
((search-types-val :search-types)
|
||||
(filters-val :filters)
|
||||
(filter-names-val :filter-names)
|
||||
(filter-bool-val :filter-boolean-params))
|
||||
`(progn
|
||||
(defvar ,search-types-var ,search-types-val
|
||||
,(format "\
|
||||
Alist of search types and according URL functions.
|
||||
Functions are used to define URL to receive '%s' entries."
|
||||
entry-type-str))
|
||||
|
||||
(defvar ,filters-var ,filters-val
|
||||
,(format "\
|
||||
List of filters for '%s' parameters.
|
||||
Each filter is a function that should take an entry as a single
|
||||
argument, and should also return an entry."
|
||||
entry-type-str))
|
||||
|
||||
,(when filter-bool-val
|
||||
(let ((filter-bool-var (intern (concat prefix
|
||||
"-filter-boolean-params")))
|
||||
(filter-bool-fun (intern (concat prefix
|
||||
"-filter-boolean"))))
|
||||
`(progn
|
||||
(defvar ,filter-bool-var ,filter-bool-val
|
||||
,(format "\
|
||||
List of '%s' parameters that should be transformed to boolean values."
|
||||
entry-type-str))
|
||||
|
||||
(defun ,filter-bool-fun (entry)
|
||||
,(format "\
|
||||
Run `guix-hydra-filter-boolean' with `%S' variable."
|
||||
filter-bool-var)
|
||||
(guix-hydra-filter-boolean entry ,filter-bool-var))
|
||||
|
||||
(setq ,filters-var
|
||||
(cons ',filter-bool-fun ,filters-var)))))
|
||||
|
||||
;; Do not move this clause up!: name filtering should be
|
||||
;; performed before any other filtering, so this filter should
|
||||
;; be consed after the boolean filter.
|
||||
,(when filter-names-val
|
||||
(let* ((filter-names-var (intern (concat prefix
|
||||
"-filter-names")))
|
||||
(filter-names-fun filter-names-var))
|
||||
`(progn
|
||||
(defvar ,filter-names-var ,filter-names-val
|
||||
,(format "\
|
||||
Alist of '%s' parameter names returned by Hydra API and names
|
||||
used internally by the elisp code of this package."
|
||||
entry-type-str))
|
||||
|
||||
(defun ,filter-names-fun (entry)
|
||||
,(format "\
|
||||
Run `guix-hydra-filter-names' with `%S' variable."
|
||||
filter-names-var)
|
||||
(guix-hydra-filter-names entry ,filter-names-var))
|
||||
|
||||
(setq ,filters-var
|
||||
(cons ',filter-names-fun ,filters-var)))))
|
||||
|
||||
(defun ,get-fun (search-type &rest args)
|
||||
,(format "\
|
||||
Receive '%s' entries.
|
||||
See `guix-hydra-get-entries' for details."
|
||||
entry-type-str)
|
||||
(apply #'guix-hydra-get-entries
|
||||
',entry-type search-type args))
|
||||
|
||||
(guix-alist-put!
|
||||
'((search-types . ,search-types-var)
|
||||
(filters . ,filters-var))
|
||||
'guix-hydra-entry-type-data ',entry-type)
|
||||
|
||||
(guix-define-entry-type ,entry-type
|
||||
:parent-group guix-hydra
|
||||
:parent-faces-group guix-hydra-faces
|
||||
,@%foreign-args)))))
|
||||
|
||||
(defmacro guix-hydra-define-interface (buffer-type entry-type &rest args)
|
||||
"Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
|
||||
|
||||
This macro should be called after calling
|
||||
`guix-hydra-define-entry-type' with the same ENTRY-TYPE.
|
||||
|
||||
ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro."
|
||||
(declare (indent 2))
|
||||
(let* ((entry-type-str (symbol-name entry-type))
|
||||
(buffer-type-str (symbol-name buffer-type))
|
||||
(get-fun (intern (concat "guix-" entry-type-str
|
||||
"-get-entries")))
|
||||
(definer (intern (concat "guix-" buffer-type-str
|
||||
"-define-interface"))))
|
||||
`(,definer ,entry-type
|
||||
:get-entries-function ',get-fun
|
||||
:message-function 'guix-hydra-message
|
||||
,@args)))
|
||||
|
||||
(defmacro guix-hydra-info-define-interface (entry-type &rest args)
|
||||
"Define 'info' interface for displaying ENTRY-TYPE entries.
|
||||
See `guix-hydra-define-interface'."
|
||||
(declare (indent 1))
|
||||
`(guix-hydra-define-interface info ,entry-type
|
||||
,@args))
|
||||
|
||||
(defmacro guix-hydra-list-define-interface (entry-type &rest args)
|
||||
"Define 'list' interface for displaying ENTRY-TYPE entries.
|
||||
Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
|
||||
|
||||
Optional keywords:
|
||||
|
||||
- `:describe-function' - default value of the generated
|
||||
`guix-ENTRY-TYPE-list-describe-function' variable (if not
|
||||
specified, use `guix-hydra-list-describe').
|
||||
|
||||
The rest keyword arguments are passed to
|
||||
`guix-hydra-define-interface' macro."
|
||||
(declare (indent 1))
|
||||
(guix-keyword-args-let args
|
||||
((describe-val :describe-function))
|
||||
`(guix-hydra-define-interface list ,entry-type
|
||||
:describe-function ,(or describe-val ''guix-hydra-list-describe)
|
||||
,@args)))
|
||||
|
||||
|
||||
(defvar guix-hydra-font-lock-keywords
|
||||
(eval-when-compile
|
||||
`((,(rx "(" (group (or "guix-hydra-define-entry-type"
|
||||
"guix-hydra-define-interface"
|
||||
"guix-hydra-info-define-interface"
|
||||
"guix-hydra-list-define-interface"))
|
||||
symbol-end)
|
||||
. 1))))
|
||||
|
||||
(font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords)
|
||||
|
||||
(provide 'guix-hydra)
|
||||
|
||||
;;; guix-hydra.el ends here
|
||||
|
|
@ -174,6 +174,15 @@ add both to the end and to the beginning."
|
|||
(t
|
||||
(concat separator str separator)))))
|
||||
|
||||
(defun guix-hexify (value)
|
||||
"Convert VALUE to string and hexify it."
|
||||
(url-hexify-string (guix-get-string value)))
|
||||
|
||||
(defun guix-number->bool (number)
|
||||
"Convert NUMBER to boolean value.
|
||||
Return nil, if NUMBER is 0; return t otherwise."
|
||||
(not (zerop number)))
|
||||
|
||||
(defun guix-shell-quote-argument (argument)
|
||||
"Quote shell command ARGUMENT.
|
||||
This function is similar to `shell-quote-argument', but less strict."
|
||||
|
|
@ -282,6 +291,15 @@ single argument."
|
|||
(while (re-search-forward ,regexp nil t)
|
||||
,@body)))
|
||||
|
||||
(defmacro guix-while-null (&rest body)
|
||||
"Evaluate BODY until its result becomes non-nil."
|
||||
(declare (indent 0) (debug t))
|
||||
(let ((result-var (make-symbol "result")))
|
||||
`(let (,result-var)
|
||||
(while (null ,result-var)
|
||||
(setq ,result-var ,@body))
|
||||
,result-var)))
|
||||
|
||||
(defun guix-modify (object modifiers)
|
||||
"Apply MODIFIERS to OBJECT.
|
||||
OBJECT is passed as an argument to the first function from
|
||||
|
|
@ -527,6 +545,8 @@ See `defun' for the meaning of arguments."
|
|||
`((,(rx "(" (group (or "guix-define-reader"
|
||||
"guix-define-readers"
|
||||
"guix-keyword-args-let"
|
||||
"guix-while-null"
|
||||
"guix-while-search"
|
||||
"guix-with-indent"))
|
||||
symbol-end)
|
||||
. 1)
|
||||
|
|
|
|||
Loading…
Reference in New Issue