diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/guix-hydra-build.el | 362 | ||||
| -rw-r--r-- | emacs/guix-hydra-jobset.el | 162 | ||||
| -rw-r--r-- | emacs/guix-hydra.el | 363 | ||||
| -rw-r--r-- | emacs/guix-utils.el | 20 |
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) |