diff options
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 67 | ||||
| -rw-r--r-- | guix-qa-frontpage/patchwork.scm | 72 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 30 |
3 files changed, 90 insertions, 79 deletions
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index c3ae256..16bfbd9 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -30,8 +30,6 @@ #:use-module (guix-qa-frontpage guix-data-service) #:export (create-branch-for-issue - patchwork-series->branch - start-manage-patch-branches-thread get-issue-branch-base-and-target-refs)) @@ -129,64 +127,6 @@ (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 (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 (create-branch-for-issue database issue-number patchwork-series) (define branch-name (simple-format #f "issue-~A" issue-number)) @@ -196,7 +136,7 @@ (define (get-base-commit) (let ((branch - (patchwork-series->branch patchwork-series))) + (assq-ref patchwork-series 'branch))) (if (string=? branch "master") (get-latest-processed-branch-revision "master") @@ -424,8 +364,9 @@ (assq-ref (get-issue-branch-base-and-target-refs issue-number) 'base)) - (branch (patchwork-series->branch - (assq-ref all-patchwork-series issue-number)))) + (branch + (assq-ref (assq-ref all-patchwork-series issue-number) + 'branch))) (with-exception-handler (lambda (exn) (if (and (guix-data-service-error? exn) diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm index 8f9d570..b4e0f66 100644 --- a/guix-qa-frontpage/patchwork.scm +++ b/guix-qa-frontpage/patchwork.scm @@ -98,6 +98,75 @@ (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* (latest-patchwork-series-by-issue #:key patchwork count) @@ -231,6 +300,9 @@ (assq-ref mumi 'merged-with))) (cons `(,@data + (branch . ,(or (parse-issue-title + (assq-ref mumi 'title)) + (patchwork-series->branch data))) (mumi . ,mumi)) result) result))) diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 8db6aae..e7b25d6 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -35,6 +35,8 @@ #:use-module (guix store) #:use-module ((guix build syscalls) #:select (set-thread-name)) + #:use-module ((guix-data-service utils) + #:select (delete-duplicates/sort!)) #:use-module (guix-data-service web util) #:use-module ((guix-data-service web query-parameters) #:select (parse-query-string)) @@ -260,16 +262,13 @@ symbol-key #f)))) query-params)) - (latest-series-branches - (map - (match-lambda - ((_ . series) - (patchwork-series->branch series))) - latest-series)) (branch-options - (sort (delete-duplicates - latest-series-branches) - string<?)) + (reverse + (delete-duplicates/sort! + (map (lambda (series) + (assq-ref series 'branch)) + latest-series) + string<?))) (filtered-branches (filter-map (match-lambda @@ -280,7 +279,7 @@ query-params)) (latest-series-with-overall-statuses (filter-map - (lambda (series branch) + (lambda (series) (let ((overall-status (with-sqlite-cache database @@ -288,7 +287,9 @@ (const 'unknown) #:store-computed-value? #f #:args (list (first series)) - #:ttl 3600))) + #:ttl 3600)) + (branch + (assq-ref series 'branch))) (if (and (or (null? filtered-statuses) (member overall-status filtered-statuses)) @@ -298,8 +299,7 @@ `((branch . ,branch) (overall-status . ,overall-status))) #f))) - latest-series - latest-series-branches)) + latest-series)) (sorted-latest-series (sort latest-series-with-overall-statuses @@ -619,8 +619,6 @@ (select-create-branch-for-issue-log database number)) - (branch - (patchwork-series->branch series)) (master-branch-substitute-availability systems-with-low-substitute-availability master-branch-package-reproducibility @@ -633,7 +631,7 @@ (render-html #:sxml (issue-view number series - branch + (assq-ref series 'branch) (assq-ref (assq-ref series 'mumi) 'tags) base-and-target-refs |