summaryrefslogtreecommitdiff
path: root/emacs
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
parent494a62f215c9b6dc66737f6a46f4c538715a56ec (diff)
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')
-rw-r--r--emacs/guix-hydra-build.el362
-rw-r--r--emacs/guix-hydra-jobset.el162
-rw-r--r--emacs/guix-hydra.el363
-rw-r--r--emacs/guix-utils.el20
4 files changed, 907 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
diff --git a/emacs/guix-hydra-jobset.el b/emacs/guix-hydra-jobset.el
new file mode 100644
index 0000000000..a4a55a36f2
--- /dev/null
+++ b/emacs/guix-hydra-jobset.el
@@ -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
diff --git a/emacs/guix-hydra.el b/emacs/guix-hydra.el
new file mode 100644
index 0000000000..429483946b
--- /dev/null
+++ b/emacs/guix-hydra.el
@@ -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
diff --git a/emacs/guix-utils.el b/emacs/guix-utils.el
index 98a408f875..8c1a5b42de 100644
--- a/emacs/guix-utils.el
+++ b/emacs/guix-utils.el
@@ -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)