cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add labels to revisions on the branches and branch pages

Browse source 
And always link to the revision page. Now the label let's you know if you
should expect information or not for that revision.
This commit is contained in:
Christopher Baines 2019-06-19 22:49:57 +01:00
parent e93b8f948e
commit a168b23c24
2 changed files with 86 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

56
guix-data-service/model/git-branch.scm
View file

@ -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)
"")))
(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)))
(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;"))
(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))
query)))

48
guix-data-service/web/view/html.scm
View file

@ -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)