diff options
author | Christopher Baines <mail@cbaines.net> | 2019-07-22 20:00:11 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-07-22 20:00:11 +0100 |
commit | 91be72df039b1b1c914bece96a81d4b0cdee2144 (patch) | |
tree | 88252338dba6aeaffe67172c92af0d506999127a /guix-data-service/web | |
parent | 1f1deac29609fb63abf0f0a9939157df23b651a3 (diff) | |
download | data-service-91be72df039b1b1c914bece96a81d4b0cdee2144.tar data-service-91be72df039b1b1c914bece96a81d4b0cdee2144.tar.gz |
Display the jobs related to a revision on the revision page
Diffstat (limited to 'guix-data-service/web')
-rw-r--r-- | guix-data-service/web/controller.scm | 9 | ||||
-rw-r--r-- | guix-data-service/web/view/html.scm | 110 |
2 files changed, 107 insertions, 12 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index e49e0a7..6f2511c 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -103,7 +103,9 @@ (git-repositories-and-branches (git-branches-with-repository-details-for-commit conn commit-hash)) (derivations-counts - (count-packages-derivations-in-revision conn commit-hash))) + (count-packages-derivations-in-revision conn commit-hash)) + (jobs-and-events + (select-jobs-and-events-for-commit conn commit-hash))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) @@ -125,6 +127,7 @@ packages-count git-repositories-and-branches derivations-counts + jobs-and-events #:path-base path-base #:header-text header-text) #:extra-headers http-headers-for-unchanging-content))))) @@ -152,7 +155,9 @@ commit-hash (select-job-for-commit conn commit-hash) - (git-branches-with-repository-details-for-commit conn commit-hash)))))) + (git-branches-with-repository-details-for-commit conn commit-hash) + (select-jobs-and-events-for-commit conn commit-hash)))))) + (define* (render-revision-packages mime-types conn diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 8c34f05..25b759e 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -396,6 +396,7 @@ (define* (view-revision commit-hash packages-count git-repositories-and-branches derivations-count + jobs-and-events #:key (path-base "/revision/") header-text) (layout @@ -441,7 +442,51 @@ commit-hash))) ,name " at " ,datetime)))) branches)))) - git-repositories-and-branches)))) + git-repositories-and-branches))) + (h3 "Jobs") + (table + (@ (class "table")) + (thead + (tr + (th "Source") + (th "Events") + (th ""))) + (tbody + ,@(map (match-lambda + ((id commit source git-repository-id created-at succeeded-at + events log-exists?) + `(tr + (@ (class + ,(let ((event-names + (map (lambda (event) + (assoc-ref event "event")) + (vector->list events)))) + (cond + ((member "success" event-names) + "success") + ((member "failure" event-names) + "danger") + ((member "start" event-names) + "info") + (else + ""))))) + (td ,source) + (td + (dl + ,@(map + (lambda (event) + `((dt ,(assoc-ref event "event")) + (dd ,(assoc-ref event "occurred_at")))) + (cons + `(("event" . "created") + ("occurred_at" . ,created-at)) + (vector->list events))))) + (td + ,@(if log-exists? + `((a (@ (href ,(string-append "/job/" id))) + "View log")) + '()))))) + jobs-and-events)))) (div (@ (class "col-md-6")) (h3 "Derivations") @@ -1491,7 +1536,8 @@ (h1 ,header-text) (p ,body))))) -(define (unknown-revision commit-hash job git-repositories-and-branches) +(define (unknown-revision commit-hash job git-repositories-and-branches + jobs-and-events) (layout #:body `(,(header) @@ -1524,7 +1570,7 @@ `((h3 "Git repositories") ,@(map (match-lambda - (((label url cgit-url-base) . branches) + (((id label url cgit-url-base) . branches) `((h4 ,url) ,@(map (match-lambda @@ -1537,13 +1583,57 @@ commit-hash))) ,name " at " ,datetime)))) branches)))) - git-repositories-and-branches)))) - (div - (@ (class "col-md-6")) - (h3 "Derivations") - (strong (@ (class "text-center") - (style "font-size: 2em; display: block;")) - "Unknown")))))))))) + git-repositories-and-branches))) + (h3 "Jobs") + (table + (@ (class "table")) + (thead + (tr + (th "Source") + (th "Events") + (th ""))) + (tbody + ,@(map (match-lambda + ((id commit source git-repository-id created-at succeeded-at + events log-exists?) + `(tr + (@ (class + ,(let ((event-names + (map (lambda (event) + (assoc-ref event "event")) + (vector->list events)))) + (cond + ((member "success" event-names) + "success") + ((member "failure" event-names) + "danger") + ((member "start" event-names) + "info") + (else + ""))))) + (td ,source) + (td + (dl + ,@(map + (lambda (event) + `((dt ,(assoc-ref event "event")) + (dd ,(assoc-ref event "occurred_at")))) + (cons + `(("event" . "created") + ("occurred_at" . ,created-at)) + (vector->list events))))) + (td + ,@(if log-exists? + `((a (@ (href ,(string-append "/job/" id))) + "View log")) + '()))))) + jobs-and-events)))) + (div + (@ (class "col-md-6")) + (h3 "Derivations") + (strong (@ (class "text-center") + (style "font-size: 2em; display: block;")) + "Unknown")))))))))) (define (compare-unknown-commit base-commit target-commit base-exists? target-exists? |