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

Add a few new pages

Browse source 
For showing more information about builds, revisions and derivations.
This commit is contained in:
Christopher Baines 2019-03-06 22:59:27 +00:00
parent e656b0967b
commit b0eaf9cf7a
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
3 changed files with 131 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -24,6 +24,9 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:export (index
view-revision
view-builds
view-derivation
compare
compare/derivations
compare/packages
@ -164,6 +167,104 @@
(td ,source))))
queued-guix-revisions)))))))))
(define (view-revision commit-hash packages)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(h1 "Revision " (samp ,commit-hash)))
(div
(@ (class "row"))
(h3 "Packages")
(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Version")))
(tbody
,@(map
(match-lambda
((name version rest ...)
`(tr
(td ,name)
(td ,version))))
packages))))))))
(define (view-builds stats builds)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(h1 "Builds")
(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-2")) "Status")
(th (@ (class "col-md-2")) "Count")))
(tbody
,@(map
(match-lambda
((status count)
`(tr
(td ,status)
(td ,count))))
stats))))
(div
(@ (class "row"))
(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-xs-2")) "Status")
(th (@ (class "col-xs-9")) "Derivation")
(th (@ (class "col-xs-1")) "Started at")
(th (@ (class "col-xs-1")) "Finished at")
(th (@ (class "col-xs-1")) "")))
(tbody
,@(map
(match-lambda
((build-id build-server-url derivation-file-name
status-fetched-at starttime stoptime status)
`(tr
(td (@ (class ,(cond
((string=? status "succeeded")
"bg-success")
((string=? status "failed")
"bg-danger")
(else ""))))
,status)
(td ,derivation-file-name)
(td ,starttime)
(td ,stoptime)
(td (a (@ (href ,(simple-format
#f "~Abuild/~A" build-server-url build-id)))
"View build on " ,build-server-url)))))
builds))))))))
(define (view-derivation derivation-file-name)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(h1 "Derivation " (samp ,derivation-file-name)))))))
(define (compare base-commit
target-commit
new-packages