path: root/emacs/guix-hydra-build.el

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