~niklaseklund/egerrit

egerrit/egerrit-zuul.el -rw-r--r-- 6.1 KiB
8953a3b9Niklas Eklund Move egerrit-dashboard command to egerrit 2 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
;;; egerrit-zuul.el --- Integate egerrit with zuul.el -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Free Software Foundation, Inc.

;; This file is not part of GNU Emacs.

;; This program 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.

;; This program 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 library provides the integration with `zuul'.

;;; Code:

;;;; Requirements

(require 'egerrit)
(require 'subr-x)

(declare-function zuul-open-build-log "zuul")
(declare-function zuul-data "zuul")
(declare-function zuul-get-builds "zuul")
(declare-function zuul-get-buildsets "zuul")

(defvar zuul-build-display-buffer-action)

;;;; Functions

;;;###autoload
(defun egerrit-zuul-setup ()
  "Setup integration with `zuul'."
  (advice-add #'egerrit-get-changes :around #'egerrit-zuul--get-changes))

;;;; Commands

;;;###autoload
(defun egerrit-zuul-open-build-log (select-buildset)
  "Open a build for the change related to the current commit.

Optionally SELECT-BUILDSET."
  (interactive "P")
  (let* ((zuul-build-display-buffer-action
          (if (eq major-mode 'egerrit-dashboard-mode)
              zuul-build-display-buffer-action
            'display-buffer-pop-up-window))
         (change (egerrit-zuul--get-change))
         (query
          (lambda ()
            (if select-buildset
                (egerrit-zuul--buildsets change)
              (let ((revision (seq-first (seq-reverse (egerrit--change-revisions change)))))
                (egerrit-zuul--builds change revision))))))
    (when change
      (zuul-open-build-log query))))

;;;; Support functions

(defun egerrit-zuul--get-change ()
  "Return change based on context."
  (when-let ((change
              (if (eq major-mode 'egerrit-dashboard-mode)
                  (tabulated-list-get-id)
                (egerrit-zuul--current-commit-change))))
    (and (egerrit-change-p change)
         (egerrit-get-detailed-change change))))

(defun egerrit-zuul--buildsets (change &optional revision)
  "Return buildsets related to CHANGE REVISION."
  `(zuul-get-buildsets
   :change ,(egerrit--change-number change)
   :patchset ,(when revision (egerrit--revision-number revision))
   :project ,(egerrit--change-project change)))

(defun egerrit-zuul--builds (change &optional revision)
  "Return builds related to CHANGE REVISION."
  `(zuul-get-builds
   :change ,(egerrit--change-number change)
   :patchset ,(when revision (egerrit--revision-number revision))
   :project ,(egerrit--change-project change)
   :limit "100"))

(defun egerrit-zuul--most-recent-buildset (change)
  "Return the most recent buildset for CHANGE."
  (when-let* ((revision
               (seq-first (seq-reverse (egerrit--change-revisions change))))
              (buildsets
               (apply (egerrit-zuul--buildsets change revision))))
    (thread-last buildsets
                 (seq-sort-by (lambda (it) (let-alist it (float-time (date-to-time .event_timestamp)))) #'>)
                 (seq-first))))

(defun egerrit-zuul--get-changes (orig-fun &rest args)
  "Add CI info to a change when calling ORIG-FUN with ARGS."
  (let* ((changes (apply orig-fun args))
         (zuul-changes (egerrit-zuul--buildset-changes)))
    (seq-map (lambda (it)
               (when-let ((build (and (egerrit-change-p it)
                                      (alist-get (egerrit--change-number it) zuul-changes))))
                 (setf (egerrit--change-ci it) build))
               it)
             changes)))

(defun egerrit-zuul--buildset-changes ()
  "Return an alist of buildset-changes."
  (let ((buildsets (zuul-get-buildsets)))
    (thread-last buildsets
                 (seq-remove (lambda (it) (let-alist (zuul-data it) .result)))
                 (seq-map (lambda (it) (let-alist (zuul-data it) (cons .change it)))))))

(defun egerrit-zuul--current-commit-change-id ()
  "Return the change-id for the current git commit."
  (let ((git-args '("--no-pager" "log" "-1"))
        (re (rx  "Change-Id: " (group (regexp ".*")))))
    (with-temp-buffer
      (apply #'process-file `("git" nil t nil ,@git-args))
      (goto-char (point-min))
      (when (search-forward-regexp re nil t)
        (match-string 1)))))

(defun egerrit-zuul--current-commit-change ()
  "Return the change for the current git commit."
  (when-let* ((change-id (egerrit-zuul--current-commit-change-id))
              (project (egerrit-zuul--current-commit-project))
              (change
               (thread-last (format "%s project:%s" change-id project)
                            (egerrit--read-changes)
                            (seq-map #'egerrit--create-change)
                            (seq-first))))
    (egerrit-get-detailed-change change)))

(defun egerrit-zuul--current-commit-project ()
  "Return the project for the current git commit."
  (let ((git-args '("config" "--get" "remote.origin.url")))
    (with-temp-buffer
      (apply #'process-file `("git" nil t nil ,@git-args))
      (string-trim
       (seq-first
        (seq-reverse
         (split-string (buffer-string) "/" t)))))))

(cl-defmethod egerrit--ci-str ((change egerrit-change))
  "Return CI representation for CHANGE."
  (if-let ((build (egerrit--change-ci change)))
      (let-alist (zuul-data build)
        (let ((pipeline-str .pipeline))
          (put-text-property 0 (length pipeline-str) 'face 'egerrit-ci-status-face pipeline-str)
          pipeline-str))
    ""))

;;;;; Keybindings

(let ((map egerrit-dashboard-mode-map))
  (define-key map (kbd "b") #'egerrit-zuul-open-build-log))

(transient-append-suffix 'egerrit-dispatch "a"
  '("b" "Builds" egerrit-zuul-open-build-log))

(provide 'egerrit-zuul)

;;; egerrit-zuul.el ends here