;;; 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