aboutsummaryrefslogtreecommitdiff
path: root/emacs/guix-hydra-build.el
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2015-12-11 14:01:35 +0300
committerAlex Kost <alezost@gmail.com>2016-01-02 17:25:35 +0300
commit32950fc846e1193769a378a1c277eeb02e5a7f9c (patch)
tree04d44f18264c930bf389f26f70ee4e3084ea88cf /emacs/guix-hydra-build.el
parent494a62f215c9b6dc66737f6a46f4c538715a56ec (diff)
downloadguix-32950fc846e1193769a378a1c277eeb02e5a7f9c.tar
guix-32950fc846e1193769a378a1c277eeb02e5a7f9c.tar.gz
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.
Diffstat (limited to 'emacs/guix-hydra-build.el')
-rw-r--r--emacs/guix-hydra-build.el362
1 files changed, 362 insertions, 0 deletions
diff --git a/emacs/guix-hydra-build.el b/emacs/guix-hydra-build.el
new file mode 100644
index 0000000000..232221e773
--- /dev/null
+++ b/emacs/guix-hydra-build.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