emacs/guix-hydra.el

   1 ;;; guix-hydra.el --- Common code for interacting with Hydra  -*- lexical-binding: t -*-
   2
   3 ;; Copyright © 2015 Alex Kost <alezost@gmail.com>
   4
   5 ;; This file is part of GNU Guix.
   6
   7 ;; GNU Guix is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Guix is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file provides some general code for 'list'/'info' interfaces for
  23 ;; Hydra (Guix build farm).
  24
  25 ;;; Code:
  26
  27 (require 'json)
  28 (require 'guix-buffer)
  29 (require 'guix-entry)
  30 (require 'guix-utils)
  31 (require 'guix-help-vars)
  32
  33 (guix-define-groups hydra)
  34
  35 (defvar guix-hydra-job-regexp
  36   (concat ".*\\." (regexp-opt guix-help-system-types) "\\'")
  37   "Regexp matching a full name of Hydra job (including system).")
  38
  39 (defun guix-hydra-job-name-specification (name version)
  40   "Return Hydra's job name specification by NAME and VERSION."
  41   (concat name "-" version))
  42
  43 (defun guix-hydra-message (entries search-type &rest _)
  44   "Display a message after showing Hydra ENTRIES."
  45   ;; XXX Add more messages maybe.
  46   (when (null entries)
  47     (if (eq search-type 'fake)
  48         (message "The update is impossible due to lack of Hydra API.")
  49       (message "Hydra has returned no results."))))
  50
  51 (defun guix-hydra-list-describe (ids)
  52   "Describe 'hydra' entries with IDS (list of identifiers)."
  53   (guix-buffer-display-entries
  54    (guix-entries-by-ids ids (guix-buffer-current-entries))
  55    'info (guix-buffer-current-entry-type)
  56    ;; Hydra does not provide an API to receive builds/jobsets by
  57    ;; IDs/names, so we use a 'fake' search type.
  58    '(fake)
  59    'add))
  60
  61 \f
  62 ;;; Readers
  63
  64 (defvar guix-hydra-projects
  65   '("gnu" "guix")
  66   "List of available Hydra projects.")
  67
  68 (guix-define-readers
  69  :completions-var guix-hydra-projects
  70  :single-reader guix-hydra-read-project
  71  :single-prompt "Project: ")
  72
  73 (guix-define-readers
  74  :single-reader guix-hydra-read-jobset
  75  :single-prompt "Jobset: ")
  76
  77 (guix-define-readers
  78  :single-reader guix-hydra-read-job
  79  :single-prompt "Job: ")
  80
  81 (guix-define-readers
  82  :completions-var guix-help-system-types
  83  :single-reader guix-hydra-read-system
  84  :single-prompt "System: ")
  85
  86 \f
  87 ;;; Defining URLs
  88
  89 (defvar guix-hydra-url "http://hydra.gnu.org"
  90   "URL of the Hydra build farm.")
  91
  92 (defun guix-hydra-url (&rest url-parts)
  93   "Return Hydra URL."
  94   (apply #'concat guix-hydra-url "/" url-parts))
  95
  96 (defun guix-hydra-api-url (type args)
  97   "Return URL for receiving data using Hydra API.
  98 TYPE is the name of an allowed method.
  99 ARGS is alist of (KEY . VALUE) pairs.
 100 Skip ARG, if VALUE is nil or an empty string."
 101   (declare (indent 1))
 102   (let* ((fields (mapcar
 103                   (lambda (arg)
 104                     (pcase arg
 105                       (`(,key . ,value)
 106                        (unless (or (null value)
 107                                    (equal "" value))
 108                          (concat (guix-hexify key) "="
 109                                  (guix-hexify value))))
 110                       (_ (error "Wrong argument '%s'" arg))))
 111                   args))
 112          (fields (mapconcat #'identity (delq nil fields) "&")))
 113     (guix-hydra-url "api/" type "?" fields)))
 114
 115 \f
 116 ;;; Receiving data from Hydra
 117
 118 (defun guix-hydra-receive-data (url)
 119   "Return output received from URL and processed with `json-read'."
 120   (with-temp-buffer
 121     (url-insert-file-contents url)
 122     (goto-char (point-min))
 123     (let ((json-key-type 'symbol)
 124           (json-array-type 'list)
 125           (json-object-type 'alist))
 126       (json-read))))
 127
 128 (defun guix-hydra-get-entries (entry-type search-type &rest args)
 129   "Receive ENTRY-TYPE entries from Hydra.
 130 SEARCH-TYPE is one of the types defined by `guix-hydra-define-interface'."
 131   (unless (eq search-type 'fake)
 132     (let* ((url         (apply #'guix-hydra-search-url
 133                                entry-type search-type args))
 134            (raw-entries (guix-hydra-receive-data url))
 135            (entries     (guix-hydra-filter-entries
 136                          raw-entries
 137                          (guix-hydra-filters entry-type))))
 138       entries)))
 139
 140 \f
 141 ;;; Filters for processing raw entries
 142
 143 (defun guix-hydra-filter-entries (entries filters)
 144   "Filter ENTRIES using FILTERS.
 145 Call `guix-modify' on each entry from ENTRIES."
 146   (mapcar (lambda (entry)
 147             (guix-modify entry filters))
 148           entries))
 149
 150 (defun guix-hydra-filter-names (entry name-alist)
 151   "Replace names of ENTRY parameters using NAME-ALIST.
 152 Each element of NAME-ALIST is (OLD-NAME . NEW-NAME) pair."
 153   (mapcar (lambda (param)
 154             (pcase param
 155               (`(,name . ,val)
 156                (let ((new-name (guix-assq-value name-alist name)))
 157                  (if new-name
 158                      (cons new-name val)
 159                    param)))))
 160           entry))
 161
 162 (defun guix-hydra-filter-boolean (entry params)
 163   "Convert number PARAMS (0/1) of ENTRY to boolean values (nil/t)."
 164   (mapcar (lambda (param)
 165             (pcase param
 166               (`(,name . ,val)
 167                (if (memq name params)
 168                    (cons name (guix-number->bool val))
 169                  param))))
 170           entry))
 171
 172 \f
 173 ;;; Wrappers for defined variables
 174
 175 (defvar guix-hydra-entry-type-data nil
 176   "Alist with hydra entry type data.
 177 This alist is filled by `guix-hydra-define-entry-type' macro.")
 178
 179 (defun guix-hydra-entry-type-value (entry-type symbol)
 180   "Return SYMBOL's value for ENTRY-TYPE from `guix-hydra'."
 181   (symbol-value (guix-assq-value guix-hydra-entry-type-data
 182                                  entry-type symbol)))
 183
 184 (defun guix-hydra-search-url (entry-type search-type &rest args)
 185   "Return URL to receive ENTRY-TYPE entries from Hydra."
 186   (apply (guix-assq-value (guix-hydra-entry-type-value
 187                            entry-type 'search-types)
 188                           search-type)
 189          args))
 190
 191 (defun guix-hydra-filters (entry-type)
 192   "Return a list of filters for ENTRY-TYPE."
 193   (guix-hydra-entry-type-value entry-type 'filters))
 194
 195 \f
 196 ;;; Interface definers
 197
 198 (defmacro guix-hydra-define-entry-type (entry-type &rest args)
 199   "Define general code for ENTRY-TYPE.
 200 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 201
 202 Required keywords:
 203
 204   - `:search-types' - default value of the generated
 205     `guix-ENTRY-TYPE-search-types' variable.
 206
 207 Optional keywords:
 208
 209   - `:filters' - default value of the generated
 210     `guix-ENTRY-TYPE-filters' variable.
 211
 212   - `:filter-names' - if specified, a generated
 213     `guix-ENTRY-TYPE-filter-names' function for filtering these
 214     names will be added to `guix-ENTRY-TYPE-filters' variable.
 215
 216   - `:filter-boolean-params' - if specified, a generated
 217     `guix-ENTRY-TYPE-filter-boolean' function for filtering these
 218     names will be added to `guix-ENTRY-TYPE-filters' variable.
 219
 220 The rest keyword arguments are passed to
 221 `guix-define-entry-type' macro."
 222   (declare (indent 1))
 223   (let* ((entry-type-str     (symbol-name entry-type))
 224          (prefix             (concat "guix-" entry-type-str))
 225          (search-types-var   (intern (concat prefix "-search-types")))
 226          (filters-var        (intern (concat prefix "-filters")))
 227          (get-fun            (intern (concat prefix "-get-entries"))))
 228     (guix-keyword-args-let args
 229         ((search-types-val   :search-types)
 230          (filters-val        :filters)
 231          (filter-names-val   :filter-names)
 232          (filter-bool-val    :filter-boolean-params))
 233       `(progn
 234          (defvar ,search-types-var ,search-types-val
 235            ,(format "\
 236 Alist of search types and according URL functions.
 237 Functions are used to define URL to receive '%s' entries."
 238                     entry-type-str))
 239
 240          (defvar ,filters-var ,filters-val
 241            ,(format "\
 242 List of filters for '%s' parameters.
 243 Each filter is a function that should take an entry as a single
 244 argument, and should also return an entry."
 245                     entry-type-str))
 246
 247          ,(when filter-bool-val
 248             (let ((filter-bool-var (intern (concat prefix
 249                                                    "-filter-boolean-params")))
 250                   (filter-bool-fun (intern (concat prefix
 251                                                    "-filter-boolean"))))
 252               `(progn
 253                  (defvar ,filter-bool-var ,filter-bool-val
 254                    ,(format "\
 255 List of '%s' parameters that should be transformed to boolean values."
 256                             entry-type-str))
 257
 258                  (defun ,filter-bool-fun (entry)
 259                    ,(format "\
 260 Run `guix-hydra-filter-boolean' with `%S' variable."
 261                             filter-bool-var)
 262                    (guix-hydra-filter-boolean entry ,filter-bool-var))
 263
 264                  (setq ,filters-var
 265                        (cons ',filter-bool-fun ,filters-var)))))
 266
 267          ;; Do not move this clause up!: name filtering should be
 268          ;; performed before any other filtering, so this filter should
 269          ;; be consed after the boolean filter.
 270          ,(when filter-names-val
 271             (let* ((filter-names-var (intern (concat prefix
 272                                                      "-filter-names")))
 273                    (filter-names-fun filter-names-var))
 274               `(progn
 275                  (defvar ,filter-names-var ,filter-names-val
 276                    ,(format "\
 277 Alist of '%s' parameter names returned by Hydra API and names
 278 used internally by the elisp code of this package."
 279                             entry-type-str))
 280
 281                  (defun ,filter-names-fun (entry)
 282                    ,(format "\
 283 Run `guix-hydra-filter-names' with `%S' variable."
 284                             filter-names-var)
 285                    (guix-hydra-filter-names entry ,filter-names-var))
 286
 287                  (setq ,filters-var
 288                        (cons ',filter-names-fun ,filters-var)))))
 289
 290          (defun ,get-fun (search-type &rest args)
 291            ,(format "\
 292 Receive '%s' entries.
 293 See `guix-hydra-get-entries' for details."
 294                     entry-type-str)
 295            (apply #'guix-hydra-get-entries
 296                   ',entry-type search-type args))
 297
 298          (guix-alist-put!
 299           '((search-types . ,search-types-var)
 300             (filters      . ,filters-var))
 301           'guix-hydra-entry-type-data ',entry-type)
 302
 303          (guix-define-entry-type ,entry-type
 304            :parent-group guix-hydra
 305            :parent-faces-group guix-hydra-faces
 306            ,@%foreign-args)))))
 307
 308 (defmacro guix-hydra-define-interface (buffer-type entry-type &rest args)
 309   "Define BUFFER-TYPE interface for displaying ENTRY-TYPE entries.
 310
 311 This macro should be called after calling
 312 `guix-hydra-define-entry-type' with the same ENTRY-TYPE.
 313
 314 ARGS are passed to `guix-BUFFER-TYPE-define-interface' macro."
 315   (declare (indent 2))
 316   (let* ((entry-type-str  (symbol-name entry-type))
 317          (buffer-type-str (symbol-name buffer-type))
 318          (get-fun         (intern (concat "guix-" entry-type-str
 319                                           "-get-entries")))
 320          (definer         (intern (concat "guix-" buffer-type-str
 321                                           "-define-interface"))))
 322     `(,definer ,entry-type
 323        :get-entries-function ',get-fun
 324        :message-function 'guix-hydra-message
 325        ,@args)))
 326
 327 (defmacro guix-hydra-info-define-interface (entry-type &rest args)
 328   "Define 'info' interface for displaying ENTRY-TYPE entries.
 329 See `guix-hydra-define-interface'."
 330   (declare (indent 1))
 331   `(guix-hydra-define-interface info ,entry-type
 332      ,@args))
 333
 334 (defmacro guix-hydra-list-define-interface (entry-type &rest args)
 335   "Define 'list' interface for displaying ENTRY-TYPE entries.
 336 Remaining arguments (ARGS) should have a form [KEYWORD VALUE] ...
 337
 338 Optional keywords:
 339
 340   - `:describe-function' - default value of the generated
 341     `guix-ENTRY-TYPE-list-describe-function' variable (if not
 342     specified, use `guix-hydra-list-describe').
 343
 344 The rest keyword arguments are passed to
 345 `guix-hydra-define-interface' macro."
 346   (declare (indent 1))
 347   (guix-keyword-args-let args
 348       ((describe-val :describe-function))
 349     `(guix-hydra-define-interface list ,entry-type
 350        :describe-function ,(or describe-val ''guix-hydra-list-describe)
 351        ,@args)))
 352
 353 \f
 354 (defvar guix-hydra-font-lock-keywords
 355   (eval-when-compile
 356     `((,(rx "(" (group (or "guix-hydra-define-entry-type"
 357                            "guix-hydra-define-interface"
 358                            "guix-hydra-info-define-interface"
 359                            "guix-hydra-list-define-interface"))
 360             symbol-end)
 361        . 1))))
 362
 363 (font-lock-add-keywords 'emacs-lisp-mode guix-hydra-font-lock-keywords)
 364
 365 (provide 'guix-hydra)
 366
 367 ;;; guix-hydra.el ends here