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

Extract out view-revision/jobs-and-events

Browse source 
This is common to both view-revision and unknown-revision.
This commit is contained in:
Christopher Baines 2019-07-22 20:29:38 +01:00
parent 7a70e9ca6f
commit 219b1fd4ad
1 changed files with 48 additions and 88 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -416,38 +416,8 @@
branches)))) branches))))
git-repositories-and-branches))) git-repositories-and-branches)))
(define* (view-revision commit-hash packages-count (define (view-revision/jobs-and-events jobs-and-events)
git-repositories-and-branches derivations-count `((h3 "Jobs")
jobs-and-events
#:key (path-base "/revision/")
header-text)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 (@ (style "white-space: nowrap;"))
,@header-text)))
(div
(@ (class "row"))
(div
(@ (class "col-md-6"))
(h2 "Packages")
(strong (@ (class "text-center")
(style "font-size: 2em; display: block;"))
,packages-count)
(a (@ (href ,(string-append path-base "/packages")))
"View packages")
,@(if (null? git-repositories-and-branches)
'()
(view-revision/git-repositories git-repositories-and-branches
commit-hash))
(h3 "Jobs")
(table (table
(@ (class "table")) (@ (class "table"))
(thead (thead
@ -490,7 +460,40 @@
`((a (@ (href ,(string-append "/job/" id))) `((a (@ (href ,(string-append "/job/" id)))
"View log")) "View log"))
'()))))) '())))))
jobs-and-events)))) jobs-and-events)))))
(define* (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count
jobs-and-events
#:key (path-base "/revision/")
header-text)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 (@ (style "white-space: nowrap;"))
,@header-text)))
(div
(@ (class "row"))
(div
(@ (class "col-md-6"))
(h2 "Packages")
(strong (@ (class "text-center")
(style "font-size: 2em; display: block;"))
,packages-count)
(a (@ (href ,(string-append path-base "/packages")))
"View packages")
,@(if (null? git-repositories-and-branches)
'()
(view-revision/git-repositories git-repositories-and-branches
commit-hash))
,@(view-revision/jobs-and-events jobs-and-events))
(div (div
(@ (class "col-md-6")) (@ (class "col-md-6"))
(h3 "Derivations") (h3 "Derivations")
@ -1573,50 +1576,7 @@
(view-revision/git-repositories (view-revision/git-repositories
git-repositories-and-branches git-repositories-and-branches
commit-hash)) commit-hash))
(h3 "Jobs") ,@(view-revision/jobs-and-events jobs-and-events))
(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 (div
(@ (class "col-md-6")) (@ (class "col-md-6"))
(h3 "Derivations") (h3 "Derivations")