aboutsummaryrefslogtreecommitdiff
path: root/guix-qa-frontpage/view
diff options
context:
space:
mode:
Diffstat (limited to 'guix-qa-frontpage/view')
-rw-r--r--guix-qa-frontpage/view/branch.scm12
-rw-r--r--guix-qa-frontpage/view/branches.scm22
-rw-r--r--guix-qa-frontpage/view/issue.scm9
-rw-r--r--guix-qa-frontpage/view/shared.scm107
-rw-r--r--guix-qa-frontpage/view/util.scm17
5 files changed, 97 insertions, 70 deletions
diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm
index 5c7c94f..d7c93f7 100644
--- a/guix-qa-frontpage/view/branch.scm
+++ b/guix-qa-frontpage/view/branch.scm
@@ -5,6 +5,7 @@
#:use-module (ice-9 format)
#:use-module ((guix-data-service model utils) #:select (group-to-alist))
#:use-module (guix-qa-frontpage manage-builds)
+ #:use-module (guix-qa-frontpage guix-data-service)
#:use-module (guix-qa-frontpage derivation-changes)
#:use-module (guix-qa-frontpage view util)
#:use-module (guix-qa-frontpage view shared)
@@ -13,16 +14,11 @@
master-branch-view))
-(define (branch-view branch revisions derivation-changes
+(define (branch-view branch revisions derivation-changes-counts
substitute-availability
package-reproducibility
up-to-date-with-master
master-branch-systems-with-low-substitute-availability)
- (define derivation-changes-counts
- (if (assq-ref derivation-changes 'exception)
- derivation-changes
- (assq-ref derivation-changes 'counts)))
-
(layout
#:title (simple-format #f "Branch ~A" branch)
#:head
@@ -58,7 +54,9 @@ td.bad {
"View Git branch"))
(li
(a (@ (href ,(simple-format
- #f "https://data.qa.guix.gnu.org/repository/2/branch/~A"
+ #f "~A/repository/~A/branch/~A"
+ %data-service-url-base
+ %data-service-guix-repository-id
branch)))
"View branch with Guix Data Service"))))
diff --git a/guix-qa-frontpage/view/branches.scm b/guix-qa-frontpage/view/branches.scm
index 90d1da7..9573d2b 100644
--- a/guix-qa-frontpage/view/branches.scm
+++ b/guix-qa-frontpage/view/branches.scm
@@ -10,10 +10,22 @@
#:body
`((main
(table
+ (thead
+ (tr (th "Branch")
+ (th "Request to merge")))
(tbody
- ,@(map (lambda (branch-details)
- (let ((name (assoc-ref branch-details "name")))
- `(tr
- (td (a (@ (href ,(simple-format #f "/branch/~A" name)))
- ,name)))))
+ ,@(map (match-lambda
+ ((name . details)
+ (let ((issue-number
+ (assoc-ref details "issue_number")))
+ `(tr
+ (td (a (@ (href ,(simple-format #f "/branch/~A" name))
+ (style "font-family: monospace;"))
+ ,name))
+ (td ,@(if issue-number
+ `((a (@ (href ,(string-append
+ "https://issues.guix.gnu.org/"
+ (number->string issue-number))))
+ "#" ,issue-number))
+ '()))))))
branches)))))))
diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index 4e851f8..567ba24 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -78,7 +78,7 @@
(simple-format
#f
"~A/log/?h=~A&qt=range&q=~A..~A"
- "https://git.guix-patches.cbaines.net/guix-patches"
+ "https://git.qa.guix.gnu.org/guix-patches"
branch-name base-tag branch-name))))
"View Git branch")))
'())
@@ -258,7 +258,10 @@
patches to record a review, which will highlight that these patches should be
ready to merge.")
- (p "Here's a list of common things to check, tick them off as you review
+ (p "There's some "
+ (a (@ (href "https://guix.gnu.org/manual/devel/en/html_node/Reviewing-the-Work-of-Others.html"))
+ "guidance in the manual about reviewing patches")
+ ". Here's a list of common things to check, tick them off as you review
the patches:"))
,@(map
@@ -475,5 +478,5 @@ Guix QA review form submission:"
(uri-encode email-text))))
(b "Open mail client to send review email"))
(p "If the above link doesn't work for you, the contents of the suggested email is given below, and can be sent "
- (strong "to control@debbugs.gnu.org and 66195@debbugs.gnu.org"))
+ (strong "to control@debbugs.gnu.org and " ,issue-number "@debbugs.gnu.org"))
(pre ,email-text)))))
diff --git a/guix-qa-frontpage/view/shared.scm b/guix-qa-frontpage/view/shared.scm
index 708ac63..804923b 100644
--- a/guix-qa-frontpage/view/shared.scm
+++ b/guix-qa-frontpage/view/shared.scm
@@ -745,55 +745,64 @@
(td (@ (colspan 10)
(class "bad"))
"Comparison unavailable"
- ,@(or (and=>
- (assq-ref derivation-changes-counts
- 'invalid_query_parameters)
- (lambda (params)
- (append-map
- (match-lambda
- ((param . details)
- (let ((error
- (assq-ref details 'error)))
- (cond
- ((member param '("base_commit"
- "target_commit"))
- `((br)
- (a
- (@ (href
- ,(string-append
- "https://data.qa.guix.gnu.org"
- "/revision/"
- (assq-ref
- revisions
- (if (string=? param "base_commit")
- 'base
- 'target)))))
- ,(cond
- ((eq? error 'unknown-commit)
- (string-append
- (if (string=? param "base_commit")
- "Base revision "
- "Target revision ")
- "unknown to the data service."))
- ((member error
- '(yet-to-process-revision
- failed-to-process-revision))
- (simple-format
- #f "~A to process ~A"
- (if (eq? error 'yet-to-process-revision)
- "Yet"
- "Failed")
- (if (string=? param "base_commit")
- "base revision (from master branch)"
- "target revision")))
- (else
- (string-append
- "Error with "
- (if (string=? param "base_commit")
- "base revision."
- "target revision.")))))))))))
- params)))
- '()))))))))
+ ,@(cond
+ ((eq? (assq-ref derivation-changes-counts 'exception)
+ 'guix-data-service-invalid-parameters)
+ (append-map
+ (match-lambda
+ ((param . details)
+ (let ((error
+ (assq-ref details 'error)))
+ (cond
+ ((member param '("base_commit"
+ "target_commit"))
+ `((br)
+ (a
+ (@ (href
+ ,(string-append
+ "https://data.qa.guix.gnu.org"
+ "/revision/"
+ (assq-ref
+ revisions
+ (if (string=? param "base_commit")
+ 'base
+ 'target)))))
+ ,(cond
+ ((eq? error 'unknown-commit)
+ (string-append
+ (if (string=? param "base_commit")
+ "Base revision "
+ "Target revision ")
+ "unknown to the data service."))
+ ((member error
+ '(yet-to-process-revision
+ failed-to-process-revision))
+ (simple-format
+ #f "~A to process ~A"
+ (if (eq? error 'yet-to-process-revision)
+ "Yet"
+ "Failed")
+ (if (string=? param "base_commit")
+ "base revision (from master branch)"
+ "target revision")))
+ (else
+ (string-append
+ "Error with "
+ (if (string=? param "base_commit")
+ "base revision."
+ "target revision.")))))))))))
+ (assq-ref derivation-changes-counts
+ 'invalid_query_parameters)))
+ ((eq? (assq-ref derivation-changes-counts 'exception)
+ 'guix-data-service-exception)
+ (let ((url
+ (assq-ref derivation-changes-counts 'url)))
+ `((br)
+ "Exception fetching data from "
+ (a (@ (href ,url))
+ ,url))))
+ (else
+ '())))))))))
(define (package-cross-changes-summary-table revisions
cross-derivation-changes-counts
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index 60ec66a..497e718 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -45,6 +45,8 @@
table/branches-with-most-recent-commits
render-html
+ render-json
+ render-text
general-not-found
error-page
@@ -417,6 +419,12 @@ main > header {
(define render-html
guix-data-service:render-html)
+(define render-json
+ guix-data-service:render-json)
+
+(define render-text
+ guix-data-service:render-text)
+
(define (general-not-found header-text body)
(layout
#:body
@@ -424,17 +432,14 @@ main > header {
(h1 ,header-text)
(p ,body)))))
-(define* (error-page #:optional error)
+(define* (error-page #:optional exn)
(layout
#:body
`((main
(h1 "An error occurred")
(p "Sorry about that!")
- ,@(if error
- (match error
- ((key . args)
- `((b ,key)
- (pre ,args))))
+ ,@(if exn
+ `((pre ,exn))
'())))))
(define file-mime-types
generated by cgit v1.2.3 (git 2.49.0) at 2025-07-03 23:26:05 +0000