Add lots more functionality

1 files changed, 75 insertions, 1 deletions

diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
index 7d2da7d..69949e2 100644
--- a/guix-qa-frontpage/patchwork.scm
+++ b/guix-qa-frontpage/patchwork.scm
@@ -11,7 +11,10 @@
   #:use-module (guix-build-coordinator utils)
   #:export (%patchwork-instance
 
-            patchwork-patches))
+            patchwork-patches
+            latest-patchwork-series-by-issue
+
+            patchwork-patch-checks))
 
 (define %patchwork-instance
   (make-parameter "https://patches.guix-patches.cbaines.net"))
@@ -103,3 +106,74 @@
   (retry-on-error (lambda () (make-request initial-uri))
                   #:times 10
                   #:delay 5))
+
+(define* (latest-patchwork-series-by-issue
+          #:key patchwork)
+  (define (patch->issue-number patch)
+    (string->number
+     (match:substring
+      (string-match "\\[bug#([0-9]*).*\\]"
+                    (assoc-ref patch "name"))
+      1)))
+
+  (let ((result
+         (make-hash-table 2048)))
+
+    (for-each
+     (lambda (patch)
+       (let ((issue-number
+              (patch->issue-number patch))
+             (patch-series
+              (assoc-ref patch "series")))
+
+         ;; Some patches are missing series when patchwork has trouble
+         ;; processing them
+         (when (not (eq? (vector-length patch-series) 0))
+           (or (and=>
+                (hash-ref result issue-number)
+                (lambda (series)
+                  (let ((patch-series-number
+                         (assoc-ref (vector-ref patch-series 0)
+                                    "id")))
+                    (when (eq? (assoc-ref series "id")
+                               patch-series-number)
+                      (hash-set!
+                       result
+                       issue-number
+                       `(,@(alist-delete "patches" series)
+                         ("patches" . (,@(assoc-ref series "patches")
+                                       ,patch))))))))
+               (hash-set!
+                result
+                issue-number
+                `(,@(vector-ref patch-series 0)
+                  ("patches" . (,patch))))))))
+     (patchwork-patches #:patchwork patchwork))
+
+    (sort!
+     (hash-map->list cons result)
+     (lambda (a b)
+       (> (first a)
+          (first b))))))
+
+(define (patchwork-patch-checks checks-url)
+  ;; Patchwork uses http URIs, so convert here to avoid the redirect
+  (define https-uri
+    (string->uri
+     (string-append
+      "https:"
+      (string-join
+       (drop (string-split checks-url #\:) 1)
+       ":"))))
+
+  (define (make-request)
+    (let-values (((response body)
+                  (http-request https-uri
+                                #:decode-body? #f)))
+      (vector->list
+       (json-string->scm (utf8->string body)))))
+
+  (retry-on-error make-request
+                  #:times 10
+                  #:delay 5))
+