From 7d64b120dcfc935819428ed5dee67b94bca0d89e Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 14 Feb 2023 19:19:29 +0000
Subject: Further tweak managing patch branches

---
 guix-qa-frontpage/manage-patch-branches.scm | 204 ++++++++++++++--------------
 1 file changed, 103 insertions(+), 101 deletions(-)

(limited to 'guix-qa-frontpage')

diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index 3b02824..0813dfa 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -222,7 +222,6 @@
     (let ((issue-numbers
            (map string->number
                 (issue-numbers-for-branches))))
-
       (with-bare-git-repository
        (lambda ()
          (simple-format #t "checking for branches to delete\n")
@@ -247,8 +246,9 @@
                                   (begin
                                     (simple-format
                                      (current-error-port)
-                                     "Removing ~A, base revision gone\n"
-                                     issue-number)
+                                     "Removing ~A, base revision (~A) gone\n"
+                                     issue-number
+                                     base-commit)
                                     #t)
                                   #f))
                           (lambda ()
@@ -261,103 +261,104 @@
                    (simple-format #f "base-for-issue-~A" issue-number))
               (run "git" "push" "patches" "--delete"
                    (simple-format #f "issue-~A" issue-number))))
-          issue-numbers)))
-
-      (simple-format #t "finished checking for branches to delete\n")
-
-      (let* ((all-patchwork-series
-              (latest-patchwork-series-by-issue))
-             (series-to-create-branches-for
-              (let ((recent-series
-                     (take all-patchwork-series
-                           150)))
-                (append
-                 recent-series
-                 (filter-map
-                  (lambda (issue-number)
-                    (if (assq-ref recent-series issue-number)
-                        #f
-                        (cons issue-number
-                              (assq-ref all-patchwork-series
-                                        issue-number))))
-                  issue-numbers)))))
-        (for-each
-         (match-lambda
-           ((issue-number . patchwork-series)
-            (when (or (not
-                       (member issue-number
-                               issue-numbers
-                               =))
-
-                      ;; Does the branch need re-creating with a new series?
-                      (let ((branch-committer-date
-                             (get-git-branch-head-committer-date
-                              (simple-format #f "patches/issue-~A" issue-number)))
-                            (patchwork-series-date
-                             (assoc-ref patchwork-series "date")))
-                        (if (and branch-committer-date
-                                 patchwork-series-date)
-                            (let* ((branch-committer-time
-                                    (date->time-utc branch-committer-date))
-                                   (patchwork-series-time
-                                    (date->time-utc
-                                     (string->date
-                                      patchwork-series-date
-                                      "~Y-~m-~dT~H:~M:~S")))
-                                   (recreate-branch?
-                                    (time<? branch-committer-time
-                                            patchwork-series-time)))
-                              (simple-format
-                               #t
-                               "considering recreating branch for issue ~A (~A, ~A, ~A)\n"
-                               issue-number
-                               branch-committer-time
-                               patchwork-series-time
-                               recreate-branch?)
-                              (time<? branch-committer-time
-                                      patchwork-series-time))
-                            #f)))
-              (simple-format #t "creating branch for issue ~A\n" issue-number)
-              (with-exception-handler
-                  (lambda (exn)
-                    (simple-format
-                     (current-error-port)
-                     "exception when creating branch for ~A: ~A\n"
-                     issue-number
-                     exn)
-
-                    (simple-format
-                     (current-error-port)
-                     "deleting tag and branch for issue\n")
-                    (system* "git" "push" "--delete" "patches"
-                             (simple-format #f "base-for-issue-~A" issue-number))
-                    (system* "git" "push" "--progress" "patches" "--delete"
-                             (simple-format #f "issue-~A" issue-number)))
-                (lambda ()
-                  (with-throw-handler #t
-                    (lambda ()
-                      (create-branch-for-issue issue-number
-                                               (number->string
-                                                (assoc-ref patchwork-series
-                                                           "id")))
-                      (clear-sqlite-cache-entry
-                       database
-                       'issue-branch-base-and-target-refs
-                       #:args (list issue-number))
-
-                      (clear-sqlite-cache-entry
-                       database
-                       'issue-patches-overall-status
-                       #:args (list issue-number)))
-                    (lambda args
-                      (display (backtrace) (current-error-port))
-                      (newline (current-error-port)))))))))
-         series-to-create-branches-for)
-
-        (simple-format (current-error-port)
-                       "finished processing patch branches (last issue: ~A)\n"
-                       (car (last series-to-create-branches-for)))))
-    (sleep 3600))
+          issue-numbers))))
+    (simple-format #t "finished checking for branches to delete\n")
+
+    (let* ((all-patchwork-series
+            (latest-patchwork-series-by-issue))
+           (issue-numbers
+            (map string->number
+                 (issue-numbers-for-branches)))
+           (series-to-create-branches-for
+            (let ((recent-series
+                   (take all-patchwork-series
+                         150)))
+              (append
+               recent-series
+               (filter-map
+                (lambda (issue-number)
+                  (if (assq-ref recent-series issue-number)
+                      #f
+                      (cons issue-number
+                            (assq-ref all-patchwork-series
+                                      issue-number))))
+                issue-numbers)))))
+      (for-each
+       (match-lambda
+         ((issue-number . patchwork-series)
+          (when (or (not
+                     (member issue-number
+                             issue-numbers
+                             =))
+
+                    ;; Does the branch need re-creating with a new series?
+                    (let ((branch-committer-date
+                           (get-git-branch-head-committer-date
+                            (simple-format #f "patches/issue-~A" issue-number)))
+                          (patchwork-series-date
+                           (assoc-ref patchwork-series "date")))
+                      (if (and branch-committer-date
+                               patchwork-series-date)
+                          (let* ((branch-committer-time
+                                  (date->time-utc branch-committer-date))
+                                 (patchwork-series-time
+                                  (date->time-utc
+                                   (string->date
+                                    patchwork-series-date
+                                    "~Y-~m-~dT~H:~M:~S")))
+                                 (recreate-branch?
+                                  (time<? branch-committer-time
+                                          patchwork-series-time)))
+                            (simple-format
+                             #t
+                             "considering recreating branch for issue ~A (~A, ~A, ~A)\n"
+                             issue-number
+                             branch-committer-time
+                             patchwork-series-time
+                             recreate-branch?)
+                            (time<? branch-committer-time
+                                    patchwork-series-time))
+                          #f)))
+            (simple-format #t "creating branch for issue ~A\n" issue-number)
+            (with-exception-handler
+                (lambda (exn)
+                  (simple-format
+                   (current-error-port)
+                   "exception when creating branch for ~A: ~A\n"
+                   issue-number
+                   exn)
+
+                  (simple-format
+                   (current-error-port)
+                   "deleting tag and branch for issue\n")
+                  (system* "git" "push" "--delete" "patches"
+                           (simple-format #f "base-for-issue-~A" issue-number))
+                  (system* "git" "push" "--progress" "patches" "--delete"
+                           (simple-format #f "issue-~A" issue-number)))
+              (lambda ()
+                (with-throw-handler #t
+                  (lambda ()
+                    (create-branch-for-issue issue-number
+                                             (number->string
+                                              (assoc-ref patchwork-series
+                                                         "id")))
+                    (clear-sqlite-cache-entry
+                     database
+                     'issue-branch-base-and-target-refs
+                     #:args (list issue-number))
+
+                    (clear-sqlite-cache-entry
+                     database
+                     'issue-patches-overall-status
+                     #:args (list issue-number)))
+                  (lambda args
+                    (display (backtrace) (current-error-port))
+                    (newline (current-error-port)))))))))
+       series-to-create-branches-for)
+
+      (simple-format (current-error-port)
+                     "finished processing patch branches (last issue: ~A)\n"
+                     (car (last series-to-create-branches-for)))))
 
   (setenv "GIT_SSH_COMMAND"
           "ssh -o StrictHostKeyChecking=no")
@@ -377,5 +378,6 @@
              (lambda args
                (display (backtrace) (current-error-port))
                (newline (current-error-port)))))
-         #:unwind? #t)))))
+         #:unwind? #t)
+       (sleep 3600)))))
 
-- 
cgit v1.2.3