[PATCH qa-frontpage] Apply incoming patches onto the correct feature branch

[Vivien Kraus <vivien@planete-kraus.eu>]

It seems that the only available information of the feature branch is
in the patch name.
---

Hello guix!

Thank you for making the QA tool. It seems to me that feature branches
are ignored for patches. The patches seem to always be applied on top
of master. I get that idea because the base-for-issue-* tag is always
put on HEAD, and all my patches targetting gnome-team recently get
applied to master. I understand that the latter could be a problem
with me.

If patches are indeed applied on top of master, then the question
arises, what to do. The available information from patchwork is
scarce: the base-commit is not available, and the optional feature
branch only appears in the name of the patches of the series.

I think it is possible to parse the patch names. This way, we get some
useful information: the feature branch, the series revision, and the
patch index. The patch index can be used to make sure the patches are
in correct order (this can be the case if a server in the path
re-orders the emails).

What do you think?

Best regards,

Vivien

 guix-qa-frontpage/manage-patch-branches.scm | 80 +++++++++++++++++++--
 1 file changed, 76 insertions(+), 4 deletions(-)

diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index 7f3adb1..0512680 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -102,6 +102,55 @@
     (close-pipe pipe)
     result))
 
+(define (parse-patch-name name)
+  (let ((args
+         (and
+          (string-prefix? "[" name)
+          (let ((stop (string-index name #\])))
+            (substring name 1 stop))))
+        (as-bug-number
+         (lambda (arg)
+           (and (string-prefix? "bug#" arg)
+                (string->number (substring arg (string-length "bug#"))))))
+        (as-v2
+         (lambda (arg)
+           (and (string-prefix? "v" arg)
+                (string->number (substring arg 1)))))
+        (as-patch-number
+         (lambda (arg)
+           (match (string-split arg #\/)
+             (((= string->number index) (= string->number total))
+              (and index total (<= index total)
+                   (cons index total)))
+             (else #f)))))
+    (let analyze ((bug-number #f)
+                  (branch "master")
+                  (version 1)
+                  (index 1)
+                  (total 1)
+                  (arguments
+                   (if args
+                       (string-split args #\,)
+                       '())))
+      (match arguments
+        ((or ("") ())
+         `((bug-number . ,bug-number)
+           (branch . ,branch)
+           (version . ,version)
+           (index . ,index)
+           (total . ,total)))
+        (((= as-bug-number (? number? new-bug-number))
+          arguments ...)
+         (analyze new-bug-number branch version index total arguments))
+        (((= as-v2 (? number? new-version))
+          arguments ...)
+         (analyze bug-number branch new-version index total arguments))
+        (((= as-patch-number ((? number? new-index) . (? number? new-total)))
+          arguments ...)
+         (analyze bug-number branch version new-index new-total arguments))
+        ((feature-branch arguments ...)
+         (analyze bug-number feature-branch version index total arguments))))))
+
 (define (create-branch-for-issue issue-number patchwork-series)
   (define (apply-patches)
     (let ((series-data
@@ -116,9 +165,32 @@
                (json->scm body)))))
 
       (if (assoc-ref series-data "received_all")
-          (let* ((patch-data
-                  (vector->list
-                   (assoc-ref series-data "patches")))
+          (let* ((annotated-patch-data
+                  (map
+                   (lambda (patch)
+                     (let ((name (assoc-ref patch "name")))
+                       `((patch . ,patch)
+                         (metadata . ,(parse-patch-name name)))))
+                   (vector->list
+                    (assoc-ref series-data "patches"))))
+                 (patch-data
+                  (map
+                   (lambda (annotated)
+                     (assq-ref annotated 'patch))
+                   (stable-sort
+                    annotated-patch-data
+                    (lambda (a b)
+                      (let ((a-meta (assq-ref a 'metadata))
+                            (b-meta (assq-ref b 'metadata)))
+                        (< (assq-ref a-meta 'index)
+                           (assq-ref b-meta 'index)))))))
+                 (feature-branch
+                  (match annotated-patch-data
+                    ((p rest ...)
+                     (let ((meta (assq-ref p 'metadata)))
+                       (if meta
+                           (assq-ref meta 'branch)
+                           "master")))))
                  (branch-name
                   (simple-format #f "issue-~A" issue-number))
                  (base-tag
@@ -127,7 +199,7 @@
             (simple-format #t "all patches have been received\n")
 
             (system* "git" "tag" "--delete" base-tag)
-            (invoke "git" "tag" base-tag)
+            (invoke "git" "tag" base-tag feature-branch)
 
             (let ((patch-ids
                    (map

base-commit: 96e85c3ff9dbc55bcabeceff6ef45c54151ce7b3
-- 
2.41.0