diff options
Diffstat (limited to 'emacs/guix-hydra-build.el')
| -rw-r--r-- | emacs/guix-hydra-build.el | 362 |
1 files changed, 0 insertions, 362 deletions
diff --git a/emacs/guix-hydra-build.el b/emacs/guix-hydra-build.el deleted file mode 100644 index 232221e773..0000000000 --- a/emacs/guix-hydra-build.el +++ /dev/null @@ -1,362 +0,0 @@ -;;; 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 |