diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/model/git-branch.scm | 66 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 48 |
2 files changed, 86 insertions, 28 deletions
diff --git a/guix-data-service/model/git-branch.scm b/guix-data-service/model/git-branch.scm index 43774ed..985fd0d 100644 --- a/guix-data-service/model/git-branch.scm +++ b/guix-data-service/model/git-branch.scm @@ -1,5 +1,6 @@ (define-module (guix-data-service model git-branch) #:use-module (ice-9 match) + #:use-module (json) #:use-module (squee) #:use-module (srfi srfi-19) #:use-module (guix-data-service model utils) @@ -55,7 +56,15 @@ WHERE git_branches.commit = $1") (define query (string-append "SELECT git_branches.commit, datetime, " - "(guix_revisions.id IS NOT NULL) as guix_revision_exists " + "(guix_revisions.id IS NOT NULL) as guix_revision_exists, " + "( + SELECT json_agg(event) + FROM load_new_guix_revision_job_events + INNER JOIN load_new_guix_revision_jobs ON + load_new_guix_revision_jobs.id = load_new_guix_revision_job_events.job_id + WHERE load_new_guix_revision_jobs.commit = git_branches.commit AND + git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id + ) AS job_events " "FROM git_branches " "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit " "WHERE name = $1 " @@ -72,10 +81,19 @@ WHERE git_branches.commit = $1") (simple-format #f " LIMIT ~A;" limit) ""))) - (exec-query - conn - query - (list branch-name))) + (map + (match-lambda + ((commit datetime guix_revision_exists job_events) + (list commit + datetime + (string=? guix_revision_exists "t") + (if (string=? job_events "") + '() + (vector->list (json-string->scm job_events)))))) + (exec-query + conn + query + (list branch-name)))) (define* (latest-processed-commit-for-branch conn branch-name) (define query @@ -99,14 +117,34 @@ WHERE git_branches.commit = $1") (define (all-branches-with-most-recent-commit conn) (define query (string-append - "SELECT DISTINCT ON (name) name, git_branches.commit, " - "datetime, (guix_revisions.id IS NOT NULL) guix_revision_exists " - "FROM git_branches " - "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit " - "WHERE git_branches.commit IS NOT NULL " - "ORDER BY name, datetime DESC;")) + " +SELECT DISTINCT ON (name) + name, git_branches.commit, + datetime, (guix_revisions.id IS NOT NULL) guix_revision_exists, + ( + SELECT json_agg(event) + FROM load_new_guix_revision_job_events + INNER JOIN load_new_guix_revision_jobs ON + load_new_guix_revision_jobs.id = load_new_guix_revision_job_events.job_id + WHERE load_new_guix_revision_jobs.commit = git_branches.commit AND + git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id + ) AS job_events +FROM git_branches +LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit +WHERE git_branches.commit IS NOT NULL +ORDER BY name, datetime DESC;")) - (exec-query - conn - query)) + (map + (match-lambda + ((name commit datetime guix_revision_exists job_events) + (list name + commit + datetime + (string=? guix_revision_exists "t") + (if (string=? job_events "") + '() + (vector->list (json-string->scm job_events)))))) + (exec-query + conn + query))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index c837724..97ce2e4 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -666,24 +666,34 @@ (thead (tr (th (@ (class "col-md-3")) "Name") - (th (@ (class "col-md-3")) "Date") - (th (@ (class "col-md-3")) "Commit"))) + (th (@ (class "col-md-2")) "Date") + (th (@ (class "col-md-7")) "Commit"))) (tbody ,@(map (match-lambda - ((name commit date revision-exists) + ((name commit date revision-exists? job-events) `(tr (td (a (@ (href ,(string-append "/branch/" name))) ,name)) (td ,date) - (td ,(if (string=? revision-exists "t") + (td ,(if (string=? commit "NULL") + '(samp "branch deleted") `(a (@ (href ,(string-append "/revision/" commit))) - (samp ,commit)) - `(samp ,(if (string=? commit "NULL") - "branch deleted" - commit))))))) + (samp ,commit) + " " + ,(cond + (revision-exists? + '(span + (@ (class "label label-success")) + "✓")) + ((member "failure" job-events) + '(span (@ (class "label label-danger")) + "Failed to import data")) + (else + '(span (@ (class "label label-default")) + "No information yet"))))))))) branches-with-most-recent-commits))))))))) (define (view-branch branch-name query-parameters @@ -744,16 +754,26 @@ (tbody ,@(map (match-lambda - ((commit date revision-exists) + ((commit date revision-exists? job-events) `(tr (td ,date) - (td ,(if (string=? revision-exists "t") + (td ,(if (string=? commit "NULL") + '(samp "branch deleted") `(a (@ (href ,(string-append "/revision/" commit))) - (samp ,commit)) - `(samp ,(if (string=? commit "NULL") - "branch deleted" - commit))))))) + (samp ,commit) + " " + ,(cond + (revision-exists? + '(span + (@ (class "label label-success")) + "✓")) + ((member "failure" job-events) + '(span (@ (class "label label-danger")) + "Failed to import data")) + (else + '(span (@ (class "label label-default")) + "No information yet"))))))))) branch-commits))))))))) (define (view-builds stats builds) |