diff options
| -rw-r--r-- | guix-qa-frontpage/mumi.scm | 47 | ||||
| -rw-r--r-- | guix-qa-frontpage/patchwork.scm | 20 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 27 |
3 files changed, 69 insertions, 25 deletions
diff --git a/guix-qa-frontpage/mumi.scm b/guix-qa-frontpage/mumi.scm index d1d7839..bef358d 100644 --- a/guix-qa-frontpage/mumi.scm +++ b/guix-qa-frontpage/mumi.scm @@ -18,8 +18,13 @@ (define-module (guix-qa-frontpage mumi) #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:use-module (kolam http) - #:export (mumi-issue-tags)) + #:use-module ((guix-data-service utils) #:select (chunk-for-each!)) + #:export (mumi-issue-tags + mumi-issue-open? + + mumi-bulk-issues)) (define (mumi-issue-tags number) (with-exception-handler @@ -37,3 +42,43 @@ (assoc-ref (cdr (first response)) "tags")))) #:unwind? #t)) + +(define (mumi-issue-open? number) + (let ((response + (graphql-http-get "https://issues.guix.gnu.org/graphql" + `(document (query (#(issue #:number ,number) open)))))) + (assoc-ref (cdr (first response)) + "open"))) + +(define (mumi-bulk-issues numbers) + (let ((number-to-data + (make-hash-table))) + + (chunk-for-each! + (lambda (chunk) + (let ((response + (graphql-http-get + "https://issues.guix.gnu.org/graphql" + `(document + ,@(map (lambda (number) + `(query (#(issue #:number ,number) + number title open severity tags))) + chunk))))) + + (for-each + (lambda (res) + (let ((data (cdr res))) + (hash-set! number-to-data + (assoc-ref data "number") + `((title . ,(assoc-ref data "title")) + (open? . ,(assoc-ref data "open")) + (tags . ,(vector->list + (assoc-ref data "tags"))) + (severity . ,(assoc-ref data "severity")))))) + response))) + 30 + (list-copy numbers)) + + (map (lambda (number) + (hash-ref number-to-data number)) + numbers))) diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm index 69949e2..cd5bc26 100644 --- a/guix-qa-frontpage/patchwork.scm +++ b/guix-qa-frontpage/patchwork.scm @@ -9,6 +9,7 @@ #:use-module (web request) #:use-module (web response) #:use-module (guix-build-coordinator utils) + #:use-module (guix-qa-frontpage mumi) #:export (%patchwork-instance patchwork-patches @@ -150,11 +151,20 @@ ("patches" . (,patch)))))))) (patchwork-patches #:patchwork patchwork)) - (sort! - (hash-map->list cons result) - (lambda (a b) - (> (first a) - (first b)))))) + (let* ((data (hash-map->list cons result)) + (mumi-data (mumi-bulk-issues + (map first data)))) + (sort! + (filter-map (lambda (data mumi) + (if (assq-ref mumi 'open?) + `(,@data + (mumi . ,mumi)) + #f)) + data + mumi-data) + (lambda (a b) + (> (first a) + (first b))))))) (define (patchwork-patch-checks checks-url) ;; Patchwork uses http URIs, so convert here to avoid the redirect diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index e914c00..b3ebddf 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -283,13 +283,7 @@ 'latest-patchwork-series-by-issue latest-patchwork-series-by-issue #:ttl 1200) - (string->number number))) - (mumi-tags (with-sqlite-cache - database - 'mumi-issue-tags - mumi-issue-tags - #:args (list number) - #:ttl 60))) + (string->number number)))) (if series (let ((derivation-changes change-details @@ -331,7 +325,8 @@ (render-html #:sxml (issue-view number series - mumi-tags + (assq-ref (assq-ref series 'mumi) + 'tags) derivation-changes change-details comparison-details))) @@ -426,23 +421,17 @@ port. Also, the port used can be changed by passing the --port option.\n" 'derivation-changes patch-series-derivation-changes #:args (list url) - #:ttl (* 60 20))))) - (mumi-tags - (with-sqlite-cache - database - 'mumi-issue-tags - mumi-issue-tags - #:args (list (car series)) - #:ttl 60))) + #:ttl (* 60 20)))))) (and derivation-changes - mumi-tags (with-sqlite-cache database 'issue-patches-overall-status (lambda (id) - (issue-patches-overall-status derivation-changes - mumi-tags)) + (issue-patches-overall-status + derivation-changes + (assq-ref (assq-ref series 'mumi) + 'tags))) #:args (list (car series)) #:ttl 0))))) latest-series |