Check if all patches have been received earlier

1 files changed, 104 insertions, 105 deletions

diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index 616a300..56f0ae6 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -220,116 +220,115 @@
 
       (insert-create-branch-for-issue-log database issue-number log))
 
-    (if (assoc-ref patchwork-series "received_all")
-        (begin
-          (simple-format #t "all patches have been received\n")
-          (create-base-tag)
-
-          (let loop ((patch-data
-                      (vector->list
-                       (assoc-ref patchwork-series "patches")))
-                     (results '()))
-            (if (null? patch-data)
+    (create-base-tag)
+
+    (let loop ((patch-data
+                (vector->list
+                 (assoc-ref patchwork-series "patches")))
+               (results '()))
+      (if (null? patch-data)
+          (begin
+            (insert-log results)
+
+            (if (string=? (base-commit-hash)
+                          (with-repository (getcwd) repository
+                            (oid->string
+                             (reference-name->oid repository "HEAD"))))
+                (simple-format
+                 (current-error-port)
+                 "Commit hashes match, so no patches have been applied\n")
                 (begin
-                  (insert-log results)
-
-                  (if (string=? (base-commit-hash)
-                                (with-repository (getcwd) repository
-                                  (oid->string
-                                   (reference-name->oid repository "HEAD"))))
+                  (push)
+                  (clear-cache))))
+          (let* ((patch (car patch-data))
+                 (name (assoc-ref patch "name"))
+                 (id   (assoc-ref patch "id")))
+
+            (simple-format #t "Running git am --ignore-whitespace --empty=drop --3way \"~A.patch\" (~A)\n" id name)
+            (let ((patch-file
+                   (simple-format #f "~A.patch" id)))
+              (call-with-output-file patch-file
+                (lambda (output)
+                  (let ((port
+                         size
+                         (http-fetch
+                          (string->uri (assoc-ref patch "mbox")))))
+                    (dump-port port output))))
+
+              (simple-format #t "applying ~A\n" patch-file)
+              (let* ((code
+                      output
+                      (invoke/capture-output
+                       "git" "am"
+                       "--empty=drop"
+                       ;; As seen in #66110, there's potentially
+                       ;; something going wrong in Patchwork when
+                       ;; handling carriage return characters that need
+                       ;; to be included in the diff, but this option
+                       ;; seems to work around that
+                       "--ignore-whitespace"
+                       "--3way" patch-file))
+                     (new-results
+                      `(((id . ,id)
+                         (name . ,name)
+                         (output . ,output))
+                        ,@results)))
+                (if (zero? (status:exit-val (cdr code)))
+                    (loop (cdr patch-data)
+                          new-results)
+                    (begin
                       (simple-format
-                       (current-error-port)
-                       "Commit hashes match, so no patches have been applied\n")
-                      (begin
-                        (push)
-                        (clear-cache))))
-                (let* ((patch (car patch-data))
-                       (name (assoc-ref patch "name"))
-                       (id   (assoc-ref patch "id")))
-
-                  (simple-format #t "Running git am --ignore-whitespace --empty=drop --3way \"~A.patch\" (~A)\n" id name)
-                  (let ((patch-file
-                         (simple-format #f "~A.patch" id)))
-                    (call-with-output-file patch-file
-                      (lambda (output)
-                        (let ((port
-                               size
-                               (http-fetch
-                                (string->uri (assoc-ref patch "mbox")))))
-                          (dump-port port output))))
-
-                    (simple-format #t "applying ~A\n" patch-file)
-                    (let* ((code
-                            output
-                            (invoke/capture-output
-                             "git" "am"
-                             "--empty=drop"
-                             ;; As seen in #66110, there's potentially
-                             ;; something going wrong in Patchwork when
-                             ;; handling carriage return characters that need
-                             ;; to be included in the diff, but this option
-                             ;; seems to work around that
-                             "--ignore-whitespace"
-                             "--3way" patch-file))
-                           (new-results
-                            `(((id . ,id)
-                               (name . ,name)
-                               (output . ,output))
-                              ,@results)))
-                      (if (zero? (status:exit-val (cdr code)))
-                          (loop (cdr patch-data)
-                                new-results)
-                          (begin
-                            (simple-format
-                             #t "Failed to apply \"~A.patch\" (~A)\n" id name)
-                            (insert-log new-results)
-                            #f))))))))
-        (simple-format
-         #t
-         "issue ~A (series: ~A): all patches have not been received, skipping\n"
-         issue-number
-         (assoc-ref patchwork-series "id"))))
-
-  (let ((latest-master-commit
-         (get-latest-processed-branch-revision "master")))
-
-    (with-bare-git-repository
-     (lambda ()
-       (invoke "git" "fetch" "--prune" "origin")
-       (system* "git" "worktree" "remove" "--force"
-                (simple-format #f "../issue-~A" issue-number))
-       (system* "git" "branch" "-D"
-                (simple-format #f "issue-~A" issue-number))))
-
-    (with-git-worktree
-     (simple-format #f "issue-~A" issue-number)
-     latest-master-commit
-     (lambda ()
-       (with-exception-handler
-           (lambda (exn)
-             (simple-format
-              (current-error-port)
-              "exception when creating branch for ~A: ~A\n"
-              issue-number
-              exn)
+                       #t "Failed to apply \"~A.patch\" (~A)\n" id name)
+                      (insert-log new-results)
+                      #f))))))))
 
-             (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))
+  (if (not (assoc-ref patchwork-series "received_all"))
+      (simple-format
+       #t
+       "issue ~A (series: ~A): all patches have not been received, skipping\n"
+       issue-number
+       (assoc-ref patchwork-series "id"))
+
+      (let ((latest-master-commit
+             (get-latest-processed-branch-revision "master")))
 
-             (raise-exception exn))
+        (with-bare-git-repository
          (lambda ()
-           (with-throw-handler #t
-             apply-patches
-             (lambda args
-               (display (backtrace) (current-error-port))
-               (newline (current-error-port)))))
-         #:unwind? #t))
-     #:remove-after? #t)))
+           (invoke "git" "fetch" "--prune" "origin")
+           (system* "git" "worktree" "remove" "--force"
+                    (simple-format #f "../issue-~A" issue-number))
+           (system* "git" "branch" "-D"
+                    (simple-format #f "issue-~A" issue-number))))
+
+        (with-git-worktree
+         (simple-format #f "issue-~A" issue-number)
+         latest-master-commit
+         (lambda ()
+           (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))
+
+                 (raise-exception exn))
+             (lambda ()
+               (with-throw-handler #t
+                 apply-patches
+                 (lambda args
+                   (display (backtrace) (current-error-port))
+                   (newline (current-error-port)))))
+             #:unwind? #t))
+         #:remove-after? #t))))
 
 (define* (start-manage-patch-branches-thread database
                                              metrics-registry