1 files changed, 105 insertions, 10 deletions

diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
index 8f9d570..08bf62f 100644
--- a/guix-qa-frontpage/patchwork.scm
+++ b/guix-qa-frontpage/patchwork.scm
@@ -16,10 +16,13 @@
   #:use-module ((guix-build-coordinator utils fibers)
                 #:select (retry-on-error))
   #:use-module (guix-qa-frontpage mumi)
+  #:use-module (guix-qa-frontpage utils)
   #:use-module (guix-qa-frontpage debbugs)
   #:export (%patchwork-instance
 
-            latest-patchwork-series-by-issue))
+            %patchwork-series-default-count
+            latest-patchwork-series-by-issue
+            latest-patchwork-series-for-issue))
 
 (define %patchwork-instance
   (make-parameter "https://patches.guix-patches.cbaines.net"))
@@ -77,12 +80,16 @@
          (retry-on-error
           (lambda ()
             (http-request uri
-                          #:decode-body? #f))
+                          #:port (open-socket-for-uri* uri)
+                          #:decode-body? #f
+                          #:streaming? #t))
           #:times 2
           #:delay 3)))
 
     (values
-     (json-string->scm (utf8->string body))
+     (let ((json (json->scm body)))
+       (close-port body)
+       json)
      (and=> (assq-ref (response-headers response) 'link)
             (lambda (link-header)
               (and=>
@@ -98,15 +105,93 @@
                     (assq-ref link-details 'uri)
                     (uri-scheme uri))))))))))
 
+(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 parse-issue-title
+  (let ((regex (make-regexp "\\[([A-Z\\_a-z0-9\\-]+)\\].*")))
+    (lambda (title)
+      (match (regexp-exec regex title)
+        (#f #f)
+        (m
+         (let ((branch (match:substring m 1)))
+           (if (string=? branch "PATCH")
+               #f
+               branch)))))))
+
+(define (patchwork-series->branch series)
+  (match (assoc-ref series "patches")
+    (#() "master")
+    (#(first-patch rest ...)
+     (let ((details
+            (parse-patch-name
+             (assoc-ref first-patch "name"))))
+       (assq-ref details 'branch)))))
+
+(define %patchwork-series-default-count
+  (make-parameter #f))
+
 (define* (latest-patchwork-series-by-issue
           #:key patchwork
-          count)
+          (count (%patchwork-series-default-count)))
   (define (string->issue-number str)
     (string->number
      (match:substring
       (string-match "\\[?bug#([0-9]*)(,|:|\\])" str)
       1)))
 
+  (define (strip-title-prefix str)
+    (if (string-prefix? "[" str)
+        (let ((start (string-index str #\])))
+          (string-drop str (+ 1 start)))
+        str))
+
   (define issue-number-to-series-hash-table
     (make-hash-table))
 
@@ -165,7 +250,10 @@
         ;; Need more series, so keep going
         (let* ((series-batch
                 next-page-uri
-                (request-patchwork-series patchwork-uri))
+                (with-fibers-port-timeouts
+                 (lambda ()
+                   (request-patchwork-series patchwork-uri))
+                 #:timeout 60))
 
                (batch-hash-table
                 (make-hash-table)))
@@ -230,14 +318,21 @@
                                   #t))
                             (assq-ref mumi 'merged-with)))
                       (cons
-                       `(,@data
-                         (mumi . ,mumi))
+                       `(,issue-number
+                         .
+                         (("name" . ,(strip-title-prefix
+                                      (assq-ref mumi 'title)))
+                          ,@(alist-delete "name" (cdr data) string=?)
+                          (branch . ,(or (parse-issue-title
+                                          (assq-ref mumi 'title))
+                                         (patchwork-series->branch data)))
+                          (mumi . ,mumi)))
                        result)
                       result)))
               result
               series-by-issue-number
               mumi-data)))))))
 
-
-
-
+(define* (latest-patchwork-series-for-issue issue-number #:key patchwork)
+  (assq-ref (latest-patchwork-series-by-issue #:patchwork patchwork)
+            issue-number))